      SUBROUTINE DPPLO1(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1MAXNPP,
     1IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--FORM A Y PLOT, A Y VERSUS X PLOT, A SUBSET PLOT,
C              AND OTHER SIMILAR TYPE PLOTS
C              WHEN HAVE NO VERSUS AND NO EQUALS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --JANUARY   1978.
C     UPDATED         --FEBRUARY  1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988. FIX PLOT Y FOR ... WHEN I OUT OF BOUNDS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHVERT
      CHARACTER*4 IHVER2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IHSET
      CHARACTER*4 IHSET2
      CHARACTER*4 IERRO4
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='DPPL'
      ISUBN2='O1  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      NUMAR1=0
C
      D2MIN=0.0
      DEL=0.0
C
C               ********************************
C               **  STEP 10--                 **
C               **  TREAT THE CASE WHEN HAVE  **
C               **  NO    VERSUS        AND   **
C               **  NO    FOR X =             **
C               ********************************
C
 1000 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPLO1--')
      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)IBUGG3,IBUGQ
   54 FORMAT('IBUGG3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IFOUND,IERROR
   55 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)MAXNPP
   56 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      ISTEPN='10'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE VERTICAL VARIABLE)  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHVERT=IHARG(1)
      IHVER2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVERT,IHVER2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IVAV=IVALUE(ILOCV)
      NLOCAL=IN(ILOCV)
C
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,1107)IHVERT,IHVER2,ILOCV,IERROR,
     1IVAV,NLOCAL
 1107 FORMAT('IHVERT,IHVER2,ILOCV,IERROR,IVAV,NLOCAL = ',
     1A4,A4,2X,I8,2X,A4,I8,I8)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               *****************************************
C               **  STEP 12--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='12'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1290
      DO1200J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1210
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1210
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1220
 1200 CONTINUE
      GOTO1290
 1210 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1290
 1220 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1290
 1290 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO1295
      WRITE(ICOUT,1291)NUMARG,ILOCQ
 1291 FORMAT('NUMARG,ILOCQ = ',12I8)
      CALL DPWRST('XXX','BUG ')
 1295 CONTINUE
C
C               *********************************************
C               **  STEP 13--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               *********************************************
C
      ISTEPN='13'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO1310
      IF(ICASEQ.EQ.'SUBS')GOTO1320
      IF(ICASEQ.EQ.'FOR')GOTO1330
C
 1310 CONTINUE
      DO1315I=1,NLOCAL
      ISUB(I)=1
 1315 CONTINUE
      NQ=NLOCAL
      GOTO1350
C
 1320 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO1350
C
 1330 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
CCCCC THE FOLLOWING LINE WAS INSERTED MARCH 1988
      IF(NS.GT.NIOLD)NS=NIOLD
      GOTO1350
C
 1350 CONTINUE
C
C               **********************************************************
C               **  STEP 14--                                           **
C               **  BRANCH ACCORDING TO THE NUMBER OF ARGUMENTS BEFORE  **
C               **  'SUBS', 'FOR', AND 'AND'.                          **
C               **********************************************************
C
      ISTEPN='14'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCA=NUMARG+1
      IF(IHARG(NUMARG).EQ.'AND')ILOCA=NUMARG
      IF(ILOCA.LT.ILOCQ)NUMAR1=ILOCA-1
      IF(ILOCQ.LT.ILOCA)NUMAR1=ILOCQ-1
      IF(ILOCA.EQ.ILOCQ)NUMAR1=NUMARG
      IF(NUMAR1.EQ.1)GOTO1500
      IF(NUMAR1.EQ.2)GOTO1600
      IF(NUMAR1.EQ.3)GOTO1700
      WRITE(ICOUT,1401)
 1401 FORMAT('***** ERROR IN DPPLO1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1402)
 1402 FORMAT('      NUMAR1 NOT = 1, 2, OR 3. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1403)NUMAR1
 1403 FORMAT('      NUMAR1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1404)NUMARG,IHARG(NUMARG),ILOCA,ILOCQ
 1404 FORMAT('      NUMARG,IHARG(NUMARG),ILOCA,ILOCQ = ',
     1I6,2X,A4,2I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1408)
 1408 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1409)(IANS(I),I=1,IWIDTH)
 1409 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *************************************************************
C               **  STEP 15--                                              **
C               **  TREAT THE 1 VARIABLE CASE (WITH NO VS AND NO =) CASE.  **
C               *************************************************************
C
 1500 CONTINUE
      ISTEPN='15'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ****************************************
C               **  STEP 15.1--                       **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               ****************************************
C
      ISTEPN='15.1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHVERT=IHARG(1)
      IHVER2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVERT,IHVER2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IVAV=IVALUE(ILOC)
C
C               *************************************************************
C               **  STEP 15.2--                                            **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                  **
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.  **
C               **  RESET THE D(.) VECTOR TO ONES.                         **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='15.2'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IAND1.EQ.'NO')GOTO1519
      IF(NPLOTP.LE.0)GOTO1519
      D1MAX=D(1)
      DO1510I=1,NPLOTP
      IF(D(I).GT.D1MAX)D1MAX=D(I)
 1510 CONTINUE
      D2MIN=1.0
      IF(IAND1.EQ.'YES')DEL=D1MAX-D2MIN+1.0
 1519 CONTINUE
C
      L=NPLOTP
C
      DO1520I=1,NLOCAL
      IF(ISUB(I).EQ.0)GOTO1520
      L=L+1
C
      IF(L.LE.MAXNPP)GOTO1529
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1521)
 1521 FORMAT('***** ERROR IN DPPLO1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1523)
 1523 FORMAT('      THE NUMBER OF PLOT POINTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1524)MAXNPP
 1524 FORMAT('      HAS JUST EXCEEDED ',I8,' *****')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)I,NLOCAL,L,MAXN,MAXNPP,NPLOTP
 1525 FORMAT('I,NLOCAL,L,MAXN,MAXNPP,NPLOTP = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1526)IAND1,IAND2,IFOUND,IERROR
 1526 FORMAT('IAND1,IAND2,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1529 CONTINUE
C
      IJ=MAXN*(IVAV-1)+I
      IF(IVAV.LE.MAXCOL)Y(L)=V(IJ)
      IF(IVAV.EQ.MAXCP1)Y(L)=PRED(I)
      IF(IVAV.EQ.MAXCP2)Y(L)=RES(I)
      IF(IVAV.EQ.MAXCP3)Y(L)=YPLOT(I)
      IF(IVAV.EQ.MAXCP4)Y(L)=XPLOT(I)
      IF(IVAV.EQ.MAXCP5)Y(L)=X2PLOT(I)
      IF(IVAV.EQ.MAXCP6)Y(L)=TAGPLO(I)
      X(L)=L
      IF(IAND1.EQ.'NO')D(L)=1.0
      IF(IAND1.EQ.'YES')D(L)=1.0+DEL
 1520 CONTINUE
      NPLOTP=L
      NPLOTV=1
      IF(IAND1.EQ.'YES'.AND.NPLOTV.GT.1)NPLOTV=NPLOTV
      GOTO9000
C
C               *************************************************************
C               **  STEP 16--                                              **
C               **  TREAT THE 2 VARIABLE CASE (WITH NO VS AND NO =) CASE.  **
C               *************************************************************
C
 1600 CONTINUE
      ISTEPN='16'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ****************************************
C               **  STEP 16.1--                       **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               ****************************************
C
      ISTEPN='16.1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHVERT=IHARG(1)
      IHVER2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVERT,IHVER2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IVAV=IVALUE(ILOCV)
C
C               ****************************************
C               **  STEP 16.2--                       **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               ****************************************
C
      ISTEPN='16.2'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHHOR=IHARG(2)
      IHHOR2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCH,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IHAV=IVALUE(ILOCH)
C
C               *************************************************************
C               **  STEP 16.3--                                            **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                  **
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.  **
C               **  RESET THE D(.) VECTOR TO ONES.                         **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='16.3'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IAND1.EQ.'NO')GOTO1619
      IF(NPLOTP.LE.0)GOTO1619
      D1MAX=D(1)
      DO1610I=1,NPLOTP
      IF(D(I).GT.D1MAX)D1MAX=D(I)
 1610 CONTINUE
      D2MIN=1.0
      IF(IAND1.EQ.'YES')DEL=D1MAX-D2MIN+1.0
 1619 CONTINUE
C
      L=NPLOTP
C
      NLOCAL=IN(ILOCV)
      DO1620I=1,NLOCAL
      IF(ISUB(I).EQ.0)GOTO1620
      L=L+1
C
      IF(L.LE.MAXNPP)GOTO1629
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1621)
 1621 FORMAT('***** ERROR IN DPPLO1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1623)
 1623 FORMAT('      THE NUMBER OF PLOT POINTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1624)MAXNPP
 1624 FORMAT('      HAS JUST EXCEEDED ',I8,' *****')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)I,NLOCAL,L,MAXN,MAXNPP,NPLOTP
 1625 FORMAT('I,NLOCAL,L,MAXN,MAXNPP,NPLOTP = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1626)IAND1,IAND2,IFOUND,IERROR
 1626 FORMAT('IAND1,IAND2,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1629 CONTINUE
C
      IJ=MAXN*(IVAV-1)+I
      IF(IVAV.LE.MAXCOL)Y(L)=V(IJ)
      IF(IVAV.EQ.MAXCP1)Y(L)=PRED(I)
      IF(IVAV.EQ.MAXCP2)Y(L)=RES(I)
      IF(IVAV.EQ.MAXCP3)Y(L)=YPLOT(I)
      IF(IVAV.EQ.MAXCP4)Y(L)=XPLOT(I)
      IF(IVAV.EQ.MAXCP5)Y(L)=X2PLOT(I)
      IF(IVAV.EQ.MAXCP6)Y(L)=TAGPLO(I)
      IJ=MAXN*(IHAV-1)+I
      IF(IHAV.LE.MAXCOL)X(L)=V(IJ)
      IF(IHAV.EQ.MAXCP1)X(L)=PRED(I)
      IF(IHAV.EQ.MAXCP2)X(L)=RES(I)
      IF(IHAV.EQ.MAXCP3)X(L)=YPLOT(I)
      IF(IHAV.EQ.MAXCP4)X(L)=XPLOT(I)
      IF(IHAV.EQ.MAXCP5)X(L)=X2PLOT(I)
      IF(IHAV.EQ.MAXCP6)X(L)=TAGPLO(I)
      IF(IAND1.EQ.'NO')D(L)=1.0
      IF(IAND1.EQ.'YES')D(L)=1.0+DEL
 1620 CONTINUE
      NPLOTP=L
      NPLOTV=2
      IF(IAND1.EQ.'YES'.AND.NPLOTV.GT.2)NPLOTV=NPLOTV
      GOTO9000
C
C               *************************************************************
C               **  STEP 17--                                              **
C               **  TREAT THE 3 VARIABLE CASE (WITH NO VS AND NO =) CASE.  **
C               *************************************************************
C
 1700 CONTINUE
      ISTEPN='17'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ****************************************
C               **  STEP 17.1--                       **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               ****************************************
C
      ISTEPN='17.1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHVERT=IHARG(1)
      IHVER2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVERT,IHVER2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IVAV=IVALUE(ILOCV)
C
C               ****************************************
C               **  STEP 17.2--                       **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               ****************************************
C
      ISTEPN='17.2'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHHOR=IHARG(2)
      IHHOR2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCH,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IHAV=IVALUE(ILOCH)
C
C               ****************************************
C               **  STEP 17.3--                       **
C               **  CHECK THE VALIDITY OF ARGUMENT 3  **
C               ****************************************
C
      ISTEPN='17.3'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHSET=IHARG(3)
      IHSET2=IHARG2(3)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCD,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ISETV=IVALUE(ILOCD)
C
C               *************************************************************
C               **  STEP 17.4--                                            **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                  **
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.  **
C               **  RESET THE D(.) VECTOR TO ONES.                         **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='17.4'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IAND1.EQ.'NO')GOTO1719
      IF(NPLOTP.LE.0)GOTO1719
      D1MAX=D(1)
      DO1710I=1,NPLOTP
      IF(D(I).GT.D1MAX)D1MAX=D(I)
 1710 CONTINUE
      I=1
      IJ=MAXN*(ISETV-1)+I
      IF(ISETV.LE.MAXCOL)D2MIN=V(IJ)
      IF(ISETV.EQ.MAXCP1)D2MIN=PRED(I)
      IF(ISETV.EQ.MAXCP2)D2MIN=RES(I)
      IF(ISETV.EQ.MAXCP3)D2MIN=YPLOT(I)
      IF(ISETV.EQ.MAXCP4)D2MIN=XPLOT(I)
      IF(ISETV.EQ.MAXCP5)D2MIN=X2PLOT(I)
      IF(ISETV.EQ.MAXCP6)D2MIN=TAGPLO(I)
      NLOCAL=IN(ILOCV)
      DO1711I=1,NLOCAL
      IJ=MAXN*(ISETV-1)+I
      IF(ISETV.LE.MAXCOL)GOTO1712
      IF(ISETV.EQ.MAXCP1)GOTO1713
      IF(ISETV.EQ.MAXCP2)GOTO1714
      IF(ISETV.EQ.MAXCP3)GOTO1715
      IF(ISETV.EQ.MAXCP4)GOTO1716
      IF(ISETV.EQ.MAXCP5)GOTO1717
      IF(ISETV.EQ.MAXCP6)GOTO1718
 1712 CONTINUE
      IF(V(IJ).LT.D2MIN)D2MIN=V(IJ)
      GOTO1711
 1713 CONTINUE
      IF(PRED(I).LT.D2MIN)D2MIN=PRED(I)
      GOTO1711
 1714 CONTINUE
      IF(RES(I).LT.D2MIN)D2MIN=RES(I)
      GOTO1711
 1715 CONTINUE
      IF(YPLOT(I).LT.D2MIN)D2MIN=YPLOT(I)
      GOTO1711
 1716 CONTINUE
      IF(XPLOT(I).LT.D2MIN)D2MIN=XPLOT(I)
      GOTO1711
 1717 CONTINUE
      IF(X2PLOT(I).LT.D2MIN)D2MIN=X2PLOT(I)
      GOTO1711
 1718 CONTINUE
      IF(TAGPLO(I).LT.D2MIN)D2MIN=TAGPLO(I)
      GOTO1711
 1711 CONTINUE
      IF(IAND1.EQ.'YES')DEL=D1MAX-D2MIN+1.0
 1719 CONTINUE
C
      L=NPLOTP
C
      NLOCAL=IN(ILOCV)
      DO1720I=1,NLOCAL
      IF(ISUB(I).EQ.0)GOTO1720
      L=L+1
C
      IF(L.LE.MAXNPP)GOTO1729
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1721)
 1721 FORMAT('***** ERROR IN DPPLO1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1723)
 1723 FORMAT('      THE NUMBER OF PLOT POINTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1724)MAXNPP
 1724 FORMAT('      HAS JUST EXCEEDED ',I8,' *****')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)I,NLOCAL,L,MAXN,MAXNPP,NPLOTP
 1725 FORMAT('I,NLOCAL,L,MAXN,MAXNPP,NPLOTP = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1726)IAND1,IAND2,IFOUND,IERROR
 1726 FORMAT('IAND1,IAND2,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1729 CONTINUE
C
      IJ=MAXN*(IVAV-1)+I
      IF(IVAV.LE.MAXCOL)Y(L)=V(IJ)
      IF(IVAV.EQ.MAXCP1)Y(L)=PRED(I)
      IF(IVAV.EQ.MAXCP2)Y(L)=RES(I)
      IF(IVAV.EQ.MAXCP3)Y(L)=YPLOT(I)
      IF(IVAV.EQ.MAXCP4)Y(L)=XPLOT(I)
      IF(IVAV.EQ.MAXCP5)Y(L)=X2PLOT(I)
      IF(IVAV.EQ.MAXCP6)Y(L)=TAGPLO(I)
      IJ=MAXN*(IHAV-1)+I
      IF(IHAV.LE.MAXCOL)X(L)=V(IJ)
      IF(IHAV.EQ.MAXCP1)X(L)=PRED(I)
      IF(IHAV.EQ.MAXCP2)X(L)=RES(I)
      IF(IHAV.EQ.MAXCP3)X(L)=YPLOT(I)
      IF(IHAV.EQ.MAXCP4)X(L)=XPLOT(I)
      IF(IHAV.EQ.MAXCP5)X(L)=X2PLOT(I)
      IF(IHAV.EQ.MAXCP6)X(L)=TAGPLO(I)
      IJ=MAXN*(ISETV-1)+I
      IF(IAND1.EQ.'NO'.AND.ISETV.LE.MAXCOL)D(L)=V(IJ)
      IF(IAND1.EQ.'NO'.AND.ISETV.EQ.MAXCP1)D(L)=PRED(I)
      IF(IAND1.EQ.'NO'.AND.ISETV.EQ.MAXCP2)D(L)=RES(I)
      IF(IAND1.EQ.'NO'.AND.ISETV.EQ.MAXCP3)D(L)=YPLOT(I)
      IF(IAND1.EQ.'NO'.AND.ISETV.EQ.MAXCP4)D(L)=XPLOT(I)
      IF(IAND1.EQ.'NO'.AND.ISETV.EQ.MAXCP5)D(L)=X2PLOT(I)
      IF(IAND1.EQ.'NO'.AND.ISETV.EQ.MAXCP6)D(L)=TAGPLO(I)
      IF(IAND1.EQ.'YES'.AND.ISETV.LE.MAXCOL)D(L)=V(IJ)+DEL
      IF(IAND1.EQ.'YES'.AND.ISETV.EQ.MAXCP1)D(L)=PRED(I)+DEL
      IF(IAND1.EQ.'YES'.AND.ISETV.EQ.MAXCP2)D(L)=RES(I)+DEL
      IF(IAND1.EQ.'YES'.AND.ISETV.EQ.MAXCP3)D(L)=YPLOT(I)+DEL
      IF(IAND1.EQ.'YES'.AND.ISETV.EQ.MAXCP4)D(L)=XPLOT(I)+DEL
      IF(IAND1.EQ.'YES'.AND.ISETV.EQ.MAXCP5)D(L)=X2PLOT(I)+DEL
      IF(IAND1.EQ.'YES'.AND.ISETV.EQ.MAXCP6)D(L)=TAGPLO(I)+DEL
 1720 CONTINUE
      NPLOTP=L
      NPLOTV=3
      IF(IAND1.EQ.'YES'.AND.NPLOTV.GT.3)NPLOTV=NPLOTV
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPLO1--')
      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)IBUGG3,IBUGQ
 9014 FORMAT('IBUGG3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFOUND,IERROR
 9015 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)MAXNPP
 9016 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)
 9020 FORMAT('I,Y(.),X(.),D(.),ISUB(.)--')
      CALL DPWRST('XXX','BUG ')
      DO9021I=1,NPLOTP
      WRITE(ICOUT,9022)I,Y(I),X(I),D(I),ISUB(I)
 9022 FORMAT(I8,F15.7,F15.7,F15.7,I8)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPLO2(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IVSLOC,NUMVS,
     1MAXNPP,
     1IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--FORM A Y PLOT, A Y VERSUS X PLOT, A SUBSET PLOT,
C              AND OTHER SIMILAR TYPE PLOTS
C              WHEN HAVE 1 OR MORE VERSUS ENTERED.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --JANUARY   1978.
C     UPDATED         --FEBRUARY  1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988. FIX PLOT Y X FOR .. WHEN I OUT OF BOUNDS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHVERT
      CHARACTER*4 IHVER2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IVSLOC(*)
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='DPPL'
      ISUBN2='O2  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
CCCCC MAXNPP=1000
C
      KSTART=0
C
      DEL=0.0
C
C               ***********************************************************
C               **  STEP 20--                                            **
C               **  TREAT THE CASE WHEN HAVE 1 OR MORE 'VERSUS' ENTERED  **
C               ***********************************************************
C
 2000 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPLO2--')
      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)IBUGG3,IBUGQ
   54 FORMAT('IBUGG3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IFOUND,IERROR
   55 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)MAXNPP
   56 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      ISTEPN='20'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='21'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               **********************************
C               **  STEP 22--                   **
C               **  DETERMINE WHICH VARIABLES   **
C               **  ARE TO BE GROUPED TOGETHER  **
C               **********************************
C
      ISTEPN='22'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      L=NPLOTP
C
      NEWSET=0
      DO2200J=1,NUMVS
      JM1=J-1
      IF(J.EQ.1)KSTART=1
      IF(J.GE.2)KSTART=IVSLOC(JM1)+2
      KSTOP=IVSLOC(J)-1
      IVS=IVSLOC(J)
C
      IVSP1=IVS+1
      DO2210K=KSTART,KSTOP
      NEWSET=NEWSET+1
C
      IHVERT=IHARG(K)
      IHVER2=IHARG2(K)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVERT,IHVER2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IVAV=IVALUE(ILOCV)
      NLOCAL=IN(ILOCV)
C
      IHHOR=IHARG(IVSP1)
      IHHOR2=IHARG2(IVSP1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCH,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IHAV=IVALUE(ILOCH)
C
      ISETV=NEWSET
C
      IF(IAND1.EQ.'NO')GOTO2280
      IF(NPLOTP.LE.0)GOTO2280
      D1MAX=D(1)
      DO2220I=1,NPLOTP
      IF(D(I).GT.D1MAX)D1MAX=D(I)
 2220 CONTINUE
      D2MIN=1.0
      IF(IAND1.EQ.'YES')DEL=D1MAX-D2MIN+1.0
 2280 CONTINUE
C
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,2282)IHVERT,ILOCV,IERROR,IVAV,NLOCAL
 2282 FORMAT('IHVERT,ILOCV,IERROR,IVAV,NLOCAL = ',
     1A4,2X,I8,2X,A4,2X,A4,2X,I8)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               *********************************************
C               **  STEP 23--                              **
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='23'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2310
      IF(ICASEQ.EQ.'SUBS')GOTO2320
      IF(ICASEQ.EQ.'FOR')GOTO2330
CCCCC IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2320
CCCCC IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2320
CCCCC IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2330
C
 2310 CONTINUE
      DO2315I=1,NLOCAL
      ISUB(I)=1
 2315 CONTINUE
      NQ=NLOCAL
      GOTO2350
C
 2320 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO2350
C
 2330 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
CCCCC THE FOLLOWING LINE WAS INSERTED MARCH 1988
      IF(NS.GT.NIOLD)NS=NIOLD
      GOTO2350
C
 2350 CONTINUE
C
      DO2360I=1,NLOCAL
      IF(ISUB(I).EQ.0)GOTO2360
      L=L+1
C
      IF(L.LE.MAXNPP)GOTO2369
      WRITE(ICOUT,2362)
 2362 FORMAT('***** PLOT FORMATION ERROR IN DPPLO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2363)
 2363 FORMAT('      THE NUMBER OF PLOT POINTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2364)MAXNPP
 2364 FORMAT('      HAS JUST EXCEEDED ',I8,' *****')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2369 CONTINUE
C
      IJ=MAXN*(IVAV-1)+I
      IF(IVAV.LE.MAXCOL)Y(L)=V(IJ)
      IF(IVAV.EQ.MAXCP1)Y(L)=PRED(I)
      IF(IVAV.EQ.MAXCP2)Y(L)=RES(I)
      IF(IVAV.EQ.MAXCP3)Y(L)=YPLOT(I)
      IF(IVAV.EQ.MAXCP4)Y(L)=XPLOT(I)
      IF(IVAV.EQ.MAXCP5)Y(L)=X2PLOT(I)
      IF(IVAV.EQ.MAXCP6)Y(L)=TAGPLO(I)
      IJ=MAXN*(IHAV-1)+I
      IF(IHAV.LE.MAXCOL)X(L)=V(IJ)
      IF(IHAV.EQ.MAXCP1)X(L)=PRED(I)
      IF(IHAV.EQ.MAXCP2)X(L)=RES(I)
      IF(IHAV.EQ.MAXCP3)Y(L)=YPLOT(I)
      IF(IHAV.EQ.MAXCP4)Y(L)=XPLOT(I)
      IF(IHAV.EQ.MAXCP5)Y(L)=X2PLOT(I)
      IF(IHAV.EQ.MAXCP6)Y(L)=TAGPLO(I)
      IF(IAND1.EQ.'NO')D(L)=ISETV
      IF(IAND1.EQ.'YES')D(L)=ISETV+DEL
 2360 CONTINUE
 2210 CONTINUE
 2200 CONTINUE
      NPLOTP=L
C
      DHOLD=D(1)
      DO2370I=1,NPLOTP
      IF(D(I).NE.DHOLD)GOTO2375
 2370 CONTINUE
      NPLOTV=2
      GOTO2399
 2375 CONTINUE
      NPLOTV=3
      GOTO2399
C
 2399 CONTINUE
      GOTO9000
C
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 DPPLO2--')
      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)IBUGG3,IBUGQ
 9014 FORMAT('IBUGG3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFOUND,IERROR
 9015 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)MAXNPP
 9016 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPLO3(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1PARAM,IPARN,IPARN2,NUMPAR,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,
     1IFOLOC,
     1MAXNPP,
     1IANGLU,IBUGG3,IBUGCO,IBUGEV,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--FORM A PLOT OF A FUNCTION
C              WHEN HAVE 1 OR MORE    =    ENTERED,
C              THAT IS, WHEN HAVE   PLOT Y = ... FOR X = ...
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --JANUARY   1978.
C     UPDATED         --FEBRUARY  1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     1992. FIX   PLOT CONSTANT
C     UPDATED         --MAY       1994. SUPPRESS MESSAGE FOR POINT PLOT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW2HOL
      CHARACTER*4 IW22HO
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IWD1
      CHARACTER*4 IWD12
      CHARACTER*4 IWD2
      CHARACTER*4 IWD22
      CHARACTER*4 IVERTI
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHPARN
      CHARACTER*4 IHPAR2
      CHARACTER*4 IVDU11
      CHARACTER*4 IVDU12
CCCCC CHARACTER*4 IA
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
C
      DIMENSION ITYPEH(*)
      DIMENSION IW2HOL(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IFOLOC(*)
C
CCCCC DIMENSION IA(132)
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='DPPL'
      ISUBN2='O3  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
C
CCCCC MAXNPP=1000
C
      LOCDU1=0
      I2=0
C
      DEL=0.0
C
      NUMIT=1
C
C               **************************************************************
C               **  TREAT THE CASE WHEN HAVE 1 OR MORE '=' ENTERED
C               **  THAT IS, TREAT THE PLOT Y = ... FOR X = ... CASE
C               **************************************************************
C
 3000 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPLO3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NPLOTV,NPLOTP,NS,MAXNPP
   52 FORMAT('NPLOTV,NPLOTP,NS,MAXNPP = ',4I8)
      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,IBUGG3,IBUGCO,IBUGEV,IBUGQ
   54 FORMAT('IANGLU,IBUGG3,IBUGCO,IBUGEV,IBUGQ = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IFOUND,IERROR
   55 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************
C               **  STEP 2--                            **
C               **  DETERMINE THE MAX TRACE DESIGNATION  **
C               **  (A NUMBER) AS CONTAINED              **
C               **  IN THE VECTOR D(.).                  **
C               *******************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IAND1.EQ.'NO')GOTO119
      IF(NPLOTP.LE.0)GOTO119
      D1MAX=D(1)
      DO110I=1,NPLOTP
      IF(D(I).GT.D1MAX)D1MAX=D(I)
  110 CONTINUE
      D2MIN=1.0
      IF(IAND1.EQ.'YES')DEL=D1MAX-D2MIN+1.0
  119 CONTINUE
C
C               ************************************************
C               **  STEP 3--                                  **
C               **  DETERMINE THE NAME OF THE DUMMY VARIABLE  **
C               **  (IT NEVER GETS STORED PERMANENTLY)        **
C               **  IMMEDIATELY FOLLOWING 'FOR'.              **
C               ************************************************
C
      ISTEPN='3'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO3100J=1,NUMARG
      J2=J
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO3110
 3100 CONTINUE
      IBRAN=3101
      WRITE(ICOUT,3101)
 3101 FORMAT('***** ERROR IN DPPLO3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3102)
 3102 FORMAT('      THE STRING    FOR    NOT FOUND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3103)
 3103 FORMAT('      EVEN THOUGH THE STRING    =    WAS FOUND.')
      CALL DPWRST('XXX','BUG ')
       WRITE(ICOUT,3104)
 3104 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3105)(IANS(I),I=1,IWIDTH)
 3105 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3110 CONTINUE
      IFOLP0=J2
C
      IF(IFOLP0.LT.NUMARG)GOTO3190
      WRITE(ICOUT,3121)
 3121 FORMAT('***** ERROR IN DPPLO3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3122)
 3122 FORMAT('      THE WORD    FOR    WAS THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3123)
 3123 FORMAT('      FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3124)
 3124 FORMAT('      THE WORD    FOR    SHOULD HAVE BEEN FOLLOWED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3125)
 3125 FORMAT('      BY 5    WORDS   --')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3126)
 3126 FORMAT('      1) A DUMMY VARIABLE NAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3127)
 3127 FORMAT('      2) AN EQUAL SIGN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3128)
 3128 FORMAT('      3) ONE LIMIT (LOWER OR UPPER) ',
     1'FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3129)
 3129 FORMAT('      4) THE INCREMENT FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3130)
 3130 FORMAT('      5) THE OTHER LIMIT (UPPER OR LOWER) ',
     1'FOR THE DUMMY VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3131)
 3131 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3132)(IANS(I),I=1,IWIDTH)
 3132 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3190 CONTINUE
      IFOLP1=IFOLP0+1
      IVDU11=IHARG(IFOLP1)
      IVDU12=IHARG2(IFOLP1)
C
C               *******************************************
C               **  STEP 4--                             **
C               **  EVALUATE THE FUNCTION OVER           **
C               **  THE VARIOUS POINTS IN THE INTERVAL.  **
C               *******************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMAM1=NUMARG-1
      NUMAM2=NUMARG-2
      NUMAM3=NUMARG-3
C
 3210 CONTINUE
      ILOCA=NUMAM2
      IF(IHARG(NUMARG).EQ.'AND '.AND.IHARG2(NUMARG).EQ.'    ')
     1ILOCA=NUMAM3
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO3211
      IF(IARGT(ILOCA).EQ.'WORD')GOTO3212
      GOTO3270
 3211 CONTINUE
      START=ARG(ILOCA)
      GOTO3220
 3212 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      START=VALUE(ILOC)
      GOTO3220
C
 3220 CONTINUE
      ILOCA=NUMAM1
      IF(IHARG(NUMARG).EQ.'AND '.AND.IHARG2(NUMARG).EQ.'    ')
     1ILOCA=NUMAM2
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO3221
      IF(IARGT(ILOCA).EQ.'WORD')GOTO3222
      GOTO3270
 3221 CONTINUE
      AINC=ARG(ILOCA)
      GOTO3230
 3222 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AINC=VALUE(ILOC)
      GOTO3230
C
 3230 CONTINUE
      ILOCA=NUMARG
      IF(IHARG(NUMARG).EQ.'AND '.AND.IHARG2(NUMARG).EQ.'    ')
     1ILOCA=NUMAM1
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO3231
      IF(IARGT(ILOCA).EQ.'WORD')GOTO3232
      GOTO3270
 3231 CONTINUE
      STOP=ARG(ILOCA)
      GOTO3280
 3232 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      STOP=VALUE(ILOC)
      GOTO3280
C
 3270 CONTINUE
      WRITE(ICOUT,3271)
 3271 FORMAT('***** INTERNAL ERROR IN DPPLO3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3272)
 3272 FORMAT('      AN ARGUMENT TYPE WHICH SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3273)
 3273 FORMAT('      EITHER A NUMBER OR A WORD, IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3274)IHARG(ILOCA),IHARG2(ILOCA)
 3274 FORMAT('      ARGUMENT                  = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3275)ILOCA
 3275 FORMAT('      LOCATION IN ARGUMENT LIST = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3276)IARGT(ILOCA)
 3276 FORMAT('      ARGUMENT TYPE             = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3277)
 3277 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3278)(IANS(I),I=1,IWIDTH)
 3278 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3280 CONTINUE
C
CCCCC THE OUTPUT MESSAGE IN THE FOLLOWING SECTION WAS       MAY 1994
CCCCC COMMENTED OUT BECAUSE IT WAS GETTING IN THE WAY       MAY 1994
CCCCC WHEN PLOTTING AN INDIVIDUAL POINT                     MAY 1994
C
      IF(START.NE.STOP.AND.AINC.NE.0.0)GOTO3870
CCCCC WRITE(ICOUT,3281)
C3281 FORMAT('***** NOTE FROM DPPLO3--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3282)
C3282 FORMAT('      THE LOWER AND UPPER LIMITS')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3283)
C3283 FORMAT('      OF THE FUNCTION INTERVAL OF INTEREST')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3284)
C3284 FORMAT('      ARE IDENTICAL; OR THE INCREMENT')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3285)
C3285 FORMAT('      IS IDENTICALLY ZERO.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3286)START
C3286 FORMAT('      FIRST  LIMIT = ',D15.8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3287)AINC
C3287 FORMAT('      INCREMENT    = ',D15.8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3288)STOP
C3288 FORMAT('      SECOND LIMIT = ',D15.8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3289)
C3289 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IF(IWIDTH.GE.1)WRITE(ICOUT,3290)(IANS(I),I=1,IWIDTH)
C3290 FORMAT('      ',100A1)
CCCCC IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3291)
C3291 FORMAT('      RESULTING ACTION--ONLY A SINGLE POINT ',
CCCCC1'WAS OUTPUTTED FOR PLOTTING.')
CCCCC CALL DPWRST('XXX','BUG ')
      NUMIT=1
      GOTO3880
 3870 CONTINUE
C
C     *****THE FOLLOWING CORRECTIVE LINE ADDED AUGUST 1983*****
      IF(START.EQ.STOP)AINC=0.0
      IF(START.LT.STOP.AND.AINC.LT.0.0)AINC=-AINC
      IF(START.GT.STOP.AND.AINC.GT.0.0)AINC=-AINC
C
C     *****THE FOLLOWING 2 CORRECTIVE LINES ADDED AUGUST 1983*****
      IF(AINC.EQ.0.0)NUMIT=1
      IF(AINC.NE.0.0)NUMIT=(STOP-START)/AINC
      IF(NUMIT.LT.0)NUMIT=-NUMIT
      NUMIT=NUMIT+1
C
 3880 CONTINUE
C               ***********************************************************
C               **  STEP 5--                                             **
C               **  EXTRACT THE FUNCTIONAL                               **
C               **  EXPRESSION FROM THE INPUT COMMAND LINE.              **
C               ***********************************************************
C
      ISTEPN='5'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
      MAXN4=MAXCHF
C
      IF(IHARG(2).EQ.'=   '.AND.IHARG2(2).EQ.'    ')IWD1='=   '
      IF(IHARG(2).EQ.'=   '.AND.IHARG2(2).EQ.'    ')IWD12='    '
      IF(IHARG(2).NE.'=   '.OR.IHARG2(2).NE.'    ')IWD1='PLOT'
      IF(IHARG(2).NE.'=   '.OR.IHARG2(2).NE.'    ')IWD12='    '
      IWD2='FOR'
      IWD22=' '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2F,IBUGG3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3379
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3371)
 3371 FORMAT('***** ERROR IN DPPLO3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3372)
 3372 FORMAT('      INVALID COMMAND FORM FOR FUNCTION PLOTTING.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3373)
 3373 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3374)
 3374 FORMAT('      PLOT ... = ...  ',
     1'FOR ... = ... ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3375)
 3375 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3376)(IANS(I),I=1,IWIDTH)
 3376 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3379 CONTINUE
C
C               ***********************************************************
C               **  STEP 5.1--                                           **
C               **  FIRST CHECK TO SEE IF HAVE THE VERTICAL LINES CASE;  **
C               **  THEN EXTRACT THE UNDERLYING FUNCTION FROM            **
C               **  FUNCTION DEFINITIONS.                                **
C               ***********************************************************
C
      ISTEPN='5.1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IVERTI='NO'
      IVERT1=0
      IVERT2=0
      DO3380I=1,NUMARG
      IF(IHARG(I).EQ.'VERT'.AND.IHARG2(I).EQ.'ICAL')GOTO3385
 3380 CONTINUE
      GOTO3399
 3385 CONTINUE
C
CCCCC IMAX=N2F-12               NOVEMBER 1986
CCCCC IF(IMAX.LE.0)GOTO3389     NOVEMBER 1986
CCCCC DO3386I=1,IMAX            NOVEMBER 1986
      I=1
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
      IF(IP7.GT.N2F)GOTO3389
      IF(IFUNC2(I).NE.'V')GOTO3386
      IF(IFUNC2(IP1).NE.'E')GOTO3386
      IF(IFUNC2(IP2).NE.'R')GOTO3386
      IF(IFUNC2(IP3).NE.'T')GOTO3386
      IF(IFUNC2(IP4).NE.'I')GOTO3386
      IF(IFUNC2(IP5).NE.'C')GOTO3386
      IF(IFUNC2(IP6).NE.'A')GOTO3386
      IF(IFUNC2(IP7).NE.'L')GOTO3386
      IVERTI='YES'
      IVERT1=I
      IVERT2=IP7
      IP8=I+8
      IP9=I+9
      IP10=I+10
      IF(IP8.GT.N2F)GOTO3389
      IF(IFUNC2(IP8).EQ.' ')IVERT2=IP8
      IF(IP10.GT.N2F)GOTO3389
      IF(IFUNC2(IP8).EQ.'L'.AND.IFUNC2(IP9).EQ.'Y'.AND.
     1IFUNC2(IP10).EQ.' ')IVERT2=IP10
      GOTO3389
 3386 CONTINUE
 3389 CONTINUE
C
      IF(IVERTI.EQ.'NO')GOTO3399
      IC=0
      DO3391I=1,N2F
      IF(IVERT1.LE.I.AND.I.LE.IVERT2)GOTO3391
      IC=IC+1
      IFUNC2(IC)=IFUNC2(I)
 3391 CONTINUE
      N2FOLD=N2F
      N2FNEW=IC
C
      N2FNP1=N2FNEW+1
      IF(N2FNP1.GT.N2FOLD)GOTO3393
      DO3392IC=N2FNP1,N2FOLD
      IFUNC2(IC)=' '
 3392 CONTINUE
 3393 CONTINUE
      N2F=N2FNEW
 3399 CONTINUE
C
      CALL DPEXFU(IFUNC2,N2F,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3F,MAXN3,
     1IBUGG3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
CCCCC J=0
CCCCC DO3390I=1,N3F
CCCCC J=J+1
CCCCC IA(J)=IFUNC3(I)
C3390 CONTINUE
CCCCC NUMCHA=J
C
C               **********************************************************
C               **  STEP 6--                                            **
C               **  MAKE A NON-CALCULATING PASS AT THE FUNCTION         **
C               **  SO AS TO EXTRACT ALL PARAMETER AND VARIABLE NAMES.  **
C               **********************************************************
C
      ISTEPN='6'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      IPASS=1
      CALL COMPIM(IFUNC3,N3F,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,AJUNK,
     1IBUGCO,IBUGEV,IERROR)
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,3411)NUMPV,IPARN(1),IPARN2(1),
     1PARAM(1)
 3411 FORMAT('NUMPV,IPARN(1),IPARN2(1),PARAM(1) = ',
     1I8,2X,A4,2X,A4,E15.7)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***********************************************
C               **  STEP 7--                                  **
C               **  CHECK THAT ALL PARAMETERS                **
C               **  IN THE FUNCTION ARE ALREADY PRESENT      **
C               **  IN THE AVAILABLE NAME LIST IHNAME(.).    **
C               **  ALSO CHECK THAT THE VARIABLE NAME        **
C               **  THAT FOLLOWS FOR (THAT IS, THE DUMMY VARIABLE) **
C               **  IS IN THE FUNCTION.                      **
C               ***********************************************
C
      ISTEPN='7'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IP=0
      IV=0
      IF(NUMPV.LE.0)GOTO3650
      DO3600J=1,NUMPV
      IHPARN=IPARN(J)
      IHPAR2=IPARN2(J)
      IF(IHPARN.EQ.IVDU11.AND.IHPAR2.EQ.IVDU12)GOTO3620
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHPARN,IHPAR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
 3610 CONTINUE
      IP=IP+1
      PARAM(J)=VALUE(ILOCP)
      GOTO3600
C
 3620 CONTINUE
      IV=IV+1
      LOCDU1=J
 3600 CONTINUE
 3650 CONTINUE
CCCCC THE FOLLOWING 5 LINES WERE ADDED   APRIL 1992 (JJF)
      IF(LOCDU1.LE.0)THEN
         IV=IV+1
         NUMPV=NUMPV+1
         LOCDU1=NUMPV
      ENDIF
      NUMPAR=IP
      NUMVAR=IV
C
C               ******************************
C               **  STEP 8--                **
C               **  EVALUATE THE FUNCTION.  **
C               ******************************
C
      ISTEPN='8'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPASS=2
      L=NPLOTP
      L2=L
      DO3800I=1,NUMIT
      I2=I
      I2M1=I2-1
      AI=I
      RESULT=START+(AI-1.0)*AINC
C
      IF(I.EQ.1)GOTO3819
      IF(START.LT.STOP.AND.RESULT.GT.STOP)GOTO3888
      IF(START.GT.STOP.AND.RESULT.LT.STOP)GOTO3888
 3819 CONTINUE
      L2=L2+1
CCCCC WRITE(ICOUT,3818)I,RESULT,L,L2,MAXNPP
C3818 FORMAT('I,RESULT,L,L2,MAXNPP = ',I8,F15.7,3I8)
CCCCC CALL DPWRST('XXX','BUG ')
C
      IF(L2.LE.MAXNPP)GOTO3829
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3821)
 3821 FORMAT('***** PLOT FORMATION ERROR IN DPPLO3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3822)
 3822 FORMAT('      THE NUMBER OF PLOT POINTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3823)MAXNPP
 3823 FORMAT('      HAS JUST EXCEEDED ',I8,' *****')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3829 CONTINUE
C
      XTEMP=RESULT
C
      PARAM(LOCDU1)=XTEMP
      CALL COMPIM(IFUNC3,N3F,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,YTEMP,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(IVERTI.EQ.'NO')GOTO3839
      HOLD=YTEMP
      YTEMP=XTEMP
      XTEMP=HOLD
 3839 CONTINUE
C
      Y(L2)=YTEMP
      X(L2)=XTEMP
      IF(IAND1.EQ.'NO')D(L2)=1.0
      IF(IAND1.EQ.'YES')D(L2)=1.0+DEL
 3800 CONTINUE
      N2=I2
      GOTO3889
 3888 CONTINUE
      N2=I2M1
 3889 CONTINUE
      L=L2
      NPLOTP=L
C
C               *****************************
C               **  STEP 9--               **
C               **  DETERMINE THE NUMBER   **
C               **  OF PLOT VARIABLES.     **
C               **  STORE THIS IN NPLOTV.  **
C               *****************************
C
      ISTEPN='9'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DHOLD=D(1)
      DO3830I=1,NPLOTP
      IF(D(I).NE.DHOLD)GOTO3835
 3830 CONTINUE
      NPLOTV=2
      GOTO3890
 3835 CONTINUE
      NPLOTV=3
      GOTO3890
C
 3890 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPLO3--')
      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,MAXNPP,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,MAXNPP,ICASPL,IAND1,IAND2 = ',
     14I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IANGLU,IBUGG3,IBUGCO,IBUGEV,IBUGQ
 9014 FORMAT('IANGLU,IBUGG3,IBUGCO,IBUGEV,IBUGQ = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFOUND,IERROR
 9015 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPLOT(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--FORM A Y PLOT, A Y VS. X PLOT, A SUBSET PLOT,
C              AND OTHER SIMILAR TYPE PLOTS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --JANUARY   1978.
C     UPDATED         --FEBRUARY  1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --MARCH     1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     1992. FIX PLOT WITH NO ARGS
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 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW2HOL
      CHARACTER*4 IW22HO
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
C     ***** THE FOLLOWING 4 DIMENSIONS RAISED FROM 150 TO 225 AUGUST 1983 *****
C     ***** THE FOLLOWING 4 DIMENSIONS RAISED FROM 225 TO 1000 AUGUST 1986 *****
CCCCC DIMENSION ITYPEH(225)
CCCCC DIMENSION IW2HOL(225)
CCCCC DIMENSION IW22HO(225)
CCCCC DIMENSION W2HOLD(225)
      DIMENSION ITYPEH(1000)
      DIMENSION IW2HOL(1000)
      DIMENSION IW22HO(1000)
      DIMENSION W2HOLD(1000)
C
      DIMENSION PARAM(100)
      DIMENSION IPARN(100)
      DIMENSION IPARN2(100)
C
      DIMENSION IVSLOC(100)
      DIMENSION IEQLOC(100)
      DIMENSION IFOLOC(100)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPPL'
      ISUBN2='OT  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
C     ***** THE FOLLOWING 6 LINES INSERTED AUGUST 1983 *****
CCCCC DO40I=1,225
      DO40I=1,1000
      ITYPEH(I)='    '
      IW2HOL(I)='    '
      IW22HO(I)='    '
      W2HOLD(I)=0.0
   40 CONTINUE
C
C               ***************************
C               **  TREAT THE PLOT CASE  **
C               ***************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPLOT--')
      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,IBUGCO,IBUGEV,IBUGQ
   54 FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IFOUND,IERROR
   55 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)MAXNPP
   56 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 1--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=0
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *******************************************
C               **  STEP 2--                             **
C               **  DETERMINE IF HAD OR HAVE THE 'AND'   **
C               **  CONTINUATION CASE.                   **
C               **  IF THE PREVIOUS PLOT COMMAND LINE    **
C               **  HAD AN 'AND' CONTINUATION,           **
C               **  OR IF THE PRESENT PLOT COMMAND LINE  **
C               **  HAS AN 'AND' CONTINUATION,           **
C               **  THEN SET SOME FLAG VARIABLES.        **
C               *******************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IAND1.EQ.'NO')NPLOTV=0
      IF(IAND1.EQ.'NO')NPLOTP=0
      IAND2='NO'
      IF(NUMARG.LE.0)IAND2='NO'
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(NUMARG.GE.1.AND.IHARG(NUMARG).EQ.'AND')IAND2='YES'
      IF(NUMARG.GE.1)THEN
         IF(IHARG(NUMARG).EQ.'AND')IAND2='YES'
      ENDIF
      L=NPLOTP
C
C               ***************************************
C               **  STEP 3--                         **
C               **  DETERMINE THE TYPE OF PLOT CASE  **
C               **  (FOR THIS COMMAND LINE ONLY)--   **
C               **       1)  PLOT                    **
C               **       2)  PLOT ... VERSUS         **
C               **       3)  PLOT ... FOR X =        **
C               **       4)  OTHER THAN THE ABOVE.   **
C               ***************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO800
      GOTO809
  800 CONTINUE
      ICASPL='NODA'
      IFOUND='YES'
      IERROR='NO'
      NS=0
      GOTO9000
  809 CONTINUE
C
      ICASPL='NOVE'
C
      NUMEQ=0
      NUMFO=0
      NUMVS=0
      NUMDV=0
      DO811J=1,NUMARG
      J2=J
      IF(IHARG(J).EQ.'=')GOTO816
      IF(IHARG(J).EQ.'VS')GOTO826
      IF(IHARG(J).EQ.'VS.')GOTO826
      IF(IHARG(J).EQ.'VERS'.AND.IHARG2(J).EQ.'US  ')GOTO826
      IF(IHARG(J).EQ.'FOR')GOTO836
      GOTO811
C
  816 CONTINUE
      NUMEQ=NUMEQ+1
      IEQLOC(NUMEQ)=J2
      GOTO811
C
  826 CONTINUE
      NUMVS=NUMVS+1
      IVSLOC(NUMVS)=J2
      GOTO811
C
  836 CONTINUE
      JP1=J+1
      IF(JP1.GT.NUMARG)GOTO837
      IF(IHARG(JP1).EQ.'I   '.AND.IHARG2(JP1).EQ.'    ')GOTO837
      IF(IHARG(JP1).EQ.'ROW '.AND.IHARG2(JP1).EQ.'    ')GOTO837
      NUMDV=NUMDV+1
  837 CONTINUE
      NUMFO=NUMFO+1
      IFOLOC(NUMFO)=J2
      GOTO811
C
  811 CONTINUE
C
      IF(NUMEQ.EQ.0)ICASPL='NOVE'
      IF(NUMEQ.EQ.1.AND.NUMFO.EQ.1.AND.NUMDV.LE.0)ICASPL='NOVE'
      IF(NUMEQ.EQ.1.AND.NUMFO.EQ.1.AND.NUMDV.GE.1)ICASPL='EFE'
      IF(NUMEQ.GE.2)ICASPL='EFE'
      IF(NUMVS.GE.1)ICASPL='VS'
C
  899 CONTINUE
C
C               ******************************************
C               **  STEP 4--                            **
C               **  BRANCH ACCORDING TO THE PLOT CASE.  **
C               ******************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUND='YES'
C
      IF(ICASPL.EQ.'NOVE')GOTO1000
      IF(ICASPL.EQ.'VS')GOTO2000
      IF(ICASPL.EQ.'EFE')GOTO3000
C
 1000 CONTINUE
      CALL DPPLO1(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1MAXNPP,
     1IBUGG3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 2000 CONTINUE
      CALL DPPLO2(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IVSLOC,NUMVS,
     1MAXNPP,
     1IBUGG3,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
 3000 CONTINUE
      CALL DPPLO3(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1PARAM,IPARN,IPARN2,NUMPAR,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,
     1IFOLOC,
     1MAXNPP,
     1IANGLU,IBUGG3,IBUGCO,IBUGEV,IBUGQ,IFOUND,IERROR)
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF DPPLOT--')
      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)IANGLU,IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ
 9014 FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)MAXNPP
 9016 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)
 9020 FORMAT('I,Y(.),X(.),D(.),ISUB(.)--')
      CALL DPWRST('XXX','BUG ')
      DO9021I=1,NPLOTP
      WRITE(ICOUT,9022)I,Y(I),X(I),D(I),ISUB(I)
 9022 FORMAT(I8,E15.7,E15.7,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPLSY(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A SYMBOL PLOT--
C              THE COMMAND HAS THE FOLLOWING FORMAT:
C                  SYMBOL PLOT Y X <SIZE> <SYMBOL> <COLOR> <FILL>
C              ONLY THE Y VARIABLE IS REQUIRED.  IF ONLY Y AND X ARE
C              GIVEN, THIS COMMAND IS SIMILAR TO THE PLOT Y X
C              COMMAND.  IF A SIZE VARIABLE IS GIVEN, THE CHARACTER
C              SIZE OF PLOT CHARACTER WILL BE SCALED ACCORDING TO THAT
C              VARIABLE.  THE SYMBOL VARIABLE IDENTIFIES THE SYMBOL
C              TO USE (SPECIFY AS AN INDEX BETWEEN 1 AND 100, USE THE
C              CORRESPONDING VALUE FROM THE CHARACTER ...  COMMAND).
C              THE COLOR COMMAND IDENTIFIES THE COLOR FOR THE PLOT
C              CHARACTER (AGAIN AN INDEX FROM 1 TO 100, USE CHAR COLOR
C              COMMAND SETTINGS).  THE FILL VARIABLE IDENTIFIES
C              WHETHER THE PLOT SYMBOL WILL BE FILLED (0 FOR NO FILL
C              ANYTHING ELSE TO FILL WITH SOLID PATTERN).
C                   PLSYOR ARROW <FIXED/VARIABLE>
C     EXAMPLE--SYMBOL PLOT Y X  SIZE SYMBOL COLOR FILL
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--92/8
C     ORIGINAL VERSION--AUGUST    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
CCCCC CHARACTER*4 IHRI11
CCCCC CHARACTER*4 IHRI12
      CHARACTER*4 IH1
      CHARACTER*4 IH2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION Y3(MAXOBV)
      DIMENSION Y4(MAXOBV)
      DIMENSION Y5(MAXOBV)
      DIMENSION Y6(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
      EQUIVALENCE (GARBAG(IGARB4),Y4(1))
      EQUIVALENCE (GARBAG(IGARB5),Y5(1))
      EQUIVALENCE (GARBAG(IGARB6),Y6(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      IFOUND='NO'
C
      ISUBN1='DPPL'
      ISUBN2='SY  '
C
      ICASPL='SYMB'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=6
      MINN2=1
C
      ICOLH=0
C
C               ***********************************
C               **  TREAT THE SYMBOL PLOT CASE   **
C               ***********************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PLSY')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPLSY--')
      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 ')
      WRITE(ICOUT,54)MAXN
   54 FORMAT('MAXN = ',I8)
      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.'PLSY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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               **  AT LEAST 1 REQUIRED                              **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PLSY')
     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 2.1--                         **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='2.1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PLSY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PLSY')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               **************************************************
C               **  STEP 2.2--                                  **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **************************************************
C
      ISTEPN='2.2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PLSY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.GE.1.AND.NUMV2.LE.6)GOTO2290
C
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPPLSY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      ILLEGAL SYNTAX--THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      TO BE INCLUDED AS ARGUMENTS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      IN A SYMBOL PLOT COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      MUST BE AT LEAST 1 AND AT MOST 6;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)NUMV2
 2216 FORMAT('      SUCH WAS NOT THE CASE HERE.  NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)
 2217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2218)(IANS(I),I=1,IWIDTH)
 2218 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
C
C               ***************************************
C               **  STEP 2.3                         **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               ***************************************
C
      ISTEPN='2.3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PLSY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2300I=1,NUMV2
      IH1=IHARG(I)
      IH2=IHARG2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH1,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(I.EQ.1)ICOL1=IVALUE(ILOCV)
      IF(I.EQ.2)ICOL2=IVALUE(ILOCV)
      IF(I.EQ.3)ICOL3=IVALUE(ILOCV)
      IF(I.EQ.4)ICOL4=IVALUE(ILOCV)
      IF(I.EQ.5)ICOL5=IVALUE(ILOCV)
      IF(I.EQ.6)ICOL6=IVALUE(ILOCV)
      IF(I.EQ.1)N1=IN(ILOCV)
      IF(I.EQ.2)N2=IN(ILOCV)
      IF(I.EQ.3)N3=IN(ILOCV)
      IF(I.EQ.4)N4=IN(ILOCV)
      IF(I.EQ.5)N5=IN(ILOCV)
      IF(I.EQ.6)N6=IN(ILOCV)
 2300 CONTINUE
C
C               **************************************************
C               **  STEP 2.4--                                  **
C               **  CHECK THAT ALL ARGUMENTS                    **
C               **  HAVE THE SAME NUMBER OF OBSERVATIONS.       **
C               **************************************************
C
      ISTEPN='2.4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PLSY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N2.NE.N1)GOTO2410
      IF(NUMV2.LE.2)GOTO2490
      IF(N3.NE.N1)GOTO2410
      IF(NUMV2.LE.3)GOTO2490
      IF(N4.NE.N1)GOTO2410
      IF(NUMV2.LE.4)GOTO2490
      IF(N5.NE.N1)GOTO2410
      IF(NUMV2.LE.5)GOTO2490
      IF(N6.NE.N1)GOTO2410
      GOTO2490
C
 2410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2411)
 2411 FORMAT('***** ERROR IN DPPLSY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2412)
 2412 FORMAT('      FOR A SYMBOL PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2413)
 2413 FORMAT('      ALL VARIABLES MUST HAVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2414)
 2414 FORMAT('      THE SAME NUMBER OF ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2415)
 2415 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2421)N1
 2421 FORMAT('THE FIRST  VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.1)GOTO2490
      WRITE(ICOUT,2422)N2
 2422 FORMAT('THE SECOND VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.2)GOTO2490
      WRITE(ICOUT,2423)N3
 2423 FORMAT('THE THIRD  VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.3)GOTO2490
      WRITE(ICOUT,2424)N4
 2424 FORMAT('THE FOURTH VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.4)GOTO2490
      WRITE(ICOUT,2425)N5
 2425 FORMAT('THE FIFTH  VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.5)GOTO2490
      WRITE(ICOUT,2426)N6
 2426 FORMAT('THE SIXTH  VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2427)
 2427 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2428)(IANS(I),I=1,IWIDTH)
 2428 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2490 CONTINUE
C
C               ******************************************************
C               **  STEP 2.5--                                      **
C               **  CHECK THAT VARIABLES HAVE AT LEAST 1 ELEMENT    **
C               ******************************************************
C
 4100 CONTINUE
      ISTEPN='2.5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PLSY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.GE.1)GOTO2590
C
 2510 CONTINUE
      WRITE(ICOUT,2511)
 2511 FORMAT('***** ERROR IN DPPLSY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2513)
 2513 FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2514)
 2514 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2515)
 2515 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2516)IHRI11,IHRI12,N1
C2516 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
      WRITE(ICOUT,2516)N1
 2516 FORMAT('           VARIABLE HAS ',I8,' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2520)
 2520 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2521)(IANS(I),I=1,IWIDTH)
 2521 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2590 CONTINUE
C
C               *************************************************
C               **  STEP 3--                                   **
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               *************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PLSY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO3010
      IF(ICASEQ.EQ.'SUBS')GOTO3020
      IF(ICASEQ.EQ.'FOR')GOTO3030
C
 3010 CONTINUE
      DO3015I=1,N1
      ISUB(I)=1
 3015 CONTINUE
      NQ=N1
      GOTO3050
C
 3020 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3050
C
 3030 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3050
C
 3050 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO3060I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3060
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IF(NUMV2.LE.1)GOTO3060
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
      IF(NUMV2.LE.2)GOTO3060
      IJ=MAXN*(ICOL3-1)+I
      IF(ICOL3.LE.MAXCOL)Y3(J)=V(IJ)
      IF(ICOL3.EQ.MAXCP1)Y3(J)=PRED(I)
      IF(ICOL3.EQ.MAXCP3)Y3(J)=RES(I)
      IF(ICOL3.EQ.MAXCP3)Y3(J)=YPLOT(I)
      IF(ICOL3.EQ.MAXCP4)Y3(J)=XPLOT(I)
      IF(ICOL3.EQ.MAXCP5)Y3(J)=X2PLOT(I)
      IF(ICOL3.EQ.MAXCP6)Y3(J)=TAGPLO(I)
C
      IF(NUMV2.LE.3)GOTO3060
      IJ=MAXN*(ICOL4-1)+I
      IF(ICOL4.LE.MAXCOL)Y4(J)=V(IJ)
      IF(ICOL4.EQ.MAXCP1)Y4(J)=PRED(I)
      IF(ICOL4.EQ.MAXCP4)Y4(J)=RES(I)
      IF(ICOL4.EQ.MAXCP3)Y4(J)=YPLOT(I)
      IF(ICOL4.EQ.MAXCP4)Y4(J)=XPLOT(I)
      IF(ICOL4.EQ.MAXCP5)Y4(J)=X2PLOT(I)
      IF(ICOL4.EQ.MAXCP6)Y4(J)=TAGPLO(I)
C
      IF(NUMV2.LE.4)GOTO3060
      IJ=MAXN*(ICOL5-1)+I
      IF(ICOL5.LE.MAXCOL)Y5(J)=V(IJ)
      IF(ICOL5.EQ.MAXCP1)Y5(J)=PRED(I)
      IF(ICOL5.EQ.MAXCP5)Y5(J)=RES(I)
      IF(ICOL5.EQ.MAXCP3)Y5(J)=YPLOT(I)
      IF(ICOL5.EQ.MAXCP4)Y5(J)=XPLOT(I)
      IF(ICOL5.EQ.MAXCP5)Y5(J)=X2PLOT(I)
      IF(ICOL5.EQ.MAXCP6)Y5(J)=TAGPLO(I)
C
      IF(NUMV2.LE.5)GOTO3060
      IJ=MAXN*(ICOL6-1)+I
      IF(ICOL6.LE.MAXCOL)Y6(J)=V(IJ)
      IF(ICOL6.EQ.MAXCP1)Y6(J)=PRED(I)
      IF(ICOL6.EQ.MAXCP6)Y6(J)=RES(I)
      IF(ICOL6.EQ.MAXCP3)Y6(J)=YPLOT(I)
      IF(ICOL6.EQ.MAXCP4)Y6(J)=XPLOT(I)
      IF(ICOL6.EQ.MAXCP5)Y6(J)=X2PLOT(I)
      IF(ICOL6.EQ.MAXCP6)Y6(J)=TAGPLO(I)
C
 3060 CONTINUE
      NLOCAL=J
C
 
C
C               *******************************************************
C               **  STEP 8--                                         **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS            **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.               **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).    **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).    **
C               *******************************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PLSY')GOTO5099
      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      WRITE(ICOUT,5001)NLOCAL,ICASPL
 5001 FORMAT('NLOCAL,ICASPL=',I5,1X,A4)
      CALL DPWRST('XXX','BUG ')
 5099 CONTINUE
C
      CALL DPPLS2(Y1,Y2,Y3,Y4,Y5,Y6,NLOCAL,ICASPL,NUMV2,
     1Y,X,D,DSIZE,DSYMB,DCOLOR,DFILL,
     1NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 9--   **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PLSY')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPLSY--')
      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,NLOCAL,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NLOCAL,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)NLOCAL
 9041 FORMAT('NLOCAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NLOCAL.LE.0)GOTO9044
      DO9042I=1,NLOCAL
      WRITE(ICOUT,9043)I,Y1(I),Y2(I),Y3(I),Y4(I),Y5(I),Y6(I)
 9043 FORMAT('I,Y1(I),Y2(I),Y3(I),Y4(I)Y5(I),Y(6) = ',
     1 I8,6E15.7)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
 9044 CONTINUE
      WRITE(ICOUT,9051)NPLOTP
 9051 FORMAT('NPLOTP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9054
      DO9052I=1,NPLOTP
      WRITE(ICOUT,9053)I,Y(I),X(I),D(I),DSIZE(I),DSYMB(I),DCOLOR(I),
     1DFILL(I)
 9053 FORMAT('I,Y(I),X(I),D(I),DSIZE(I),DSYMB(I),DCOLOR(I),',
     1 'DFILL(I) = ',I8,7F12.5)
      CALL DPWRST('XXX','BUG ')
 9052 CONTINUE
 9054 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPLS2(Y1,Y2,Y3,Y4,Y5,Y6,NZ,ICASPL,NUMV2,
     1Y,X,D,DSIZE,DSYMB,DCOLOR,DFILL,
     1N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A SYMBOL PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--92/8
C     ORIGINAL VERSION--AUGUST    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 Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y3(*)
      DIMENSION Y4(*)
      DIMENSION Y5(*)
      DIMENSION Y6(*)
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
      DIMENSION DSIZE(*)
      DIMENSION DSYMB(*)
      DIMENSION DCOLOR(*)
      DIMENSION DFILL(*)
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='DPPL'
      ISUBN2='S2  '
C
      IERROR='NO'
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 DPPLS2--')
      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.'PLS2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPPLS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,NZ,N2,NPLOTV,NUMV2
   72 FORMAT('ICASPL,NZ,N2,NPLOTV,NUMV2 = ',A4,2X,4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO83
CCCCC DO81I=1,NZ
CCCCC WRITE(ICOUT,82)I,Y1(I),Y2(I),Y3(I),Y4(I),Y5(I),Y6(I)
CCC82 FORMAT('I,Y1(I),Y2(I),Y3(I),Y4(I),Y5(I),Y6(I) = ',
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC1 I8,6E12.5)
   81 CONTINUE
   83 CONTINUE
   90 CONTINUE
C
C               ****************************************
C               **  STEP 1--                          **
C               **  INITIALIZE DSIZE, ETC.            **
C               ****************************************
C
      DO100I=1,NZ
      Y(I)=Y1(I)
      D(I)=1.0
      DSIZE(I)=1.0
      DSYMB(I)=1.0
      DCOLOR(I)=1.0
      DFILL(I)=0.0
 100  CONTINUE
C
C               ****************************************
C               **  STEP 2--                          **
C               **  IF NO X, CREATE IT                **
C               ****************************************
C
      IF(NUMV2.LT.2)THEN
        DO200I=1,NZ
        X(I)=REAL(I)
 200    CONTINUE
        GOTO8000
      ELSE
        DO210I=1,NZ
        X(I)=Y2(I)
 210    CONTINUE
      ENDIF
C
C               ****************************************
C               **  STEP 3--                          **
C               **  HANDLE THE SIZE VARIABLE          **
C               ****************************************
C
      IF(NUMV2.LT.3)GOTO8000
        AMAXSZ=0.0
        DO300I=1,NZ
        ATEMP=ABS(Y3(I))
        IF(ATEMP.GT.AMAXSZ)AMAXSZ=ATEMP
 300    CONTINUE
        DO310I=1,NZ
        ATEMP=ABS(Y3(I))/AMAXSZ
        IF(ATEMP.GT.1.0)ATEMP=1.0
        IF(ATEMP.LT.0.05)ATEMP=0.05
        DSIZE(I)=ATEMP
 310  CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PLS2')GOTO390
      WRITE(ICOUT,371)
  371 FORMAT('***** AFTER CALCULATING SIZE --')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,372)AMAXSZ
  372 FORMAT('AMAXSZ = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO381I=1,10
      WRITE(ICOUT,382)I,Y3(I),DSIZE(I)
  382 FORMAT('I,Y3(I),DSIZE(I) = ',I4,E15.7,1X,F8.5)
      CALL DPWRST('XXX','BUG ')
  381 CONTINUE
  390 CONTINUE
C
C               ****************************************
C               **  STEP 4--                          **
C               **  HANDLE THE SYMBOL VARIABLE        **
C               **  SHOULD BE AN INDEX BETWEEN 1 AND  **
C               **  100                               **
C               ****************************************
C
      IF(NUMV2.LT.4)GOTO8000
        DO400I=1,NZ
        DSYMB(I)=Y4(I)
        DSYMB(I)=ABS(DSYMB(I))
        IF(DSYMB(I).LT.0.5)DSYMB(I)=1.0
        IF(DSYMB(I).GT.99.5)DSYMB(I)=100.0
 400  CONTINUE
C
C               ****************************************
C               **  STEP 5--                          **
C               **  HANDLE THE COLOR  VARIABLE        **
C               **  SHOULD BE AN INDEX BETWEEN 1 AND  **
C               **  100                               **
C               ****************************************
C
      IF(NUMV2.LT.5)GOTO8000
        DO500I=1,NZ
        DCOLOR(I)=Y5(I)
        DCOLOR(I)=ABS(DCOLOR(I))
        IF(DCOLOR(I).LT.0.5)DCOLOR(I)=1.0
        IF(DCOLOR(I).GT.99.5)DCOLOR(I)=100.0
 500  CONTINUE
C
C               ****************************************
C               **  STEP 6--                          **
C               **  HANDLE THE FILL   VARIABLE        **
C               **  SHOULD BE 0 FOR NO FILL, ANYTHING **
C               **  ELSE FOR SOLID FILL               **
C               ****************************************
C
      IF(NUMV2.LT.5)GOTO8000
        DO600I=1,NZ
        DFILL(I)=Y6(I)
        IF(DFILL(I).GE.-0.5.AND.DFILL(I).LE.0.5)THEN
          DFILL(I)=0.0
        ELSE
          DFILL(I)=1.0
        ENDIF
 600  CONTINUE
C
 8000 CONTINUE
      N2=NZ
      NPLOTV=3
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PLS2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPLS2--')
      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 ')
CCCCC WRITE(ICOUT,9013)N2,J,K
C9013 FORMAT('N2,J,K = ',3I8)
      WRITE(ICOUT,9013)N2
 9013 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO9023
      DO9021I=1,NZ
      WRITE(ICOUT,9022)I,Y1(I),Y2(I),Y3(I),Y4(I)
 9022 FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,4E12.5)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9023 CONTINUE
      WRITE(ICOUT,9031)N2,NPLOTV
 9031 FORMAT('N2,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,N2
      WRITE(ICOUT,9036)I,Y(I),X(I),D(I)
 9036 FORMAT('I,Y(I),X(I),D(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPMTI(IANS,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--EXTRACT THE STRING TO BE USED AS A TITLE
C              FOR SUBSEQUENT SAVED PIXMAPS;
C     INPUT  ARGUMENTS--IANS   (A  CHARACTER VECTOR)
C                     --IWIDTH
C                     --IHARG  (A  CHARACTER VECTOR)
C                     --IHARG2  (A  CHARACTER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--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--97/4
C     ORIGINAL VERSION--APRIL      1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
      DIMENSION IANSLC(*)
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPM.INC'
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(IBUGP2.NE.'ON')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPPMTI--')
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C     *****************************************
C     **  STEP 1--                           **
C     **  DETERMINE THE COMMAND              **
C     **  (TITLE) AND ITS LOCATION           **
C     **  ON THE LINE.                       **
C     *****************************************
C
      DO1000I=1,IWIDTH
      I2=I
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IF(IANS(I).EQ.'T'.AND.IANS(IP1).EQ.'I'
     1.AND.IANS(IP2).EQ.'T'.AND.IANS(IP3).EQ.'L'
     1.AND.IANS(IP4).EQ.'E')
     1GOTO100
C
 1000 CONTINUE
      WRITE(ICOUT,1001)
 1001 FORMAT('***** ERROR IN DPPMTI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1002)
 1002 FORMAT('      NO MATCH FOR COMMAND.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO800
C
C     **********************************************************
C     **  STEP 2--                                            **
C     **  DEFINE THE START POSITION (ISTART) FOR THE STRING.  **
C     **********************************************************
C
  100 CONTINUE
      ISTART=I2+6
      GOTO300
C
C     ********************************************************
C     **  STEP 3--                                          **
C     **  DEFINE THE STOP POSITION (ISTOP) FOR THE STRING.  **
C     ********************************************************
C
  300 CONTINUE
      IFOUND='YES'
      ISTOP=0
      IF(ISTART.GT.IWIDTH)GOTO329
      DO320I=ISTART,IWIDTH
      IREV=IWIDTH-I+ISTART
      IF(IANS(IREV).NE.' ')GOTO325
  320 CONTINUE
      GOTO329
  325 CONTINUE
      ISTOP=IREV
  329 CONTINUE
C
C     *****************************************
C     **  STEP 4--                           **
C     **  COPY OVER THE STRING OF INTEREST.  **
C     *****************************************
C
      IF(ISTART.GT.ISTOP)GOTO359
      IF(ISTOP.EQ.0)GOTO359
      IPXMCM(NUMPXM+1)=' '
      J=0
      DO350I=ISTART,ISTOP
      J=J+1
      IPXMCM(NUMPXM+1)(J:J)=IANSLC(I)(1:1)
  350 CONTINUE
      NCTITL=J
      GOTO800
  359 CONTINUE
C
C     ************************************
C     **  STEP 5--                      **
C     **  TREAT THE EMPTY-STRING CASE.  **
C     ************************************
C
      NCTITL=0
      GOTO800
C
C     ***************************
C     **  STEP 6--             **
C     **  PRINT OUT A MESSAGE  **
C     ***************************
C
  800 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO889
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,811)
  811 FORMAT('THE TITLE FOR THE NEXT SAVED PIXMAP HAS JUST BEEN ',
     1'SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCTITL.EQ.0)THEN
        WRITE(ICOUT,999)
      ELSE IF(NCTITL.GE.1)THEN
        WRITE(ICOUT,812)(IPXMCM(NUMPXM+1)(I:I),I=1,NCTITL)
      ENDIF
      CALL DPWRST('XXX','BUG ')
  812 FORMAT(10X,120A1)
  889 CONTINUE
      GOTO9000
C
C     ****************
C     **  STEP 90-- **
C     **  EXIT      **
C     ****************
C
 9000 CONTINUE
      IF(IBUGP2.NE.'ON')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPPMTI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NCTITL
 9012 FORMAT('NCTITL = ',I5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPOI2(X1,Y1,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A POINT
C              WITH THE COORDINATES (X1,Y1)
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(10)
      DIMENSION PY(10)
CCCCC DIMENSION PX3(10)
CCCCC DIMENSION PY3(10)
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.'POI2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPOI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',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 POINT              **
C               *********************************
C
      PX(1)=X1
      PY(1)=Y1
C
      PX(2)=X1
      PY(2)=Y1
C
      NP=2
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,
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.'POI2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPOI2--')
      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 DPPOIN(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 POINTS
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
C           POINT.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 1
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*1 = 2.
C     NOTE--IF NO NUMBERS ARE PROVIDED,
C           THEN THE DRAWN POINT WILL BE
C           AT THE LAST CURSOR POSITION
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN POINT WILL BE
C           AT THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE 2 NUMBERS
C     NOTE--AND SO FORTH FOR 2, 3, 4, ... 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.'POIN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPOIN--')
      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='POIN'
      NUMPT=1
      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 DPPOIN--')
      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 POINT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      AT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      BOX ABSOLUTE 20 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
      GOTO1170
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)
      GOTO1170
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
      X1=X2
      Y1=Y2
      GOTO1170
C
 1170 CONTINUE
      CALL DPPOI2(X1,Y1,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X1
      Y1=Y1
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X1
      PYEND=Y1
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.'POIN')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPOIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1
 9013 FORMAT('X1,Y1 = ',2E15.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 DPPOLY(
     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,
     1IDFONT,
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW A POLYGON
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES ARE AN ARRAY OF X AND Y VALUES
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--97/7
C     ORIGINAL VERSION--JULY      1997.
C
C-----NON-COMMON VARIABLES-----------------------------------------
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
      CHARACTER*4 IDFONT
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      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
      CHARACTER*4 IHFACT
      CHARACTER*4 IHFAC2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XP(MAXOBV)
      DIMENSION YP(MAXOBV)
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
      DIMENSION ICOLIV(2)
      DIMENSION NIV(2)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),XP(1))
      EQUIVALENCE (GARBAG(IGARB2),YP(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOM2.INC'
      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='YES'
      IERROR='NO'
      IERRG4=IERROR
      IBUGQ=IBUGD2
      ISUBN1='DPPO'
      ISUBN2='LY  '
C
      ILOCFN=0
      NPTS=0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'POLY')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPOLY--')
      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='POLY'
      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)
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO')GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA')GOTO1113
      IF(NUMARG.GE.2) GOTO1111
      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
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPPOLY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR POLYGON ',
     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 POLYGON ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH COORDINATES STORED IN THE ARRAYS X AND Y')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      POLYGON X Y')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      POLYGON ABSOLUTE X Y')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      POLYGON RELATIVE X Y')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  SEARCH FOR COMMAND ARGUMENTS       **
C               *****************************************
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
      DO530J=ILOCFN,ILOCFN+1
      IFAC=J-ILOCFN+1
      IHFACT=IHARG(IFAC)
      IHFAC2=IHARG2(IFAC)
      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(IBUGD2.EQ.'ON')WRITE(ICOUT,532)IFAC,IHFACT,IHFAC2,ICOLIV(IFAC),
     1NIV(IFAC)
  532 FORMAT('I,IHFACT,IHFAC2,ICOLIV(IFAC),NIV(IFAC) = ',
     1I8,2X,A4,2X,A4,I8,I8)
      IF(IBUGD2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  530 CONTINUE
C
      IF(NIV(1).NE.NIV(2))GOTO550
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPPOLY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A POLYGON, THE NUMBER OF ELEMENTS IN THE',
     1' TWO ARRAYS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      SHOULD HAVE THE SAME AS THE NUMBER OF ELEMENTS;')
      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('      THE TWO VARIABLES HAVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,566)NIV(ILOCFN),NIV(ILOCFN)
  566 FORMAT('      ',I8,I8,' ELEMENTS RESPECTIVELY.')
      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'
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NIV(1)
      ISUB(I)=1
  615 CONTINUE
      NQ=NIV(1)
      GOTO650
C
  620 CONTINUE
      NIOLD=NIV(1)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NIV(1)
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NIV(1)
      IF(NQ.LT.NIV(1))IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IJ=MAXN*(ICOLIV(1)-1)+I
      IF(ICOLIV(1).LE.MAXCOL)XP(J)=V(IJ)
      IF(ICOLIV(1).EQ.MAXCP1)XP(J)=PRED(I)
      IF(ICOLIV(1).EQ.MAXCP2)XP(J)=RES(I)
      IF(ICOLIV(1).EQ.MAXCP3)XP(J)=YPLOT(I)
      IF(ICOLIV(1).EQ.MAXCP4)XP(J)=XPLOT(I)
      IF(ICOLIV(1).EQ.MAXCP5)XP(J)=X2PLOT(I)
      IF(ICOLIV(1).EQ.MAXCP6)XP(J)=TAGPLO(I)
C
      ICOLR=ICOLIV(2)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)YP(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)YP(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)YP(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)YP(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)YP(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)YP(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)YP(J)=TAGPLO(I)
C
  660 CONTINUE
      NPTS=J
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
 1151 CONTINUE
C
      IF(UNITSW.EQ.'DATA')THEN
        CALL DPCODS('X',XP(1),XP(1),IBUGD2,ISUBRO,IERROR)
        CALL DPCODS('Y',YP(1),YP(1),IBUGD2,ISUBRO,IERROR)
      ENDIF
      DO1170I=2,NPTS
        IF(UNITSW.EQ.'DATA')THEN
          CALL DPCODS('X',XP(I),XP(I),IBUGD2,ISUBRO,IERROR)
          IF(ITYPEO.EQ.'RELA')XP(I)=XP(I-1)+XP(I)
          CALL DPCODS('Y',YP(I),YP(I),IBUGD2,ISUBRO,IERROR)
          IF(ITYPEO.EQ.'RELA')YP(I)=YP(I-1)+YP(I)
        ENDIF
C
 1170 CONTINUE
C
      CALL DPPOL2(XP,YP,NPTS,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      PXEND=XP(NPTS)
      PYEND=YP(NPTS)
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.'POLY')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPOLY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NPTS
 9012 FORMAT('ILOCFN,NPTS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPTS.GT.0)THEN
      DO9013I=1,NPTS
      WRITE(ICOUT,9014)I,XP(I),YP(I)
 9014 FORMAT('I,XP(I),YP(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9013 CONTINUE
      ENDIF
      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 DPPOL2(X,Y,NPTS,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A POLYGON
C              COORDINATES OF THE POLYGON ARE STORED IN
C              THE ARRAYS X AND Y
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/7
C     ORIGINAL VERSION--JULY      1997.
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IPATT2
      CHARACTER*4 IFIG
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 X(*)
      DIMENSION Y(*)
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.'POL2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPOL2--')
      CALL DPWRST('XXX','BUG ')
      DO52I=1,NPTS
      WRITE(ICOUT,53)I,X(I),Y(I)
   53 FORMAT('I,X,Y = ',I6,2E15.7)
   52 CONTINUE
      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 POLYGON            **
C               *********************************
C
C
      IF(X(1).EQ.X(NPTS).AND.Y(1).EQ.Y(NPTS))THEN
        NP=NPTS
      ELSE
        NP=NPTS+1
        X(NP)=X(1)
        Y(NP)=Y(1)
      ENDIF
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(X,Y,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,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(X,Y,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.'POL2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPOL2--')
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,X(I),Y(I)
 9016 FORMAT('I,X(I),Y(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 DPPOTP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBOOSS,ISEED,
     1ICAPSW,ICAPTY,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A PEAKS OVER THRESHOLD PLOT--
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-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--2005/4
C     ORIGINAL VERSION--APRIL     2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      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 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 IHP
      CHARACTER*4 IHP2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IWRITE
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION XTEMP1(MAXOBV)
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      DIMENSION XTEMP4(MAXOBV)
      DIMENSION XTEMP5(MAXOBV)
      DIMENSION XTEMP6(MAXOBV)
      DIMENSION XTEMP7(MAXOBV)
      DIMENSION XTEMP8(MAXOBV)
      DIMENSION XTEMP9(MAXOBV)
      DIMENSION XTMP10(MAXOBV)
      DIMENSION ITEMP1(MAXOBV)
      DIMENSION R(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),XTEMP1(1))
      EQUIVALENCE (GARBAG(IGARB3),XTEMP2(1))
      EQUIVALENCE (GARBAG(IGARB4),XTEMP3(1))
      EQUIVALENCE (GARBAG(IGARB5),XTEMP4(1))
      EQUIVALENCE (GARBAG(IGARB6),XTEMP5(1))
      EQUIVALENCE (GARBAG(IGARB7),XTEMP6(1))
      EQUIVALENCE (GARBAG(IGARB8),XTEMP7(1))
      EQUIVALENCE (GARBAG(IGARB9),XTEMP8(1))
      EQUIVALENCE (GARBAG(IGAR10),XTEMP9(1))
      EQUIVALENCE (GARBAG(JGAR11),XTMP10(1))
      EQUIVALENCE (GARBAG(JGAR12),R(1))
      EQUIVALENCE (IGARBG(1),ITEMP1(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      DATA MINSIZ/5/
      DATA MINSI2/30/
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPPO'
      ISUBN2='TP  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=MINSI2
C
      ICOLR=0
C
C               **************************************************
C               **  TREAT THE PEAKS OVER THRESHOLD    PLOT CASE **
C               **************************************************
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPPOTP--')
        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,ISUBRO
   53   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='POTP'
C
      IF(ICOM.EQ.'POT ')THEN
         IF(NUMARG.GE.1)THEN
            IF(IHARG(1).EQ.'PLOT')THEN
               ILASTC=1
               GOTO119
            ENDIF
         ENDIF
      ENDIF
C
      IF(ICOM.EQ.'PEAK')THEN
         IF(NUMARG.GE.3)THEN
            IF(IHARG(1).EQ.'OVER'.AND.IHARG(2).EQ.'THRE'.AND.
     1        IHARG(3).EQ.'PLOT')THEN
               ILASTC=3
               GOTO119
            ENDIF
         ENDIF
      ENDIF
C
      GOTO9000
C
  119 CONTINUE
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      IFOUND='YES'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')
     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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')THEN
        WRITE(ICOUT,311)IHLEFT,IHLEF2,ICOLL,NLEFT
  311   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     **
C               **  (NLEFT) FOR THE RESPONSE VARIABLE IS POSITIVE.  **
C               ******************************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,411)
  411   FORMAT('***** ERROR IN PEAKS OVER THRESHOLD PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,412)IHLEFT,IHLEF2
  412   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS IN VARIABLE ',
     1         A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,413)
  413   FORMAT('      FOR WHICH A PEAKS OVER THRESHOLD PLOT WAS TO')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,415)MINN2
  415   FORMAT('      HAVE BEEN FORMED MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,416)
  416   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,417)
  417   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
  418     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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,581)
  581   FORMAT('***** INTERNAL ERROR IN DPPOTP')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,582)
  582   FORMAT('      AT BRANCH POINT 481--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,583)
  583   FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH NUMARG HAD ',
     1         'PREVIOUSLY')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,585)NUMARG
  585   FORMAT('      PASSED THIS TEST ONCE ALREADY.  VALUE OF ',
     1         'NUMARG = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,586)
  586   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,417)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO500J=1,NUMARG
        J1=J
        IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')THEN
          ICASEQ='SUBS'
          ILOCQ=J1
          GOTO590
        ELSEIF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')THEN
          ICASEQ='SUBS'
          ILOCQ=J1
          GOTO590
        ELSEIF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')THEN
          ICASEQ='FOR'
          ILOCQ=J1
          GOTO590
        ENDIF
  500 CONTINUE
C
  590 CONTINUE
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')THEN
        WRITE(ICOUT,591)NUMARG,ILOCQ,ICASEQ
  591   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ******************************************************
C               **  STEP 6--                                        **
C               **  THIS COMMAND WILL ACCEPT EITHER A ONE VARIABLE  **
C               **  SYNTAX OR A TWO VARIABLE SYNTAX.  ZERO          **
C               **  OR MORE THAN TWO VARIABLES IS AN ERROR.         **
C               ******************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
C
      IF(NUMV2.EQ.2)THEN
        IHRIGH=IHARG(2)
        IHRIG2=IHARG2(2)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLR=IVALUE(ILOCV)
        NRIGH=IN(ILOCV)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')THEN
          WRITE(ICOUT,661)IHRIGH,IHRIG2,ICOLR,NRIGH
  661     FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGH = ',A4,A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(NRIGH.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,671)
  671     FORMAT('***** ERROR IN PEAKS OVER THRESHOLD PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,672)IHLEFT,IHLEF2
  672     FORMAT('      THE INPUT NUMBER OF OBSERVATIONS IN ',
     1           'VARIABLE ',A4,A4)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,673)
  673     FORMAT('      FOR WHICH A PEAKS OVER THRESHOLD PLOT WAS TO')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,675)
  675     FORMAT('      HAVE BEEN FORMED MUST BE AT LEAST 1;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,676)
  676     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,677)
  677     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,678)(IANS(I),I=1,MIN(80,IWIDTH))
  678       FORMAT(80A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
C
      ENDIF
C
      IF(NUMV2.GT.2 .OR. NUMV2.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,601)
  601   FORMAT('***** ERROR IN PEAKS OVER THRESHOLD PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,602)
  602   FORMAT('      FOR A PEAKS OVER THRESHOLD PLOT, THE NUMBER OF')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,609)
  609   FORMAT('      VARIABLES MUST BE 1 OR 2;  SUCH WAS NOT THE ',
     1         'CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,612)NUMV2
  612   FORMAT('      THE SPECIFIED NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,613)
  613   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
          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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'SUBS')THEN
        NIOLD=NLEFT
        CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
        NQ=NIOLD
      ELSEIF(ICASEQ.EQ.'FOR')THEN
        NIOLD=NLEFT
        CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1             NLOCAL,ILOCS,NS,IBUGQ,IERROR)
        NQ=NFOR
      ELSE
        DO715I=1,NLEFT
          ISUB(I)=1
  715   CONTINUE
        NQ=NLEFT
      ENDIF
C
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO760I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO760
        J=J+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)
  760 CONTINUE
      NLOCAL=J
C
C  VALUES FOR MEAN RETURN INTERVALS.  THESE DO NOT USE
C  SUBSET/EXCEPT/FOR CLAUSE.
C
      IF(NUMV2.EQ.2)THEN
        DO770I=1,NRIGH
          IJ=MAXN*(ICOLR-1)+I
          IF(ICOLR.LE.MAXCOL)R(I)=V(IJ)
          IF(ICOLR.EQ.MAXCP1)R(I)=PRED(I)
          IF(ICOLR.EQ.MAXCP2)R(I)=RES(I)
          IF(ICOLR.EQ.MAXCP3)R(I)=YPLOT(I)
          IF(ICOLR.EQ.MAXCP4)R(I)=XPLOT(I)
          IF(ICOLR.EQ.MAXCP5)R(I)=X2PLOT(I)
          IF(ICOLR.EQ.MAXCP6)R(I)=TAGPLO(I)
  770   CONTINUE
        NRET=NRIGH
      ELSE
        NRET=0
      ENDIF
C
C               *****************************************************
C               **  STEP 8--                                       **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
C               **  RESET THE VECTOR D(.) TO ALL ONES.             **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
C               *****************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPOTME.EQ.'PPCC')THEN
        IHP='GAMM'
        IHP2='A1  '
        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
          GAMMA1=-3.0
        ELSE
          GAMMA1=VALUE(ILOCP)
        ENDIF
C
        IHP='GAMM'
        IHP2='A2  '
        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
          GAMMA2=3.0
        ELSE
          GAMMA2=VALUE(ILOCP)
        ENDIF
C
        IF(GAMMA1.GT.GAMMA2)THEN
          GAMMSV=GAMMA1
          GAMMA1=GAMMA2
          GAMMA2=GAMMSV
        ENDIF
      ENDIF
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,811)
  811   FORMAT('***** FROM THE MIDDLE  OF DPPOTP--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,812)ICASPL,IPOTME,NUMV2
  812   FORMAT('ICASPL,IPOTME,NUMV2 = ',A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL DPPOT2(Y1,NLOCAL,ICASPL,IPOTME,IPOTDI,IPOTLF,IPOTAX,
     1IPOTIT,IPOTNP,PPOTTH,PPOTIN,PPOTPE,PPOTTO,
     1IGEPDF,MINSIZ,MINSI2,
     1XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,XTEMP6,XTEMP7,
     1XTEMP8,XTEMP9,XTMP10,ITEMP1,MAXOBV,
     1R,NRET,
     1ICAPSW,ICAPTY,GAMMA1,GAMMA2,
     1IBOOSS,IBOOPA,ISEED,
     1IRTFPS,IRTFFF,NCRTF1,IRTFFP,NCRTF2,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'POTP')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END OF DPPOTP--')
        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 = ',
     1         I8,I8,I8,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        IF(NPLOTP.GE.1)THEN
          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
        ENDIF
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPPOT2(Y,N,ICASPL,IPOTME,IPOTDI,IPOTLF,IPOTAX,
     1IPOTIT,IPOTNP,APOTTH,APOTIN,APOTPE,APOTTO,
     1IGEPDF,MINSIZ,MINSI2,
     1XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,XTEMP6,XTEMP7,
     1XTEMP8,XTEMP9,XTMP10,ITEMP1,MAXNXT,
     1R,NRET,
     1ICAPSW,ICAPTY,GAMMA1,GAMMA2,
     1IBOOSS,IBOOPA,ISEED,
     1IRTFPS,IRTFFF,NCRTF1,IRTFFP,NCRTF2,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A PEAKS OVER THRESHOLD PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-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--2005/04
C     ORIGINAL VERSION--APRIL      2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IPOTME
      CHARACTER*4 IPOTDI
      CHARACTER*4 IPOTLF
      CHARACTER*4 IPOTAX
      CHARACTER*4 IGEPDF
      CHARACTER*4 IBOOPA
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IRTFFF
      CHARACTER*4 IRTFFP
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IPRISV
      CHARACTER*4 IFEESV
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IADEDF
      CHARACTER*4 ILGADF
      CHARACTER*4 ISKNDF
      CHARACTER*4 IMETHD
      CHARACTER*4 ICASJB
      CHARACTER*4 ICENSO
      CHARACTER*4 IQUAME
      CHARACTER*4 ICASP2
      CHARACTER*4 ISUBN0
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*40 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*1   IBASLC
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      DOUBLE PRECISION DP
      DOUBLE PRECISION DG
      DOUBLE PRECISION DPPF
      DOUBLE PRECISION DTEMP
      DOUBLE PRECISION DXR
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
      DIMENSION XTEMP4(*)
      DIMENSION XTEMP5(*)
      DIMENSION XTEMP6(*)
      DIMENSION XTEMP7(*)
      DIMENSION XTEMP8(*)
      DIMENSION XTEMP9(*)
      DIMENSION XTMP10(*)
      DIMENSION R(*)
      DIMENSION ITEMP1(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      INCLUDE 'DPCOF2.INC'
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
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='DPPO'
      ISUBN2='T2  '
      CALL DPCONA(92,IBASLC)
C
      IERROR='NO'
      IWRITE='OFF'
      IPRISV=IPRINT
      IFEESV=IFEEDB
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'POT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.MINSI2)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN PEAKS OVER THRESHOLD PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,32)MINSI2
   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST ',
     1         I8,';')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)N
   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'POT2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)
   71   FORMAT('***** AT THE BEGINNING OF DPPOT2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)ICASPL,IPOTME,IPOTIT,IPOTNP,N
   72   FORMAT('ICASPL,IPOTME,IPOTIT,IPOTNP,N, = ',A4,2X,A4,3(2X,I8))
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,74)APOTTH,APOTIN
   74   FORMAT('APOTTH,APOTIN = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
        DO85I=1,N
          WRITE(ICOUT,86)I,Y(I)
   86     FORMAT('I,Y(I) = ',I8,E12.5)
          CALL DPWRST('XXX','BUG ')
   85   CONTINUE
      ENDIF
C
C  THE BASIC ALGORITHM FOR GENERATING A PEAKS OVER THRESHOLDS
C  PLOT IS:
C
C  1. START WITH AN INITIAL THRESHOLD VALUE
C     USER CAN SPECIFY INITIAL THRESHOLD OR THE NUMBER OF POINTS
C     TO BE EXTRACTED FOR THE INITIAL THRESHOLD
C  2. EXTRACT THE POINTS IN THE DATA SET ABOVE THIS THRESHOLD
C  3. FOR THIS EXTRACTED DATA SET, ESTIMATE THE PARAMETERS OF
C     THE DISTRIBUTION.  NOTE THAT DATAPLOT ALLOWS YOU TO SELECT
C     BOTH THE TYPE OF DISTRIBUTION BEING ESTIMATED (GENERALIZED
C     PATRETO, WEIBULL, GUMBEL, OR FRECHET) AND THE METHOD USED
C     TO ESTIMATE THE PARAMETERS (AVAILABLE METHODS DEPEND ON
C     THE DISTRIBUTION).
C  4. CALCULATE A STANDARD DEVIATION FOR THE PARAMETER ESTIMATES.
C  5. INCREMENT THE THRESHOLD AND REPEAT STEPS 1-4.
C  6. PLOT THE RESULTING PARAMETER ESTIMATES ALONG WITH THE
C     "CONFIDENCE LIMITS" (USUALLY +/- 2*SD).
C
C               ********************************************
C               **  STEP 2--                              **
C               **  SORT THE DATA                         **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'POT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NRET.GT.0)THEN
        IR50=0
        DO101I=1,NRET
          IF(ABS(R(I) - 50.0).LT.1.0)THEN
            IR50=1
            GOTO109
          ENDIF
  101   CONTINUE
  109   CONTINUE
        IF(IR50.EQ.0)THEN
          NRET=NRET+1
          R(NRET)=50.0
        ENDIF
        CALL SORT(R,NRET,R)
        IR50=0
        DO111I=1,NRET
          IF(ABS(R(I) - 50.0).LT.1.0)THEN
            IR50=I
            GOTO119
          ENDIF
  111   CONTINUE
  119   CONTINUE
      ENDIF
C
      CALL SORT(Y,N,XTEMP1)
      DO210I=1,N
        Y(I)=XTEMP1(I)
  210 CONTINUE
C
      IF(APOTTH.GT.0.0)THEN
        ATHRSH=APOTTH
      ELSEIF(IPOTNP.GT.0)THEN
        INDX=N-IPOTNP+1
        IF(INDX.LT.1)INDX=1
        IF(INDX.GT.N)INDX=N
        ATHRSH=Y(INDX)
      ELSE
        NKEEP=INT(REAL(N)*0.025 + 0.5)
        IF(NKEEP.LT.MINSIZ)NKEEP=MINSIZ
        ATHRSH=Y(N-NKEEP+1)
      ENDIF
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'POT2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,211)
  211   FORMAT('ATHRSH,NKEEP = ',G15.7,2X,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='POT2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1            IREWI1,ISUBN0,IERRF1,IBUGG3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IF(NRET.GT.0)THEN
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='POT2'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1              IREWI2,ISUBN0,IERRF2,IBUGG3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
      ENDIF
C
C               ********************************************
C               **  STEP 3--                              **
C               **  LOOP THROUGH THE THRESHOLDS           **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'POT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        NCTIT=0
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM1(ITTEMP,NCTIT,IFLAG1,IFLAG2)
        WRITE(ICOUT,1261)
 1261   FORMAT('<H2>Peaks Over Threshold Analysis</H2>')
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
CCCCC   ITTEMP='Peaks Over Threshold Analysis'
CCCCC   NCTIT=29
        ITTEMP=' '
        NCTIT=0
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPLAT8(ITTEMP,NCTIT,IFLAG1,IFLAG2)
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
 6591   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFF.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFF.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFF.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFF.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFF.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFF.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        IRTFMD='OFF'
        ITTEMP=' b Peaks Over Threshold Analysis'
        ITTEMP(1:1)=IBASLC
C
        NCTIT=32
        IFLAG1=.TRUE.
        CALL DPRTF8(ITTEMP,NCTIT,ITEMP,IFLAG1)
      ELSE
        WRITE(ICOUT,261)
  261   FORMAT(10X,'PEAKS OVER THRESHOLD ANALYSIS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      ENDIF
C
      ICNT=0
      NLOCSV=0
      DO300I=1,IPOTIT
C
        U=ATHRSH + REAL(I-1)*APOTIN
        NLOCAL=0
        DO310J=1,N
          IF(Y(J).GE.U)THEN
            NLOCAL=NLOCAL+1
            XTEMP1(NLOCAL)=Y(J)
          ENDIF
  310   CONTINUE
C
        IF(NLOCAL.EQ.NLOCSV)GOTO300
        NLOCSV=NLOCAL
C
        IF(NLOCAL.LT.MINSIZ)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,311)U
  311     FORMAT('***** WARNING--FOR A THRESHOLD OF ',G12.5)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,313)NLOCAL
  313     FORMAT('      ONLY ',I8,' ABOVE THE THRESHOLD.  THIS IS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,315)MINSIZ
  315     FORMAT('      BELOW THE REQUIRED ',I8,'.  THIS ITERATION ',
     1           'SKIPPED.')
          CALL DPWRST('XXX','BUG ')
          GOTO300
        ENDIF
C
        IF(IPOTDI.EQ.'GPAR')THEN
C
C  DEHAAN METHOD
C
          IF(IPOTME.EQ.'DEHA')THEN
C
            IFEEDB='OFF'
            IPRINT='OFF'
C
            IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'POT2')THEN
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,321)
  321         FORMAT('ATHRSH,NKEEP = ',G15.7,2X,I8)
              CALL DPWRST('XXX','BUG ')
            ENDIF
C
            THRESH=CPUMIN
            CALL DPDEGP(XTEMP1,NLOCAL,
     1                  XTEMP2,MAXNXT,
     1                  GAMMA,A,GAMMSD,THRESH,
     1                  GAMMA2,ALOC,SCALE,
     1                  IGEPDF,ICAPSW,ICAPTY,
     1                  APOTTO,
     1                  ISUBRO,IBUGG3,IERROR)
            IF(IERROR.EQ.'YES')GOTO9000
            IF(IGEPDF.NE.'SIMI')THEN
              GAMMA=-GAMMA
            ENDIF
C
            ICNT=ICNT+1
            Y2(ICNT)=GAMMA
            IF(IPOTAX.EQ.'POIN')THEN
              X2(ICNT)=REAL(NLOCAL)
            ELSE
              X2(ICNT)=U
            ENDIF
            D2(ICNT)=1.0
            IF(GAMMSD.GT.0.0)THEN
              ICNT=ICNT+1
              Y2(ICNT)=GAMMA + 2.0*GAMMSD
              IF(IPOTAX.EQ.'POIN')THEN
                X2(ICNT)=REAL(NLOCAL)
              ELSE
                X2(ICNT)=U
              ENDIF
              D2(ICNT)=2.0
              ICNT=ICNT+1
              Y2(ICNT)=GAMMA - 2.0*GAMMSD
              IF(IPOTAX.EQ.'POIN')THEN
                X2(ICNT)=REAL(NLOCAL)
              ELSE
                X2(ICNT)=U
              ENDIF
              D2(ICNT)=3.0
            ENDIF
C
            ASCALE=A
            ALOC=U
C
            IFEEDB=IFEESV
            IPRINT=IPRISV
C
C  CME METHOD
C
          ELSEIF(IPOTME.EQ.'CME')THEN
C
            IFEEDB='OFF'
            IPRINT='OFF'
C
            THRESH=0.0
            CALL DPCMGP(XTEMP1,NLOCAL,
     1                  XTEMP2,MAXNXT,
     1                  GAMMA,A,GAMMSD,THRESH,
     1                  XTEMP2,XTEMP3,XTEMP4,ITEMP1,
     1                  IGEPDF,ICAPSW,ICAPTY,
     1                  APOTTO,
     1                  ISUBRO,IBUGG3,IERROR)
            IF(IERROR.EQ.'YES')GOTO9000
            IF(IGEPDF.NE.'SIMI')THEN
              GAMMA=-GAMMA
            ENDIF
C
            ICNT=ICNT+1
            Y2(ICNT)=GAMMA
            IF(IPOTAX.EQ.'POIN')THEN
              X2(ICNT)=REAL(NLOCAL)
            ELSE
              X2(ICNT)=U
            ENDIF
            D2(ICNT)=1.0
            IF(GAMMSD.GT.0.0)THEN
              ICNT=ICNT+1
              Y2(ICNT)=GAMMA + 2.0*GAMMSD
              IF(IPOTAX.EQ.'POIN')THEN
                X2(ICNT)=REAL(NLOCAL)
              ELSE
                X2(ICNT)=U
              ENDIF
              D2(ICNT)=2.0
              ICNT=ICNT+1
              Y2(ICNT)=GAMMA - 2.0*GAMMSD
              IF(IPOTAX.EQ.'POIN')THEN
                X2(ICNT)=REAL(NLOCAL)
              ELSE
                X2(ICNT)=U
              ENDIF
              D2(ICNT)=3.0
            ENDIF
C
            ASCALE=A
            ALOC=U
C
            IFEEDB=IFEESV
            IPRINT=IPRISV
C
C  PPCC METHOD
C
          ELSEIF(IPOTME.EQ.'PPCC')THEN
C
            IFEEDB='OFF'
            IPRINT='OFF'
C
            NUMDIS=50
            ANUMDI=REAL(NUMDIS)
            GAMLL=GAMMA1
            GAMUL=GAMMA2
            CORRMX=-99.0
            MINMAX=1
            CALL UNIMED(NLOCAL,XTEMP2)
            DO360IDIS=1,50
              AIDIS=IDIS
              SHAPE=GAMLL+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMUL-GAMLL)
              ICNT2=0
              DO370II=1,NLOCAL
                ICNT2=ICNT2+1
                CALL GEPPPF(XTEMP2(II),SHAPE,MINMAX,IGEPDF,
     1                      XTEMP3(ICNT2))
  370         CONTINUE
C
              IWRITE='OFF'
              CALL CORR(XTEMP3,XTEMP1,NLOCAL,IWRITE,CC,IBUGG3,IERROR)
              IF(CC.GT.CORRMX)THEN
                CORRMX=CC
                SHAPE1=SHAPE
                CALL LINFI2(XTEMP3,XTEMP1,NLOCAL,
     1                      ALOC,SCALE,
     1                      ISUBRO,IBUGG3,IERROR)
              ENDIF
  360       CONTINUE
C
C  USE BOOTSTRAP TO OBTAIN 95% CONFIDENCE INTERVAL FOR
C  SHAPE PARAMETER
C
            ICASP2='GECP'
            ICASJB='BOOT'
            ICENSO='OFF'
            IADEDF='OFF'
            ILGADF='OFF'
            ISKNDF='OFF'
            IMETHD='KAPL'
            NHOR1=0
            NPERC=0
            IPPCDP=0
C
            DO380IRESAM=1,IBOOSS
              IF(IBOOPA.EQ.'PARA')THEN
                IF(SHAPE1.EQ.0.0)THEN
                  CALL EXPRAN(NLOCAL,ISEED,XTEMP5)
                ELSE
                  CALL UNIRAN(NLOCAL,ISEED,XTEMP5)
                  DG=DBLE(SHAPE1)
                  IF(IGEPDF.EQ.'JOHN')THEN
                    DO381II=1,NLOCAL
                      DP=DBLE(XTEMP5(II))
                      DPPF=(-1.0D0/DG)*(((1.0D0-DP)**DG)-1.0D0)
                      XTEMP5(II)=REAL(DPPF)
  381               CONTINUE
                  ELSE
                    DO382II=1,NLOCAL
                      DP=DBLE(XTEMP5(II))
                      DPPF=(1.0D0/DG)*(((1.0D0-DP)**(-DG))-1.0D0)
                      XTEMP5(II)=REAL(DPPF)
  382               CONTINUE
                  ENDIF
                ENDIF
                NS3=NLOCAL
C
              ELSE
                CALL DPJBS3(XTEMP1,NLOCAL,ICASJB,IRESAM,ISEED,
     1                      XTEMP5,NS3,
     1                      ITEMP1,
     1                      XTEMP6,
     1                      IBUGG3,IERROR)
              ENDIF
              CALL DPJBCP(
     1           XTEMP5,XTEMP6,NS3,
     1           ICASP2,ICENSO,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1           XTEMP2,XTEMP3,XTEMP4,XTEMP7,
     1           NHOR1,IGEPDF,IADEDF,ILGADF,ISKNDF,
     1           XTEMP8,XTEMP9,NPERC,
     1           PPA0,PPA1,SHAPE,ACORR,
     1           IBUGG3,ISUBRO,IERROR)
              XTMP10(IRESAM)=SHAPE
  380       CONTINUE
C
            IQUAME='ORDE'
            QNT=0.025
            NTEMP=IBOOSS
            CALL QUANT(QNT,XTMP10,NTEMP,IWRITE,XTEMP2,MAXNXT,
     1                 IQUAME,
     1                 XQU025,IBUGG3,IERROR)
            QNT=0.975
            CALL QUANT(QNT,XTMP10,NTEMP,IWRITE,XTEMP2,MAXNXT,
     1                 IQUAME,
     1                 XQU975,IBUGG3,IERROR)
C
            ICNT=ICNT+1
            Y2(ICNT)=SHAPE1
            IF(IPOTAX.EQ.'POIN')THEN
              X2(ICNT)=REAL(NLOCAL)
            ELSE
              X2(ICNT)=U
            ENDIF
            D2(ICNT)=1.0
            ICNT=ICNT+1
            Y2(ICNT)=XQU025
            IF(IPOTAX.EQ.'POIN')THEN
              X2(ICNT)=REAL(NLOCAL)
            ELSE
              X2(ICNT)=U
            ENDIF
            D2(ICNT)=2.0
            ICNT=ICNT+1
            Y2(ICNT)=XQU975
            IF(IPOTAX.EQ.'POIN')THEN
              X2(ICNT)=REAL(NLOCAL)
            ELSE
              X2(ICNT)=U
            ENDIF
            D2(ICNT)=3.0
C
            ASCALE=SCALE
            GAMMA=SHAPE1
C
            IFEEDB=IFEESV
            IPRINT=IPRISV
C
C  METHOD OF MOMENTS
C
          ELSEIF(IPOTME.EQ.'MOME')THEN
C
            IFEEDB='OFF'
            IPRINT='OFF'
C
            CALL MEAN(XTEMP1,NLOCAL,IWRITE,XMEAN,IBUGG3,IERROR)
            CALL SD(XTEMP1,NLOCAL,IWRITE,XSD,IBUGG3,IERROR)
            XVAR=XSD**2
C
            GAMMA=0.5*(XMEAN*XMEAN/XVAR - 1.0)
            SCALE=0.5*XMEAN*(XMEAN*XMEAN/XVAR + 1.0)
            print *,'xmean,xsd,gamma,scale=',xmean,xsd,gamma,scale
            IF(IGEPDF.EQ.'SIMI')THEN
              GAMMA=-GAMMA
            ENDIF
C
            ICNT=ICNT+1
            Y2(ICNT)=GAMMA
            X2(ICNT)=REAL(NLOCAL)
            D2(ICNT)=1.0
C
            IFEEDB=IFEESV
            IPRINT=IPRISV
C
C  MAXIMUM LIKELIHOOD METHOD
C
          ELSEIF(IPOTME.EQ.'MLE ')THEN
          ENDIF
C
C  NOW DO THE FOLLOWING:
C
C  1) WRITE INFO TO DPST1F.DAT (POINTS ABOVE THRESHOLD,
C     THRESHOLD, ESTIMATES OF GAMMA, LOC, SCALE
C
C  2) IF REQUESTED, COMPUTE MEAN RECURRENCE INTERVALS.
C
C  3) WRITE MEAN RECURRENCE INTERVAL INFO TO FILE.
C
          WRITE(IOUNI1,'(I8,2X,4E15.7)')NLOCAL,U,GAMMA,ALOC,ASCALE
          IF(NRET.GT.0)THEN
            ALAMB=1.0
            IF(APOTPE.GT.0.0)THEN
              ALAMB=REAL(NLOCAL)/(REAL(N)/APOTPE)
            ENDIF
C
            IF(IPRINT.EQ.'ON')THEN
            IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
              NCTIT=0
              IFLAG1=.FALSE.
              IFLAG2=.TRUE.
              CALL DPHTM1(ITTEMP,NCTIT,IFLAG1,IFLAG2)
              IWDT1=350
              IWDT2=150
C
              ITTEMP='<br><b>Iteration   :</b>'
              WRITE(ITTEMP(18:19),'(I2)')I
              NCTEMP=24
              NUMDIG=-1
              AVAL=0.0
              CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ITTEMP='Sample Size:'
              NCTEMP=12
              NUMDIG=0
              AVAL=REAL(N)
              CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ITTEMP='Threshold:'
              NCTEMP=10
              NUMDIG=-2
              AVAL=U
              CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ITTEMP='Number of Points Above the Threshold:'
              NCTEMP=37
              NUMDIG=0
              AVAL=REAL(NLOCAL)
              CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ITTEMP='Value of Lambda:'
              NCTEMP=16
              NUMDIG=-2
              AVAL=ALAMB
              CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ITTEMP=' '
              NCTEMP=0
              NUMDIG=-1
              AVAL=0.0
              CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              IF(IPOTME.EQ.'DEHA')THEN
                ITTEMP='Parameter Estimation (de Haan Method):'
                NCTEMP=38
                NUMDIG=-1
                AVAL=0.0
                CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ELSEIF(IPOTME.EQ.'CME')THEN
                ITTEMP='Parameter Estimation (CME Method):'
                NCTEMP=34
                NUMDIG=-1
                AVAL=0.0
                CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ELSEIF(IPOTME.EQ.'PPCC')THEN
                ITTEMP='Parameter Estimation (PPCC Method):'
                NCTEMP=35
                NUMDIG=-1
                AVAL=0.0
                CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ENDIF
              ITTEMP='Estimate of Shape Parameter (Gamma):'
              NCTEMP=36
              NUMDIG=-2
              AVAL=GAMMA
              CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              IF(IPOTME.EQ.'DEHA' .OR. IPOTME.EQ.'CME')THEN
                ITTEMP='Standard Deviation of Gamma:'
                NCTEMP=28
                NUMDIG=-2
                AVAL=GAMMA
                CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ELSEIF(IPOTME.EQ.'PPCC')THEN
                ITTEMP='Lower 95% Confidence Limit for Gamma:'
                NCTEMP=37
                NUMDIG=-2
                AVAL=XQU025
                CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
                ITTEMP='Upper 95% Confidence Limit for Gamma:'
                NCTEMP=37
                NUMDIG=-2
                AVAL=XQU975
                CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ENDIF
              ITTEMP='Estimate of Location Parameter:'
              NCTEMP=31
              NUMDIG=-2
              AVAL=ALOC
              CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
              ITTEMP='Estimate of Scale Parameter:'
              NCTEMP=28
              NUMDIG=-2
              AVAL=ASCALE
              CALL DPHTM3(ITTEMP,NCTEMP,AVAL,NUMDIG,IWDT1,IWDT2)
C
              IFLAG1=.TRUE.
              IFLAG2=.FALSE.
              NHEAD=0
              CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
              IFLAG1=.FALSE.
              IFLAG2=.TRUE.
              NCTIT=0
              CALL DPHTM1(ITTEMP,NCTIT,IFLAG1,IFLAG2)
              IWIDTH(1)=200
              IWIDTH(2)=200
              IWIDTH(3)=200
              VALIGN(1)='CENTER'
              VALIGN(2)='CENTER'
              VALIGN(3)='CENTER'
              ALIGN(1)='RIGHT'
              ALIGN(2)='RIGHT'
              ALIGN(3)='RIGHT'
              NUMDI2(1)=-2
              NUMDI2(2)=-2
              NUMDI2(3)=-2
              IVALUE(1)='Mean Reccurence<br>Interval (R)'
              NCHAR(1)=31
              IVALUE(2)='XR'
              NCHAR(2)=2
              IFLAG1=.TRUE.
              IFLAG2=.TRUE.
              NHEAD=2
              CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  FOLLOWING ATTEMPT TO RESOLVE PROBLEM WHERE LATEX HAS TOO
C  MANY TABLES TO RESOLVE.
C
              IF(MOD(I,6).EQ.0)THEN
                WRITE(ICOUT,3301)IBASLC
 3301           FORMAT(A1,'clearpage')
                CALL DPWRST('XXX','WRIT')
              ENDIF
C
              IF(I.EQ.1)THEN
                ITTEMP='Peaks Over Threshold Analysis'
                NCTIT=29
              ELSE
                ITTEMP=' '
                NCTIT=0
              ENDIF
              IHEAD=' '
              NHEAD=0
              IFLAG1=.TRUE.
              CALL DPLAT1(ITTEMP,NCTIT,IHEAD,NHEAD,IFLAG1)
C
              IWIDTH(1)=0
              IWIDTH(2)=0
              IWIDTH(3)=0
              VALIGN(1)=' '
              VALIGN(2)=' '
              VALIGN(3)=' '
              ALIGN(1)='l'
              ALIGN(2)='r'
              ALIGN(3)='r'
              NUMDI2(1)=-2
              NUMDI2(2)=-2
              NUMDI2(3)=-2
              AVALUE(1)=0.0
              AVALUE(2)=0.0
              NCHAR(1)=0
              NCHAR(2)=0
              IVALUE(1)=' '
              IVALUE(2)=' '
              NHEAD=2
              IFLAG1=.FALSE.
              IFLAG2=.FALSE.
              CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
              NHEAD=1
              IFLAG1=.FALSE.
              IVALUE(1)='{ bf Iteration:   }'
              WRITE(IVALUE(1)(17:18),'(I2)')I
              WRITE(IVALUE(1)(2:2),'(A1)')IBASLC
              NCHAR(1)=19
              NCHAR(2)=0
              NUMDI2(1)=-3
              NHEAD=1
              CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              NHEAD=1
              IVALUE(1)='Sample Size:'
              NCHAR(1)=12
              AVALUE(1)=REAL(N)
              NUMDI2(1)=0
              CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IVALUE(1)='Threshold:'
              NCHAR(1)=10
              NUMDI2(1)=-2
              AVALUE(1)=U
              CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IVALUE(1)='Number of Points Above the Threshold:'
              NCHAR(1)=37
              NUMDI2(1)=0
              AVALUE(1)=REAL(NLOCAL)
              CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IVALUE(1)='Value of Lambda:'
              NCHAR(1)=16
              NUMDI2(1)=-2
              AVALUE(1)=ALAMB
              CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IVALUE(1)=' '
              NCHAR(1)=1
              NUMDI2(1)=-1
              AVALUE(1)=0.0
              CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IF(IPOTME.EQ.'DEHA')THEN
                IVALUE(1)='Parameter Estimation (de Haan Method):'
                NCHAR(1)=38
                NUMDI2(1)=-3
                AVALUE(1)=0.0
                CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              ELSEIF(IPOTME.EQ.'CME')THEN
                IVALUE(1)='Parameter Estimation (CME Method):'
                NCHAR(1)=34
                NUMDI2(1)=-1
                AVALUE(1)=0.0
                CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              ELSEIF(IPOTME.EQ.'PPCC')THEN
                IVALUE(1)='Parameter Estimation (PPCC Method):'
                NCHAR(1)=35
                NUMDI2(1)=-1
                AVALUE(1)=0.0
                CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              ENDIF
              IVALUE(1)='Estimate of Shape Parameter (Gamma):'
              NCHAR(1)=36
              NUMDI2(1)=-2
              AVALUE(1)=GAMMA
              CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IF(IPOTME.EQ.'DEHA' .OR. IPOTME.EQ.'CME')THEN
                IVALUE(1)='Standard Deviation of Gamma:'
                NCHAR(1)=28
                NUMDI2(1)=-2
                AVALUE(1)=GAMMSD
                CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              ELSEIF(IPOTME.EQ.'PPCC')THEN
                IVALUE(1)='Lower 95% Confidence Limit for Gamma:'
                NCHAR(1)=37
                NUMDI2(1)=-2
                AVALUE(1)=XQU025
                CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
                IVALUE(1)='Upper 95% Confidence Limit for Gamma:'
                NCHAR(1)=37
                NUMDI2(1)=-2
                AVALUE(1)=XQU975
                CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              ENDIF
              IVALUE(1)='Estimate of Location Parameter:'
              NCHAR(1)=31
              NUMDI2(1)=-2
              AVALUE(1)=ALOC
              CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IVALUE(1)='Estimate of Scale Parameter:'
              NCHAR(1)=28
              NUMDI2(1)=-2
              AVALUE(1)=ASCALE
              CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
              IFLAG1=.TRUE.
              IFLAG2=.FALSE.
              IFLAG3=.FALSE.
              NHEAD=0
              CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
              ITTEMP=' '
              NCTIT=0
              IHEAD=' '
              NHEAD=0
              IFLAG1=.FALSE.
              CALL DPLAT1(ITTEMP,NCTIT,IHEAD,NHEAD,IFLAG1)
              NHEAD=2
              IFLAG1=.TRUE.
              IFLAG2=.TRUE.
              IVALUE(1)='Mean Reccurence Interval (R)'
              NCHAR(1)=28
              IVALUE(2)='XR'
              NCHAR(2)=2
              CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
              CALL DPCONA(92,IBASLC)
CCCCC         ITTEMP=' '
CCCCC         NCTIT=0
CCCCC         IHEAD=' '
CCCCC         NHEAD=0
CCCCC         IFLAG1=.TRUE.
CCCCC         CALL DPLAT1(ITTEMP,NCTIT,IHEAD,NHEAD,IFLAG1)
C
              IDEFPS=20
              IFRST=IRTFPS*5000/IDEFPS
              IINC1=IRTFPS*2000/IDEFPS
              IWIDTH(1)=IFRST
              IWIDTH(2)=IFRST+IINC1
              IWIDTH(3)=IWIDTH(2)+IINC1
              VALIGN(1)='b'
              VALIGN(2)='b'
              VALIGN(3)='b'
              ALIGN(1)='l'
              ALIGN(2)='r'
              ALIGN(3)='r'
              NUMDI2(1)=-2
              NUMDI2(2)=-2
              NUMDI2(3)=-2
              AVALUE(1)=0.0
              AVALUE(2)=0.0
              NCHAR(1)=0
              NCHAR(2)=0
              IVALUE(1)=' '
              IVALUE(2)=' '
              NHEAD=2
              IFLAG1=.FALSE.
              IFLAG2=.FALSE.
              CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
              ALIGN(1)='l'
              ALIGN(2)='r'
              ALIGN(3)='r'
C
              IFLAG1=.FALSE.
              IVALUE(1)=' b Iteration:'
              IVALUE(1)(1:1)=IBASLC
              NCHAR(1)=13
              NUMDI2(2)=0
              AVALUE(2)=REAL(I)
              NHEAD=1
              CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              NHEAD=1
              IVALUE(1)='Sample Size:'
              NCHAR(1)=12
              AVALUE(2)=REAL(N)
              NUMDI2(2)=0
              CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IVALUE(1)='Threshold:'
              NCHAR(1)=10
              NUMDI2(2)=-2
              AVALUE(2)=U
              CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IVALUE(1)='Number of Points Above the Threshold:'
              NCHAR(1)=37
              NUMDI2(2)=0
              AVALUE(2)=REAL(NLOCAL)
              CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IVALUE(1)='Value of Lambda:'
              NCHAR(1)=16
              NUMDI2(2)=-2
              AVALUE(2)=ALAMB
              CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IF(IPOTME.EQ.'DEHA')THEN
                IVALUE(1)=' b Parameter Estimation (de Haan Method):'
                IVALUE(1)(1:1)=IBASLC
                NCHAR(1)=41
                NCHAR(2)=0
                IFLAG1=.FALSE.
                IFLAG2=.FALSE.
                NHEAD2=2
                CALL DPRTF4(IVALUE,NCHAR,NHEAD2,IFLAG1,IFLAG2)
              ELSEIF(IPOTME.EQ.'CME')THEN
                IVALUE(1)=' b Parameter Estimation (CME Method):'
                IVALUE(1)(1:1)=IBASLC
                NCHAR(1)=37
                NCHAR(2)=0
                IFLAG1=.FALSE.
                IFLAG2=.FALSE.
                NHEAD2=2
                CALL DPRTF4(IVALUE,NCHAR,NHEAD2,IFLAG1,IFLAG2)
              ELSEIF(IPOTME.EQ.'PPCC')THEN
                IVALUE(1)=' b Parameter Estimation (PPCC Method):'
                IVALUE(1)(1:1)=IBASLC
                NCHAR(1)=38
                NCHAR(2)=0
                IFLAG1=.FALSE.
                IFLAG2=.FALSE.
                NHEAD2=2
                CALL DPRTF4(IVALUE,NCHAR,NHEAD2,IFLAG1,IFLAG2)
              ENDIF
              IVALUE(1)='Estimate of Shape Parameter (Gamma):'
              NCHAR(1)=36
              NUMDI2(2)=-2
              AVALUE(2)=GAMMA
              CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IF(IPOTME.EQ.'DEHA' .OR. IPOTME.EQ.'CME')THEN
                IVALUE(1)='Standard Deviation of Gamma:'
                NCHAR(1)=28
                NUMDI2(2)=-2
                AVALUE(2)=GAMMSD
                CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              ELSEIF(IPOTME.EQ.'PPCC')THEN
                IVALUE(1)='Lower 95% Confidence Limit for Gamma:'
                NCHAR(1)=37
                NUMDI2(2)=-2
                AVALUE(2)=XQU025
                CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
                IVALUE(1)='Upper 95% Confidence Limit for Gamma:'
                NCHAR(1)=37
                NUMDI2(2)=-2
                AVALUE(2)=XQU975
                CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              ENDIF
              IVALUE(1)='Estimate of Location Parameter:'
              NCHAR(1)=31
              NUMDI2(2)=-2
              AVALUE(2)=ALOC
              CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
              IVALUE(1)='Estimate of Scale Parameter:'
              NCHAR(1)=28
              NUMDI2(2)=-2
              AVALUE(2)=ASCALE
              CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
              NHEAD=2
              CALL DPRTF6(NHEAD)
              IF(IRTFFF.EQ.'Times New Roman')THEN
                ITEMP=0
              ELSEIF(IRTFFF.EQ.'Lucida Sans')THEN
                ITEMP=6
              ELSEIF(IRTFFF.EQ.'Arial')THEN
                ITEMP=2
              ELSEIF(IRTFFF.EQ.'Bookman')THEN
                ITEMP=3
              ELSEIF(IRTFFF.EQ.'Georgia')THEN
                ITEMP=4
              ELSEIF(IRTFFF.EQ.'Tahoma')THEN
                ITEMP=5
              ELSEIF(IRTFFF.EQ.'Verdana')THEN
                ITEMP=7
              ELSE
                ITEMP=0
              ENDIF 
              WRITE(ICOUT,6591)IBASLC,ITEMP
              CALL DPWRST(ICOUT,'WRIT')
C
              ITTEMP=' '
              NCTIT=0
              IHEAD=' '
              NHEAD=0
              CALL DPRTF1(ITTEMP,NCTIT,IHEAD,NHEAD)
              IFRST=IRTFPS*2500/IDEFPS
              IINC1=IRTFPS*2500/IDEFPS
              IWIDTH(1)=IFRST
              IWIDTH(2)=IFRST+IINC1
              IWIDTH(3)=IWIDTH(2)+IINC1
              ALIGN(1)='r'
              ALIGN(2)='r'
              ALIGN(3)='r'
              NHEAD=2
              IFLAG1=.TRUE.
              IFLAG2=.TRUE.
              IVALUE(1)=' b Mean Reccurence Interval (R)'
              IVALUE(1)(1:1)=IBASLC
              NCHAR(1)=31
              IVALUE(2)=' b XR'
              IVALUE(2)(1:1)=IBASLC
              NCHAR(2)=5
              CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
            ELSE
              WRITE(ICOUT,451)N
  451         FORMAT('SAMPLE SIZE:                          ',I8)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,452)U
  452         FORMAT('THRESHOLD:                            ',F12.5)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,453)NLOCAL
  453         FORMAT('NUMBER OF POINTS ABOVE THRESHOLD:     ',I8)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,455)ALAMB
  455         FORMAT('VALUE OF LAMBDA:                      ',G15.7)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','WRIT')
              IF(IPOTME.EQ.'DEHA')THEN
                WRITE(ICOUT,461)
  461           FORMAT('PARAMETER ESTIMATION (DEHAAN METHOD):')
                CALL DPWRST('XXX','WRIT')
              ELSEIF(IPOTME.EQ.'CME')THEN
                WRITE(ICOUT,463)
  463           FORMAT('PARAMETER ESTIMATION (CME METHOD):')
                CALL DPWRST('XXX','WRIT')
              ELSEIF(IPOTME.EQ.'PPCC')THEN
                WRITE(ICOUT,465)
  465           FORMAT('PARAMETER ESTIMATION (PPCC METHOD):')
                CALL DPWRST('XXX','WRIT')
              ENDIF
              WRITE(ICOUT,471)GAMMA
  471         FORMAT('ESTIMATE OF SHAPE PARAMETER (GAMMA):    ',G15.7)
              CALL DPWRST('XXX','WRIT')
              IF(IPOTME.EQ.'DEHA' .OR. IPOTME.EQ.'CME')THEN
                WRITE(ICOUT,472)GAMMSD
  472           FORMAT('STANDARD DEVIATION OF GAMMA:          ',G15.7)
                CALL DPWRST('XXX','WRIT')
              ELSEIF(IPOTME.EQ.'PPCC')THEN
                WRITE(ICOUT,473)XQU025
  473           FORMAT('LOWER 95% CONFIDENCED LIMIT:          ',G15.7)
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,474)XQU975
  474           FORMAT('UPPER 95% CONFIDENCED LIMIT:          ',G15.7)
                CALL DPWRST('XXX','WRIT')
              ENDIF
              WRITE(ICOUT,476)ALOC
  476         FORMAT('ESTIMATE OF LOCATION PARAMETER:         ',G15.7)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,478)ASCALE
  478         FORMAT('ESTIMATE OF SCALE    PARAMETER:         ',G15.7)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,483)
  483         FORMAT('MEAN RECURRENCE ')
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,485)
  485         FORMAT('INTERVAL (R)                     XR')
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,489)
  489         FORMAT('=====================================')
              CALL DPWRST('XXX','WRIT')
            ENDIF
            ENDIF
C
            DG=DBLE(GAMMA)
            IF(IPOTLF.EQ.'ON' .AND. GAMMA.LT.0.0)THEN
              XMAX=U - (ASCALE/GAMMA)
CCCCC         DTEMP=1.0D0 - 1.0D0/(DBLE(ALAMB)*50.0D0)
CCCCC         CALL GEDPPF(DTEMP,DBLE(GAMMA),MINMAX,IGEPDF,DXR)
              DXR=DBLE(ALOC) - DBLE(ASCALE)*
     1            (1.0D0 - (DBLE(ALAMB*50.0))**DG)/DG
              XR50=REAL(DXR)
              IF(IR50.GT.0)THEN
                XLF50=(XMAX/XR50)**2
              ELSE
                XLF50=-99.0
              ENDIF
            ENDIF
C
            DO410II=1,NRET
CCCCC         DTEMP=1.0D0 - 1.0D0/(DBLE(ALAMB)*DBLE(R(II)))
CCCCC         CALL GEDPPF(DTEMP,DBLE(GAMMA),MINMAX,IGEPDF,DXR)
              DXR=DBLE(ALOC) - DBLE(ASCALE)*
     1            (1.0D0 - (DBLE(ALAMB*R(II)))**DG)/DG
              XR=REAL(DXR)
              IF(IPOTLF.EQ.'ON')THEN
                IF(GAMMA.LT.0.0 .AND. R(II).GE.51.0)THEN
                  XLF=(XR/XR50)**2
                ELSE
                  XLF=-99.0
                ENDIF
                WRITE(IOUNI2,'(2(I8,2X),4E15.7)')I,NLOCAL,U,R(II),
     1                XR,XLF
              ELSE
                WRITE(IOUNI2,'(2(I8,2X),3E15.7)')I,NLOCAL,U,R(II),XR
              ENDIF
              IF(IPRINT.EQ.'ON')THEN
              IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
                NCHAR(1)=0
                IVALUE(1)=' '
                AVALUE(1)=R(II)
                AVALUE(2)=XR
                NHEAD=2
                CALL DPHTM5(IVALUE,NCHAR(1),AVALUE,NHEAD)
              ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
                IFLAG1=.FALSE.
                IVALUE(1)=' '
                NCHAR(1)=0
                AVALUE(1)=R(II)
                AVALUE(2)=XR
                NHEAD=2
                CALL DPLAT5(IVALUE,NCHAR,AVALUE,NHEAD,IFLAG1)
              ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
                IFLAG1=.FALSE.
                IVALUE(1)=' '
                NCHAR(1)=0
                AVALUE(1)=R(II)
                AVALUE(2)=XR
                NHEAD=2
                CALL DPRTF5(IVALUE,NCHAR,AVALUE,NHEAD,IFLAG1)
              ELSE
                WRITE(ICOUT,418)R(II),XR
  418           FORMAT(F12.2,13X,F12.5)
                CALL DPWRST('XXX','WRIT')
              ENDIF
              ENDIF
  410       CONTINUE
            IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
              IFLAG1=.TRUE.
              IFLAG2=.FALSE.
              NHEAD=0
              CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
              IF(IPOTLF.EQ.'ON' .AND. GAMMA.LT.0.0)THEN
                WRITE(ICOUT,1426)
 1426           FORMAT('<BR><UL>')
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,1427)XMAX
 1427           FORMAT('Maximum Wind Speed: ',F12.5,'<br>')
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,1429)XLF
 1429           FORMAT('Load Factor ',
     1                 '(MAX/XR<sub>50</sub>)<sup>2</sup>: ',F12.5,
     1                 '<br>')
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,1428)
 1428           FORMAT('</UL> <BR>')
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,999)
                CALL DPWRST('XXX','WRIT')
              ENDIF
            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
              IFLAG1=.TRUE.
              IFLAG2=.FALSE.
              IFLAG3=.FALSE.
              NHEAD=0
              CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
              IF(IPOTLF.EQ.'ON' .AND. GAMMA.LT.0.0)THEN
                IVALUE(1)='Maximum Wind Speed: '
                NCHAR(1)=20
                AVAL=XMAX
                CALL DPLAT7(IVALUE(1),NCHAR(1),AVAL)
                IVALUE(1)='Load Factor $(Max/XR_{50})^2$:'
                NCHAR(1)=29
                AVAL=XLF
                CALL DPLAT7(IVALUE(1),NCHAR(1),AVAL)
              ENDIF
              IFLAG1=.FALSE.
              IFLAG2=.FALSE.
              IFLAG3=.TRUE.
              CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
              NHEAD=2
              CALL DPRTF6(NHEAD)
              NHEAD=0
              NCTIT=0
              CALL DPRTF1(ITTEMP,NCTIT,IHEAD,NHEAD)
              IF(IPOTLF.EQ.'ON' .AND. GAMMA.LT.0.0)THEN
                IVALUE(1)='Maximum Wind Speed: '
                NCHAR(1)=20
                AVAL=XMAX
                CALL DPRTF7(IVALUE(1),NCHAR(1),AVAL)
                IVALUE(1)='Load Factor (Max/XR(50)^2:'
                NCHAR(1)=26
                AVAL=XLF
                CALL DPRTF7(IVALUE(1),NCHAR(1),AVAL)
                NHEAD=2
                CALL DPRTF6(NHEAD)
                NHEAD=0
                NCTIT=0
                CALL DPRTF1(ITTEMP,NCTIT,IHEAD,NHEAD)
              ENDIF
            ELSE
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','WRIT')
              IF(IPOTLF.EQ.'ON' .AND. GAMMA.LT.0.0)THEN
                WRITE(ICOUT,427)XMAX
  427           FORMAT('MAXIMUM WIND SPEED:               ',F12.5)
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,429)XLF
  429           FORMAT('LOAD FACTOR (MAX/XR(50))**2:      ',F12.5)
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,999)
                CALL DPWRST('XXX','WRIT')
              ENDIF
            ENDIF
          ENDIF
C
        ELSEIF(IPOTDI.EQ.'WEIB')THEN
        ELSEIF(IPOTDI.EQ.'GUMB')THEN
        ELSEIF(IPOTDI.EQ.'FREC')THEN
        ENDIF
C
  300 CONTINUE
C
      N2=ICNT
      NPLOTV=2
C
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
        NHEAD=0
        CALL DPRTF6(NHEAD)
      ELSE
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
C
      IPRINT=IPRISV
      IFEEDB=IFEESV
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1            IENDF1,IREWI1,ISUBN0,IERRF1,IBUGG3,ISUBRO,IERROR)
C
      IF(NRET.GT.0)THEN
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGG3,ISUBRO,IERROR)
      ENDIF
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'POT2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPPOT2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)ICASPL,N,IERROR
 9012   FORMAT('ICASPL,N,IERROR = ',A4,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)N2,NPLOTV
 9014   FORMAT('N2,NPLOTV = ',2I8)
        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
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPPP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CCCCC THE FOLLOWING LINE WAS CHANGED      DECEMBER 1993
CCCCC1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PROBABILITY PLOT
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-SQUARED
C              11) F
C              12) EXPONENTIAL
C              13) GAMMA
C              14) BETA
C              15) WEIBULL---MIN & MAX                       MAY 1993
C              16) EXTREME VALUE TYPE 1 (GUMBEL)--MIN & MAX  MAY 1993
C              17) EXTREME VALUE TYPE 2 (FRECHET)--MIN & MAX MAY 1993
C              18) PARETO
C              19) BINOMIAL
C              20) GEOMETRIC
C              21) POISSON
C              22) NEGATIVE BINOMIAL
C              23) SEMI-CIRCULAR
C              24) TRIANGULAR
C              25) INVERSE GAUUSIAN  MAY 1990
C              26) WALD   MAY 1990
C              27) RECIPROCAL INVERSE GAUUSIAN   MAY 1990
C              28) FAILURE TIME   MAY 1990
C              29) GENERALIZED PARETO     DECEMBER 1993
C              30) DISCRETE UNIFORM       SEPTEMBER 1994
C              31) NON-CENTRAL T          SEPTEMBER 1994
C              32) NON-CENTRAL F          SEPTEMBER 1994
C              33) NON-CENTRAL CHI-SQUARE SEPTEMBER 1994
C              34) NON-CENTRAL BETA       SEPTEMBER 1994
C              35) DOUBLY NON-CENTRAL T   SEPTEMBER 1994
C              36) DOUBLY NON-CENTRAL F   SEPTEMBER 1994
C              36) HYPER-GEOMETRIC        SEPTEMBER 1994
C              37) VON-MISES              OCTOBER   1994
C              38) POWER NORMAL           APRIL     1995
C              39) POWER LOGNORMAL        APRIL     1995
C              40) COSINE                 APRIL     1995
C              41) ALPHA                  APRIL     1995
C              42) POWER FUNCTION         APRIL     1995
C              43) CHI                    APRIL     1995
C              44) LOGARITMIC SERIES      APRIL     1995
C              45) LOG LOGISTIC           APRIL     1995
C              46) GENERALIZED GAMMA      APRIL     1995
C              47) WARING PROBABILTY PLOT MAY       1995
C              48) ANGLIT PROBABILTY PLOT SEPTEMBER 1995
C              49) ARCSIN PROBABILTY PLOT SEPTEMBER 1995
C              50) FOLDED NORMAL PROBABILTY PLOT SEPTEMBER 1995
C              51) TRUNCATED NORMAL PROBABILTY PLOT SEPTEMBER 1995
C              52) LOG GAMMA PROBABILTY PLOT OCTOBER 1995
C              53) HYPERBOLIC SECANT PROBABILTY PLOT OCTOBER 1995
C              54) GOMPERTZ PROBABILTY PLOT OCTOBER 1995
C              55) PARETO SECOND KIND PROBABILTY PLOT OCTOBER 1995
C              56) DOUBLE WEIBULL PROBABILTY PLOT OCTOBER 1995
C              57) WRAPPED-UP CAUCHY PROBABILTY PLOT OCTOBER 1995
C              58) EXPONENTIAL WEIBULL PROBABILTY PLOT OCTOBER 1995
C              59) TRUNCATED EXPONENTIAL PROBABILTY PLOT OCTOBER 1995
C              60) GENERALIZED LOGISTIC PROBABILTY PLOT DECEMBER 1995
C              61) EXPONENTIAL POWER PROBABILTY PLOT DECEMBER 1995
C              62) DOUBLE GAMMA PROBABILTY PLOT JANUARY 1996
C              63) MIELKE'S BETA-KAPPA PROBABILTY PLOT JANUARY 1996
C              64) FOLDED CAUCHY PROBABILTY PLOT JANUARY 1996
C              65) BETA BINOMIAL PROBABILTY PLOT FEBRUARY 1996
C              66) BETA PASCAL PROBABILTY PLOT FEBRUARY 1996
C              67) GENERALIZED EXPONENTIAL PROB PLOT FEBRUARY 1996
C              68) RECIPROCAL PROB PLOT MAY 1996
C              69) NORMAL MIXTURE PROB PLOT MAY 1998
C              70) INVERTED GAMMA PROB PLOT MAY 1998
C              71) GENERALIZED TUKEY LAMBDA PROB PLOT AUGUST 2001
C              72) JOHNSON SB PROB PLOT SEPTEMBER 2001
C              73) JOHNSON SU PROB PLOT SEPTEMBER 2001
C              74) INVERTED WEIBULL PROB PLOT SEPTEMBER 2001
C              75) LOG DOUBLE EXPONENTIAL PROB PLOT SEPTEMBER 2001
C              76) GEOMETRIC EXTREME EXPONENTIAL PROB PLOT NOV 2001
C              77) TWO-SIDED POWER PROB PLOT MAY 2002
C              78) BIWEIBULL PROB PLOT MAY 2002
C              79) G-AND-H PROB PLOT JANUARY 2003
C              80) LANDAU PROB PLOT APRIL 2003
C              81) ERROR PROB PLOT MAY 2003
C              82) TRAPEZOID PROB PLOT JUNE 2003
C              83) GENERALIZED TRAPEZOID PROB PLOT JUNE 2003
C              84) FOLDED T PROB PLOT NOVEMBER 2003
C              85) SLASH PROB PLOT DECEMBER 2003
C              86) SKEWED NORMAL PROB PLOT DECEMBER 2003
C              87) SKEWED T PROB PLOT DECEMBER 2003
C              88) INVERTED BETA PROB PLOT DECEMBER 2003
C              89) GOMPERTZ-MAKEHAM PROB PLOT DECEMBER 2003
C              90) LOG-SKEW-NORMAL PROB PLOT MARCH 2004
C              91) LOG-SKEW-T PROB PLOT MARCH 2004
C              92) GENERALIZED HALF-LOGISTIC PROB PLOT MARCH 2004
C              93) POLYA PROB PLOT MARCH 2004
C              94) HERMITE PROB PLOT MARCH 2004
C              95) YULE PROBABILTY PLOT APRIL 2004
C              96) SKEW DOUBLE EXPONENTYIAL PROBABILTY PLOT JUNE 2004
C              97) ASYMMETRIC DOUBLE EXPONENTIAL PROBABILTY PLOT
C                                                JUNE 2004
C              98) MAXWELL PROBABILTY PLOT JUNE 2004
C              99) RAYLEIGH PROBABILTY PLOT JUNE 2004
C             100) GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL
C                  PROBABILTY PLOT AUGUST 2004
C             101) GENERALIZED INVERSE GAUSSIAN PROBABILTY PLOT
C             102) MCLEISH PROBABILTY PLOT
C             103) BESSEL I FUNCTION PROBABILTY PLOT
C             104) BESSEL K FUNCTION PROBABILTY PLOT (NOT WORKING)
C             105) GENERALIZED MCLEISH PROBABILTY PLOT
C             106) HYPERBOLIC PROBABILTY PLOT (NOT WORKING)
C             107) GENERALIZED LOGISTIC TYPE 5 PROBABILTY PLOT
C             108) GENERALIZED LOGISTIC TYPE 2 PROBABILTY PLOT
C             109) WAKEBY PROBABILTY PLOT
C             110) BETA NORMAL PROBABILTY PLOT
C             111) GENERALIZED LOGISTIC TYPE 3 PROBABILTY PLOT
C             114) GENERALIZED LOGISTIC TYPE 4 PROBABILTY PLOT
C             115) 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--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MAY       1990.  IG, WALD, RIG, FL (SAUNDERS)
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --MAY       1993. MINMAX FOR EV1/EV2/WEIB DIST.
C     UPDATED         --MAY       1993. ADD GUMBEL NAME FOR EV1
C     UPDATED         --MAY       1993. ADD FRECHET NAME FOR EV2
C     UPDATED         --MAY       1993. COMPUTE & STORE PPCC
C     UPDATED         --DECEMBER  1993. SIMPLIFY STORAGE OF PPCC
C     UPDATED         --DECEMBER  1993. CALC & STORE OTHER PP STAT
C     UPDATED         --DECEMBER  1993. GENERALIZED PARETO
C     UPDATED         --DECEMBER  1993. LINFIT ARGS
C     UPDATED         --SEPTEMBER 1994. NEW DISTRIBUTIONS
C     UPDATED         --APRIL     1995. NEW DISTRIBUTIONS
C     UPDATED         --SEPTEMBER 1995. ARCSIN AND ANGLIT DISTRIBUTIONS
C     UPDATED         --SEPTEMBER 1995. FOLDED NORMAL DISTRIBUTIONS
C     UPDATED         --SEPTEMBER 1995. TRUNCATED NORMAL DISTRIBUTIONS
C     UPDATED         --OCTOBER   1995. LOG GAMMA DISTRIBUTIONS
C     UPDATED         --OCTOBER   1995. HYPERBOLIC SECANT DISTRIBUTIONS
C     UPDATED         --OCTOBER   1995. GOMPERTZ DISTRIBUTION
C     UPDATED         --OCTOBER   1995. HALF-LOGISTIC
C     UPDATED         --OCTOBER   1995. GENERALIZED EXTREME VALUE
C     UPDATED         --OCTOBER   1995. HALF CAUCHY
C     UPDATED         --OCTOBER   1995. PARETO SECOND KIND
C     UPDATED         --OCTOBER   1995. DOUBLE WEIBULL
C     UPDATED         --OCTOBER   1995. EXPONENTIAL WEIBULL
C     UPDATED         --OCTOBER   1995. TRUNCATED EXPONENTIAL
C     UPDATED         --OCTOBER   1995. WRAPPED CAUCHY
C     UPDATED         --DECEMBER  1995. GENERALIZED LOGISTIC
C     UPDATED         --JANUARY   1996. DOUBLE GAMMA
C     UPDATED         --JANUARY   1996. MIELKE BETA KAPPA
C     UPDATED         --JANUARY   1996. FOLDED CAUCHY
C     UPDATED         --FEBRUARY  1996. BETA BINOMIAL
C     UPDATED         --FEBRUARY  1996. BETA PASCAL
C     UPDATED         --FEBRUARY  1996. GENERALIZED EXPONENTIAL
C     UPDATED         --MAY       1996. RECIPROCAL
C     UPDATED         --MAY       1998. NORMAL MIXTURE
C     UPDATED         --MAY       1998. INVERTED GAMMA
C     UPDATED         --AUGUST    2001. GENERALIZED LAMBDA
C     UPDATED         --SEPTEMBER 2001. JOHNSON SB
C     UPDATED         --SEPTEMBER 2001. JOHNSON SU
C     UPDATED         --SEPTEMBER 2001. INVERTED WEIBULL
C     UPDATED         --SEPTEMBER 2001. LOG DOUBLE EXPONENTIAL
C     UPDATED         --SEPTEMBER 2001. BUG FIX FOR TRIANGULAR
C     UPDATED         --NOVEMBER  2001. GEOMETRIC EXTREME EXPO
C     UPDATED         --MAY       2002. TWO-SIDED POWER
C     UPDATED         --MAY       2002. BIWEIBULL
C     UPDATED         --JANUARY   2003. G-AND-H
C     UPDATED         --APRIL     2003. LANDAU
C     UPDATED         --MAY       2003. ERROR
C     UPDATED         --JUNE      2003. TRAPEZOID
C     UPDATED         --JUNE      2003. GENERALIZED TRAPEZOID
C     UPDATED         --NOVEMBER  2003. FOLDED T
C     UPDATED         --DECEMBER  2003. SUPPORT FOR MU PARAMETER FOR
C                                       INVERSE GAUSSIAN, RECIPROCAL
C                                       INVERSE GAUSSIAN
C     UPDATED         --DECEMBER  2003. SLASH, SKEWED NORMAL,
C     UPDATED         --                INVERTED BETA, SKEWED T,
C     UPDATED         --                GOMPERTZ-MAKEHAM
C     UPDATED         --MARCH     2004. LOG-SKEW-NORMAL
C     UPDATED         --MARCH     2004. LOG-SKEW-T
C     UPDATED         --MARCH     2004. MAKE COMMAND SEARCH TABLE
C                                       DRIVEN
C     UPDATED         --MARCH     2004. POLYA
C     UPDATED         --APRIL     2004. HERMITE
C     UPDATED         --APRIL     2004. YULE
C     UPDATED         --MAY       2004. PERFORM A BIWEIGHT FIT TO
C                                       OBTAIN ALTERNATE ESTIMATES
C                                       FOR LOCATION AND SCALE (FOR
C                                       LONG TAILED DISTRIBUTIONS SUCH
C                                       AS CAUCHY)
C     UPDATED         --JUNE      2004. SKEW 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 DOUBLE
C                                       EXPONENTIAL
C     UPDATED         --AUGUST    2004. GENERALIZED INVERSE GAUSSIAN
C     UPDATED         --SEPTEMBER 2004. MCLEISH
C     UPDATED         --SEPTEMBER 2004. BESSEL I FUNCTION
C     UPDATED         --SEPTEMBER 2004. BESSEL K FUNCTION
C     UPDATED         --SEPTEMBER 2004. GENERALIZED MCLEISH
C     UPDATED         --SEPTEMBER 2004. HYPERBOLIC
C     UPDATED         --SEPTEMBER 2004. SUPPORT FOR:
C                                       SET PROBABILITY PLOT DATA
C                                           POINTS
C     UPDATED         --OCTOBER   2004. SUPPORT FOR CENSORED DATA
C     UPDATED         --DECEMBER  2004. CLARIFY SHAPE PARAMETERS FOR
C                                       PARETO PARETO SECOND KIND
C     UPDATED         --APRIL     2005. FOR BINNED DATA, SUPPORT CASE
C                                       WHERE LOWER AND UPPER BIN
C                                       BOUNDARIES SPECIFIED RATHER
C                                       THAN THE MID-POINTS.  THIS
C                                       ALLOWS USER FLEXIBILITY IN
C                                       COMBINING BINS
C     UPDATED         --AUGUST    2005. LOG LAPLACE AS SYNONYM FOR
C                                       LOG DOUBLE EXPONENTIAL
C     UPDATED         --FEBRUARY  2006. GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006. WAKEBY
C     UPDATED         --FEBRUARY  2006. FMKL PARAMETERIZATION OF
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 EXPO
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
CCCCC THE FOLLOWING LINE WAS ADDED     DECEMBER 1993
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
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 IHRI2H
      CHARACTER*4 IHRI22
      CHARACTER*4 IERRO4
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
CCCCC THE FOLLOWING LINE WAS ADDED    DECEMBER 1993
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 LOWLTY
      CHARACTER*4 UPPLTY
      CHARACTER*4 ICENSO
      CHARACTER*4 IMETHD
C
      CHARACTER*30 IDIST
C
      PARAMETER (NUMCHS=203)
      CHARACTER*4 INAME(NUMCHS,4)
      CHARACTER*4 INCASE(NUMCHS)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION XHIGH(MAXOBV)
      DIMENSION WEIGHH(MAXOBV)
      DIMENSION WEIGHV(MAXOBV)
      DIMENSION PREDBW(MAXOBV)
      DIMENSION RESBW(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),WEIGHH(1))
      EQUIVALENCE (GARBAG(IGARB4),WEIGHV(1))
      EQUIVALENCE (GARBAG(IGARB5),PREDBW(1))
      EQUIVALENCE (GARBAG(IGARB6),RESBW(1))
      EQUIVALENCE (GARBAG(IGARB7),XHIGH(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
CCCCC THE FOLLOWING LINE WAS ADDED (FOR MINMAX)    MAY 1993
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOS2.INC'
CCCCC THE FOLLOWING LINE WAS ADDED (FOR IHOST1/2)   MAY 1993
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C  MARCH 2004.  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)/'HLPP'/
      DATA (INAME(17,J),J=1,4)/'HALF','LOGI','    ','    '/
      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'/
      DATA (INAME(40,J),J=1,4)/'BINO','    ','    ','    '/
      DATA INCASE(41)/'GEPP'/
      DATA (INAME(41,J),J=1,4)/'GEOM','    ','    ','    '/
      DATA INCASE(42)/'POPP'/
      DATA (INAME(42,J),J=1,4)/'POIS','    ','    ','    '/
      DATA INCASE(43)/'NBPP'/
      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'/
      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'/
      DATA (INAME(82,J),J=1,4)/'HYPE','    ','    ','    '/
      DATA INCASE(83)/'HYPP'/
      DATA (INAME(83,J),J=1,4)/'HYPE','GEO ','    ','    '/
      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'/
      DATA (INAME(96,J),J=1,4)/'LOGA','SERI','    ','    '/
      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'/
      DATA (INAME(102,J),J=1,4)/'WARI','    ','    ','    '/
      DATA INCASE(103)/'YUPP'/
      DATA (INAME(103,J),J=1,4)/'YULE','    ','    ','    '/
      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)/'HCPP'/
      DATA (INAME(111,J),J=1,4)/'HALF','CAUC','    ','    '/
      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)/'HNPP'/
      DATA (INAME(114,J),J=1,4)/'HALF','    ','    ','    '/
      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)/'BI  ','WEIB','    ','    '/
      DATA INCASE(140)/'BWPP'/
      DATA (INAME(140,J),J=1,4)/'BIWE','    ','    ','    '/
      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'/
      DATA (INAME(163,J),J=1,4)/'POLY','    ','    ','    '/
      DATA INCASE(164)/'HEPP'/
      DATA (INAME(164,J),J=1,4)/'HERM','    ','    ','    '/
      DATA INCASE(165)/'SDPP'/
      DATA (INAME(165,J),J=1,4)/'SKEW','DOUB','EXPO','    '/
      DATA INCASE(166)/'SDPP'/
      DATA (INAME(166,J),J=1,4)/'SKEW','LAPL','    ','    '/
      DATA INCASE(167)/'ADPP'/
      DATA (INAME(167,J),J=1,4)/'ASYM','DOUB','EXPO','    '/
      DATA INCASE(168)/'ADPP'/
      DATA (INAME(168,J),J=1,4)/'ASYM','LAPL','    ','    '/
      DATA INCASE(169)/'MXPP'/
      DATA (INAME(169,J),J=1,4)/'MAXW','    ','    ','    '/
      DATA INCASE(170)/'RAPP'/
      DATA (INAME(170,J),J=1,4)/'RAYL','    ','    ','    '/
      DATA INCASE(171)/'GALP'/
      DATA (INAME(171,J),J=1,4)/'GENE','ASYM','DOUB','EXPO'/
      DATA INCASE(172)/'GALP'/
      DATA (INAME(172,J),J=1,4)/'GENE','ASYM','LAPL','    '/
      DATA (INAME(173,J),J=1,4)/'MCLE','    ','    ','    '/
      DATA INCASE(173)/'MCPP'/
      DATA (INAME(174,J),J=1,4)/'BESS','I   ','FUNC','    '/
      DATA INCASE(174)/'BEIP'/
      DATA (INAME(175,J),J=1,4)/'BESS','I   ','    ','    '/
      DATA INCASE(175)/'BEIP'/
      DATA (INAME(176,J),J=1,4)/'BESS','K   ','FUNC','    '/
      DATA INCASE(176)/'BEKP'/
      DATA (INAME(177,J),J=1,4)/'BESS','K   ','    ','    '/
      DATA INCASE(177)/'BEKP'/
      DATA (INAME(178,J),J=1,4)/'GENE','MCLE','    ','    '/
      DATA INCASE(178)/'GMCP'/
      DATA INCASE(179)/'LXPP'/
      DATA (INAME(179,J),J=1,4)/'LOG ','LAPL','    ','    '/
      DATA INCASE(180)/'G5PP'/
      DATA (INAME(180,J),J=1,4)/'GENE','LOGI','TYPE','5   '/
      DATA INCASE(181)/'G5PP'/
      DATA (INAME(181,J),J=1,4)/'GENE','LOGI','TYPE','V   '/
      DATA INCASE(182)/'G5PP'/
      DATA (INAME(182,J),J=1,4)/'GENE','LOGI','HOSK','    '/
      DATA INCASE(183)/'G5PP'/
      DATA (INAME(183,J),J=1,4)/'HOSK','GENE','LOGI','    '/
      DATA INCASE(184)/'G5PP'/
      DATA (INAME(184,J),J=1,4)/'TYPE','5   ','GENE','LOGI'/
      DATA INCASE(185)/'G5PP'/
      DATA (INAME(185,J),J=1,4)/'TYPE','V   ','GENE','LOGI'/
      DATA INCASE(186)/'G2PP'/
      DATA (INAME(186,J),J=1,4)/'GENE','LOGI','TYPE','2   '/
      DATA INCASE(187)/'G2PP'/
      DATA (INAME(187,J),J=1,4)/'GENE','LOGI','TYPE','II  '/
      DATA INCASE(188)/'G2PP'/
      DATA (INAME(188,J),J=1,4)/'TYPE','2   ','GENE','LOGI'/
      DATA INCASE(189)/'G2PP'/
      DATA (INAME(189,J),J=1,4)/'TYPE','II  ','GENE','LOGI'/
      DATA INCASE(190)/'G3PP'/
      DATA (INAME(190,J),J=1,4)/'GENE','LOGI','TYPE','3   '/
      DATA INCASE(191)/'G3PP'/
      DATA (INAME(191,J),J=1,4)/'GENE','LOGI','TYPE','III '/
      DATA INCASE(192)/'G3PP'/
      DATA (INAME(192,J),J=1,4)/'TYPE','3   ','GENE','LOGI'/
      DATA INCASE(193)/'G3PP'/
      DATA (INAME(193,J),J=1,4)/'TYPE','III ','GENE','LOGI'/
      DATA INCASE(194)/'G4PP'/
      DATA (INAME(194,J),J=1,4)/'GENE','LOGI','TYPE','4   '/
      DATA INCASE(195)/'G4PP'/
      DATA (INAME(195,J),J=1,4)/'GENE','LOGI','TYPE','IV  '/
      DATA INCASE(196)/'G4PP'/
      DATA (INAME(196,J),J=1,4)/'TYPE','4   ','GENE','LOGI'/
      DATA INCASE(197)/'G4PP'/
      DATA (INAME(197,J),J=1,4)/'TYPE','IV  ','GENE','LOGI'/
      DATA INCASE(198)/'GLPP'/
      DATA (INAME(198,J),J=1,4)/'GENE','LOGI','    ','    '/
      DATA INCASE(199)/'LDPP'/
      DATA (INAME(199,J),J=1,4)/'GENE','LAMB','    ','    '/
      DATA INCASE(200)/'BEPP'/
      DATA (INAME(200,J),J=1,4)/'BETA','    ','    ','    '/
      DATA INCASE(201)/'LXPP'/
      DATA (INAME(201,J),J=1,4)/'LOG ','LAPL','    ','    '/
      DATA INCASE(202)/'AXPP'/
      DATA (INAME(202,J),J=1,4)/'ASYM','LOG ','DOUB','EXPO'/
      DATA INCASE(203)/'AXPP'/
      DATA (INAME(203,J),J=1,4)/'ASYM','LOG ','LAPL','    '/
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      ICENSO='OFF'
      IMETHD='UNIM'
      IF(IPPLCN.EQ.'KAPL')IMETHD=IPPLCN
C
      ISUBN1='DPPP'
      ISUBN2='    '
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
      ICOLR2=0
C
C               ***************************************
C               **  TREAT THE PROBABILITY PLOT CASE  **
C               ***************************************
C
      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'DPPP')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPPP--')
        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 ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      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
        IF(IHARG(I1).EQ.'PROB'.AND.IHARG(I2).EQ.'PLOT')THEN
          ILASTC=I2
          GOTO112
        ELSEIF(IHARG(I1).EQ.'CENS'.AND.IHARG(I2).EQ.'PROB'.AND.
     1         IHARG(I3).EQ.'PLOT')THEN
          ICENSO='ON'
          ILASTC=I3
          GOTO112
        END IF
C
  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'
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.'DPPP')
     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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'DPPP')THEN
        WRITE(ICOUT,311)IHLEFT,IHLEF2,ICOLL,NLEFT
  311   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     **
C               **  (NLEFT) FOR THE RESPONSE VARIABLE IS POSITIVE.  **
C               ******************************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,411)
  411   FORMAT('***** ERROR IN PROBABILITY PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,412)IHLEFT,IHLEF2
  412   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1         'IN VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,413)
  413   FORMAT('      (FOR WHICH A PROBABILITY PLOT WAS TO HAVE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,415)MINN2
  415   FORMAT('      BEEN FORMED) MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,416)
  416   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,417)
  417   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
  418     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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,581)
  581   FORMAT('***** INTERNAL ERROR IN DPPP')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,582)
  582   FORMAT('      AT BRANCH POINT 481--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,583)
  583   FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH NUMARG HAD ',
     1         'PREVIOUSLY')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,585)NUMARG
  585   FORMAT('      PASSED THIS TEST ONCE ALREADY.  VALUE OF ',
     1         'NUMARG = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,586)
  586   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,417)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO500J=1,NUMARG
        J1=J
        IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')THEN
          ICASEQ='SUBS'
          ILOCQ=J1
          GOTO590
        ELSEIF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')THEN
          ICASEQ='SUBS'
          ILOCQ=J1
          GOTO590
        ELSEIF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')THEN
          ICASEQ='FOR'
          ILOCQ=J1
          GOTO590
        ENDIF
  500 CONTINUE
C
  590 CONTINUE
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
        WRITE(ICOUT,591)NUMARG,ILOCQ,ICASEQ
  591   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C     *********************************************************
C     **  STEP 6--                                           **
C     **  THE FOLLOWING CASES OF MORE THAN ONE ARGUMENT      **
C     **  ARE SUPPORTED:                                     **
C     **  ... PROB PLOT Y X1           - FREQUENCY DATA      **
C     **  ... PROB PLOT Y XLOW XUPP    - FREQUENCY DATA      **
C     **  ... PROB PLOT Y X1           - CENSORED DATA       **
C     *********************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IRESV=1
      ICENV=0
      IFREV=0
      IFREV2=0
C
      NUMEXP=1
      IF(ICENSO.EQ.'ON')NUMEXP=NUMEXP+1
C
      IF(NUMV2.EQ.NUMEXP)THEN
        IDATSW='RAW'
        IF(ICENSO.EQ.'ON')ICENV=2
      ELSEIF(NUMV2.EQ.NUMEXP+1)THEN
        IDATSW='FREQ'
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,611)
  611     FORMAT('***** ERROR IN PROBABILITY PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,613)
  613     FORMAT('      FREQUENCY DATA NOT SUPPORTED FOR CENSORED ',
     1           'CASE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,417)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ELSE
          IFREV=2
          IFREV2=0
        ENDIF
      ELSEIF(NUMV2.EQ.NUMEXP+2)THEN
        IDATSW='FRE2'
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,611)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,613)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,417)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ELSE
          IFREV=2
          IFREV2=3
        ENDIF
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,611)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,623)NUMEXP,NUMEXP+1,NUMEXP+2
  623   FORMAT('      EITHER ',I8,', ',I8,' OR ',I8,
     1         ' VARIABLES EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,625)NUMV2
  625   FORMAT('      NUMBER OF VARIABLES ENTERED = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,417)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMV2.GE.2)THEN
        IHRIGH=IHARG(2)
        IHRIG2=IHARG2(2)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLR=IVALUE(ILOCV)
        NRIGHT=IN(ILOCV)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
          WRITE(ICOUT,641)IHRIGH,IHRIG2,ICOLR,NRIGHT
  641     FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(NRIGHT.NE.NLEFT)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,611)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,652)
  652     FORMAT('      FOR A ... PROBABILITY PLOT WITH TWO ',
     1           'VARIABLES SPECIFIED,')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,653)
  653     FORMAT('      THE NUMBER OF ELEMENTS IN THE TWO VARIABLES')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,655)
  655     FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,657)IHLEFT,IHLEF2,NLEFT
  657     FORMAT('      THE FIRST  VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,658)IHRIGH,IHRIG2,NRIGHT
  658     FORMAT('      THE SECOND VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,417)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
      IF(NUMV2.GE.3)THEN
        IHRI2H=IHARG(3)
        IHRI22=IHARG2(3)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHRI2H,IHRI22,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLR2=IVALUE(ILOCV)
        NRIGH2=IN(ILOCV)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
          WRITE(ICOUT,661)IHRI2H,IHRI22,ICOLR2,NRIGH2
  661     FORMAT('IHRI2H,IHRI22,ICOLR2,NRIGH2 = ',A4,2X,A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(NRIGH2.NE.NLEFT)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,611)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,672)
  672     FORMAT('      FOR A ... PROBABILITY PLOT WITH THREE ',
     1           'VARIABLES SPECIFIED,')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,673)
  673     FORMAT('      THE NUMBER OF ELEMENTS IN THE THREE VARIABLES')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,675)
  675     FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,677)IHLEFT,IHLEF2,NLEFT
  677     FORMAT('      THE FIRST VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,678)IHRI2H,IHRI22,NRIGH2
  678     FORMAT('      THE THIRD VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,417)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
      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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'SUBS')THEN
        NIOLD=NLEFT
        CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
        NQ=NIOLD
      ELSEIF(ICASEQ.EQ.'FOR')THEN
        NIOLD=NLEFT
        CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1             NLOCAL,ILOCS,NS,IBUGQ,IERROR)
        NQ=NFOR
      ELSE
        DO715I=1,NLEFT
          ISUB(I)=1
  715   CONTINUE
        NQ=NLEFT
      ENDIF
C
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO760I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO760
        J=J+1
C
C  RESPONSE VARIABLE IN Y1
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)
C
C  CLASS VARIABLE IN X1 FOR FREQUENCY DATA
C
        IF(IFREV.GT.0)THEN
          ICOLT=ICOLR
          IJ=MAXN*(ICOLT-1)+I
          IF(ICOLT.LE.MAXCOL)X1(J)=V(IJ)
          IF(ICOLT.EQ.MAXCP1)X1(J)=PRED(I)
          IF(ICOLT.EQ.MAXCP2)X1(J)=RES(I)
          IF(ICOLT.EQ.MAXCP3)X1(J)=YPLOT(I)
          IF(ICOLT.EQ.MAXCP4)X1(J)=XPLOT(I)
          IF(ICOLT.EQ.MAXCP5)X1(J)=X2PLOT(I)
          IF(ICOLT.EQ.MAXCP6)X1(J)=TAGPLO(I)
        ENDIF
C
C  IF FREQUENCY DATA GIVEN WITH LOWER AND UPPER CLASS LIMITS, THEN
C  UPPER CLASS LIMIT VARIABLE IN XHIGH
C
        IF(IFREV2.GT.0)THEN
          ICOLT=ICOLR2
          IJ=MAXN*(ICOLT-1)+I
          IF(ICOLT.LE.MAXCOL)XHIGH(J)=V(IJ)
          IF(ICOLT.EQ.MAXCP1)XHIGH(J)=PRED(I)
          IF(ICOLT.EQ.MAXCP2)XHIGH(J)=RES(I)
          IF(ICOLT.EQ.MAXCP3)XHIGH(J)=YPLOT(I)
          IF(ICOLT.EQ.MAXCP4)XHIGH(J)=XPLOT(I)
          IF(ICOLT.EQ.MAXCP5)XHIGH(J)=X2PLOT(I)
          IF(ICOLT.EQ.MAXCP6)XHIGH(J)=TAGPLO(I)
        ENDIF
C
C  CENSORING VARIABLE IN X1 FOR CENSORED DATA (CENSORING NOT
C  SUPPORTED FOR GROUPED DATA)
C
        IF(ICENSO.EQ.'ON')THEN
          ICOLT=ICOLR
          IJ=MAXN*(ICOLT-1)+I
          IF(ICOLT.LE.MAXCOL)X1(J)=V(IJ)
          IF(ICOLT.EQ.MAXCP1)X1(J)=PRED(I)
          IF(ICOLT.EQ.MAXCP2)X1(J)=RES(I)
          IF(ICOLT.EQ.MAXCP3)X1(J)=YPLOT(I)
          IF(ICOLT.EQ.MAXCP4)X1(J)=XPLOT(I)
          IF(ICOLT.EQ.MAXCP5)X1(J)=X2PLOT(I)
          IF(ICOLT.EQ.MAXCP6)X1(J)=TAGPLO(I)
        ENDIF
C
  760 CONTINUE
      NLOCAL=J
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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'LAPP')THEN
        IHP='LAMB'
        IHP2='DA  '
        IDIST='LAMBDA'
        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
        IHP='NU  '
        IHP2='    '
        IDIST='T'
        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
        IHP='NU  '
        IHP2='    '
        IDIST='CHI-SQUARED'
        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
        IHP='NU1 '
        IHP2='    '
        IDIST='F     '
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='GAMMA'
        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
        IHP='ALPH'
        IHP2='A   '
        IDIST='BETA'
        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
        IHP='ALPH'
        IHP2='A   '
        IDIST='BETA'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='WEIBULL'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='EXTREME VALUE TYPE 2'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='PARETO'
        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
        IHP='N   '
        IHP2='    '
        IDIST='BINOMIAL'
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NPAR,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
        IHP='P   '
        IHP2='    '
        IDIST='GEOMETRIC'
        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
        IHP='LAMB'
        IHP2='DA  '
        IDIST='POISSON'
        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
        IHP='K   '
        IHP2='    '
        IDIST='NEGATIVE BINOMIAL'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='INVERSE GAUSSIAN'
        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
C
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='WALD'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='RECIRPOCAL INVERSE GAUSSIAN'
        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
C
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='FATIGUE LIFE'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='GENERALIZED PARETO'
        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
        IHP='C   '
        IHP2='    '
        IDIST='TRIANGULAR'
        ALOWLM=-1.0
        AUPPLM=1.0
        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
        IHP='N   '
        IHP2='    '
        IDIST='T'
        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
        IHP='NU  '
        IHP2='    '
        IDIST='NON-CENTRAL CHI-SQUARED'
        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
        IHP='NU1 '
        IHP2='    '
        IDIST='NON-CENTRAL F'
        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
        IHP='NU  '
        IHP2='    '
        IDIST='NON-CENTRAL T'
        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
        IHP='NU1 '
        IHP2='    '
        IDIST='DOUBLY NON-CENTRAL F'
        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
        IF(ICOM2.EQ.'BOLO')THEN
          IDIST='HYPERBOLIC'
          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='XI  '
          IHP2='A   '
          ALOWLM=0.
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,XI,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ELSE
          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
      ENDIF
      IF(ICASPL.EQ.'VMPP')THEN
        IHP='B   '
        IHP2='    '
        IDIST='VON MISES'
        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
        IHP='P   '
        IHP2='    '
        IDIST='POWER NORMAL'
        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.'PLPP')THEN
        IHP='P   '
        IHP2='    '
        IDIST='POWER LOG-NORMAL'
        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
        IHP='ALPH'
        IHP2='A   '
        IDIST='ALPHA'
        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
        IHP='C   '
        IHP2='    '
        IDIST='POWER FUNCTION'
        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
        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
        IHP='DELT'
        IHP2='A   '
        IDIST='LOG-LOGISTIC'
        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
        IHP='ALPH'
        IHP2='A   '
        IDIST='GENERALIZED GAMMA'
        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 DPCHSQ--')
          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.'YUPP')THEN
        IDIST='YULE'
        IHP='P   '
        IHP2='    '
        ALOWLM=0.1
        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.'WRPP')THEN
        IHP='C   '
        IHP2='    '
        IDIST='WARING'
        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 DPCHSQ--')
          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 CHI-SQUARE 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
        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.'TNPP')THEN
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='LOG-GAMMA'
        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
        IHP='C   '
        IHP2='    '
        IDIST='GOMPERTZ'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='GENERALIZED EXTREME VALUE'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='GENERALIZED HALF LOGISTIC'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='PARETO TYPE 2'
        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.'DWPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='DOUBLE WEIBULL'
        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
        IHP='P   '
        IHP2='    '
        IDIST='WRAPPED CAUCHY'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='EXPONENTIATED WEIBULL'
        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
        IHP='ALPH'
        IHP2='A   '
        IDIST='GENERALIZED LOGISTIC'
        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.'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.'G2PP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 2'
C
        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.'G3PP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 3'
C
        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.'G4PP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 4'
C
        IHP='P   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='Q   '
        IHP2='    '
        ALOWLM=0.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
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
        IHP='BETA'
        IHP2='    '
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='DOUBLE GAMMA'
        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
        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
          AM=0.0
        ELSE
          AM=VALUE(ILOCP)
        ENDIF
C
        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'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BBPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='BETA-BINOMIAL'
        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.'PZPP')THEN
        IDIST='POLYA'
        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.'HEPP')THEN
        IDIST='HERMITE'
        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.'BRPP')THEN
        IHP='BETA'
        IHP2='    '
        IDIST='BRADFORD'
        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
        IHP='LAMB'
        IHP2='DA1 '
        IDIST='GENERALIZED EXPONENTIAL'
        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
        IHP='B   '
        IHP2='    '
        IDIST='RECIPROCAL'
        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
        IHP='U1  '
        IHP2='    '
        IDIST='NORMAL MIXTURE'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='INVERTED GAMMA'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='INVERTED WEIBULL'
        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
        IHP='ALPH'
        IHP2='A   '
        IDIST='LOG DOUBLE EXPONENTIAL'
        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
        IHP='ALPH'
        IHP2='A1  '
        IDIST='JOHNSON SU'
        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
        IHP='ALPH'
        IHP2='A1  '
        IDIST='JOHNSON SB'
        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
        IHP='LAMB'
        IHP2='DA3 '
        IDIST='GENERALIZED TUKEY-LAMBDA'
        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
        IHP='GAMM'
        IHP2='A   '
        IDIST='GEOMETRIC EXTREME EXPONENTIAL'
        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
C
      IF(ICASPL.EQ.'ERPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='ERROR (EXPONENTIAL POWER)'
        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
C
      IF(ICASPL.EQ.'TSPP')THEN
        IHP='THET'
        IHP2='A   '
        IDIST='TWO-SIDED POWER'
        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
        IHP='SCAL'
        IHP2='E1  '
        IDIST='BIWEIBULL'
        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='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALOC2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'TZPP')THEN
        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
        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
        IHP='NU  '
        IHP2='    '
        IDIST='FOLDED T'
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        NU=INT(ANU+0.5)
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'SNPP')THEN
        IHP='LAMB'
        IHP2='DA  '
        IDIST='SKEWED NORMAL'
        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.'TNPP')THEN
        IHP='NU  '
        IHP2='    '
        IDIST='SKEWED T'
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        NU=INT(ANU+0.5)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA  '
        IDIST='SKEWED NORMAL'
        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
        IHP='ALPH'
        IHP2='A   '
        IDIST='INVERTED BETA'
        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)
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        IHP='THET'
        IHP2='A   '
        LOWLTY='>=  '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GHPP')THEN
        IHP='G   '
        IHP2='    '
        IDIST='G-H'
        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
        IHP='LAMB'
        IHP2='DA  '
        IDIST='LOG-SKEW-NORMAL'
        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
        IHP='LAMB'
        IHP2='DA  '
        IDIST='LOG-SKEW-T'
        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
C
        IHP='NU  '
        IHP2='    '
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        NU=INT(ANU+0.5)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'SDPP')THEN
        IDIST='SKEWED DOUBLE EXPONENTIAL'
        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
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
        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.'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               *****************************************************
C               **  STEP 9--                                       **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
C               **  RESET THE VECTOR D(.) TO ALL ONES.             **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'DPPP')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5111)
 5111   FORMAT('***** FROM THE MIDDLE  OF DPPP--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5112)ICASPL,NUMV2,IDATSW,NPLOTP,NPLOTV
 5112   FORMAT('ICASPL,NUMV2,IDATSW,NPLOTP,NPLOTV = ',
     1         A4,I8,2X,A4,2I8)
        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 ')
        IF(NPLOTP.GE.1)THEN
          DO5115I=1,NPLOTP
            WRITE(ICOUT,5116)I,Y(I),X(I),D(I)
 5116       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
            CALL DPWRST('XXX','BUG ')
 5115     CONTINUE
        ENDIF
      ENDIF
C
      CALL DPPP2(Y1,X1,XHIGH,NLOCAL,ICASPL,IDATSW,
     1ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,NPAR,P,K,MINMAX,
     1ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,MPAR,B,SD,THETA,DELTA,A,
     1AM,X0,
     1U1,SD1,U2,SD2,DZ,
CCCCC ADD FOLLOWING LINE  AUGUST 2001.
     1ALAMB3,ALAMB4,ALPHA1,ALPHA2,
CCCC ADD FOLLOWING LINE MAY 2002.
     1ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,
CCCC ADD FOLLOWING LINE JANUARY 2003.
     1G,H,ANU3,
     1AMU,XI,AK,SIGMA,
     1ETA,ZETA,CHI,TAU,Q,
     1IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1ILGADF,ISKNDF,IGLDDF,
     1IPPLDP,MAXOBV,ICENSO,IMETHD,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
CCCCC MINMAX WAS ADDED ABOVE AS AN ARGUMENT   MAY 1993
CCCCC ANU, ANU1, ANU2, NDUN, C, B ADDED AS ARGUMENTS   SEPTEMBER 1994
CCCCC AM ADDED AS ARGUMENTS   SEPTEMBER 1995
C
CCCCC THE FOLLOWING ENTIRE SECTION WAS ADDED           MAY 1993
CCCCC TO ALLOW AUTO-COMPUTATION OF THE PROB. PLOT CORR. COEF MAY 1993
CCCCC THE FOLLOWING ENTIRE SECTION WAS THEN CHANGED    DECEMBER 1993
C
C               ***************************************
C               **  STEP 61--                        **
C               **  COMPUTE PROB PLOT STAT           **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPPP'
CCCCC CALL CORR(Y,X,NPLOTP,IWRITE,PPCC,IBUGG3,IERROR)
      CALL LINFIT(Y,X,NPLOTP,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
C
      IH='PPCC'
      IH2='    '
      VALUE0=CCXY
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='PPA0'
      IH2='    '
      VALUE0=ALPHA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='PPA1'
      IH2='    '
      VALUE0=BETA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SDPP'
      IH2='A0  '
      VALUE0=SDALPH
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SDPP'
      IH2='A1  '
      VALUE0=SDBETA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='PPRE'
      IH2='SSD '
      VALUE0=XRESSD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='PPRE'
      IH2='SDF '
      VALUE0=XRESDF
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
CCCCC MAY 2004: NOW DO 1 ITERATION OF BIWEIGHT ON RESIDUALS.
CCCCC           THIS SEEMS TO PRODUCE BETTER ESTIMATES OF
CCCCC           LOCATION AND SCALE FOR SOME HEAVY TAILED
CCCCC           DISTRIBUTIONS (E.G., CAUCHY, SLASH).
C
      DO6010I=1,NPLOTP
        RESBW(I)=Y(I) - (ALPHA + BETA*X(I))
        WEIGHH(I)=1.0
        WEIGHV(I)=1.0
 6010 CONTINUE
      IWRITE='OFF'
      CALL BIWEIG(RESBW,NPLOTP,IWRITE,WEIGHV,IBUGG3,IERROR)
C
      IT=1
      I1=1
      I2=NPLOTP
      I3=1
      I4=NPLOTP
      XMAXHF=1.0
C
      CALL LINEAR(IT,I1,I2,X,Y,WEIGHH,WEIGHV,NPLOTP,XMAXHF,I3,I4,
     1PPA0BW,PPA1BW,PREDBW,RESBW,
     1ISUBRO,IBUGG3,IERROR)
C
      DO6020I=1,NPLOTP
        RESBW(I)=Y(I) - (PPA0BW + PPA1BW*X(I))
 6020 CONTINUE
      CALL BIWEIG(RESBW,NPLOTP,IWRITE,WEIGHV,IBUGG3,IERROR)
      CALL LINEAR(IT,I1,I2,X,Y,WEIGHH,WEIGHV,NPLOTP,XMAXHF,I3,I4,
     1PPA0BW,PPA1BW,PREDBW,RESBW,
     1ISUBRO,IBUGG3,IERROR)
C
      IH='PPA0'
      IH2='BW  '
      VALUE0=PPA0BW
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='PPA1'
      IH2='BW  '
      VALUE0=PPA1BW
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'DPPP')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPPP--')
        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 = ',
     1         I8,I8,I8,2X,A4,2X,A4,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 ')
        IF(NPLOTP.GE.1)THEN
          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
        ENDIF
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPPP2(Y,X,XHIGH,N,ICASPL,IDATSW,
     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,
CCCCC ADD FOLLOWING LINE  AUGUST 2001.
     1ALAMB3,ALAMB4,ALPHA1,ALPHA2,
CCCC ADD FOLLOWING LINE MAY 2002.
     1ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,
CCCC ADD FOLLOWING LINE JANUARY 2003.
     1G,H,ANU3,
     1AMU,XI,AK,SIGMA,
     1ETA,ZETA,CHI,TAU,Q,
     1IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1ILGADF,ISKNDF,IGLDDF,
     1IPPLDP,MAXOBV,ICENSO,IMETHD,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
CCCCC MINMAX WAS ADDED ABOVE AS ANA RGUMENT   MAY 1993
CCCCC ANU, ANU1, ANU2, NDUN, C, B ADDED AS ARGUMENTS   SEPTEMBER 1994
CCCCC AM ADDED AS ARGUMENT   SEPTEMBER 1995
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A PROBABILITY PLOT FOR SOME 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--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MAY       1990.  IG, WALD, RIG, FL (SAUNDERS)
C     UPDATED         --MAY       1992.  MOVE KPAR SINCE UNDEFINED
C     UPDATED         --MAY       1993.  MINMAX FOR EV1/EV2/WEIB DIST.
C     UPDATED         --DECEMBER  1993.  GENERALIZED PARETO
C     UPDATED         --DECEMBER  1993.  FIX TRACE INFO
C     UPDATED         --SEPTEMBER 1994.  ADD 9 DISTRIBUTIONS, FIX TRIANG
C     UPDATED         --APRIL     1995.  ADD NEW DISTRIBUTIONS
C     UPDATED         --SEPTEMBER 1995.  ADD NEW DISTRIBUTIONS
C     UPDATED         --OCTOBER   1995.  ADD NEW DISTRIBUTIONS
C     UPDATED         --DECEMBER  1995.  ADD NEW DISTRIBUTIONS
C     UPDATED         --JANUARY   1996.  ADD DOUBLE GAMMA, MIELKE'S 
C                                        BETA-KAPPA, FOLDED CAUCHY
C     UPDATED         --JANUARY   1996.  DO NOT HANDLE LOG-NORMAL SEPARATELY
C     UPDATED         --FEBRUARY  1996.  BETA-BINOMIAL, BETA-PASCAL,
C                                        GENERALIZED EXPONENTIAL
C     UPDATED         --MAY       1996.  RECIPROCAL
C     UPDATED         --FEBRUARY  1998.  FOR BINNED DATA, CHECK FOR
C                                        ZERO COUNT BINS
C     UPDATED         --MAY       1998.  NORMAL MIXTURE
C     UPDATED         --MAY       1998.  INVERTED GAMMA
C     UPDATED         --AUGUST    2001.  GENERALIZED LAMBDA
C     UPDATED         --SEPTEMBER 2001.  JOHNSON SB, JOHNSON SU,
C                                        INVERTED WEIBULL,
C                                        LOG DOUBLE EXPONENTIAL
C     UPDATED         --MAY       2002.  TWO-SIDED POWER
C     UPDATED         --MAY       2002.  BIWEIBULL
C     UPDATED         --JANUARY   2003.  G-AND-H
C     UPDATED         --APRIL     2003.  LANDAU
C     UPDATED         --MAY       2003.  ERROR
C     UPDATED         --JUNE      2003.  TRAPEZOID
C     UPDATED         --JUNE      2003.  GENERALIZED TRAPEZOID
C     UPDATED         --NOVEMBER  2003.  FOLDED T
C     UPDATED         --DECEMBER  2003.  SLASH, INVERTED BETA,
C                                        SKEWED NORMAL, SKEWED T,
C                                        GOMPERTZ-MAKEHAM
C     UPDATED         --MARCH     2004.  LOG-SKEW-NORMAL
C     UPDATED         --MARCH     2004.  LOG-SKEW-T
C     UPDATED         --MARCH     2004.  POLYA
C     UPDATED         --APRIL     2004.  HERMITE
C     UPDATED         --JUNE      2004.  SKEW 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 INVERSE GAUSSIAN
C     UPDATED         --AUGUST    2004.  MCLEISH
C     UPDATED         --AUGUST    2004.  BESSEL I-FUNCTION
C     UPDATED         --SEPTEMBER 2004.  SUPPORT FOR:
C                                          SET PROBABILITY PLOT DATA
C                                              POINTS
C     UPDATED         --OCTOBER   2004.  SUPPORT FOR CENSORED DATA
C     UPDATED         --OCTOBER   2004.  FOR BINNED DATA, REMOVE
C                                        ZERO FREQUENCY BINS
C     UPDATED         --MAY       2005.  FOR BINNED DATA, SUPPORT
C                                        CASE WHERE LOWER AND UPPER
C                                        LIMITS OF BIN GIVEN (AS
C                                        OPPOSSED TO JUST MID-POINTS)
C     UPDATED         --MAY       2005.  ADD ISUBRO BUG SWITCH
C     UPDATED         --JULY      2005.  CALL LIST TO LGAPPF AND SNPPF
C     UPDATED         --FEBRUARY  2006.  GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006.  WAKEBY
C     UPDATED         --FEBRUARY  2006.  FMLK PARAMERIZATION OF
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 LAPLACE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IDATSW
      CHARACTER*4 IADEDF
      CHARACTER*4 IGEPDF
      CHARACTER*4 IMAKDF
      CHARACTER*4 IBEIDF
      CHARACTER*4 ILGADF
      CHARACTER*4 ISKNDF
      CHARACTER*4 IGLDDF
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICENSO
      CHARACTER*4 IMETHD
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 IWRITE
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION XHIGH(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      REAL LANPPF
      DOUBLE PRECISION DX2OUT
C
      DOUBLE PRECISION QUAGLO
      DOUBLE PRECISION QUAWAK
      DOUBLE PRECISION XPAR(5)
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='DPPP'
      ISUBN2='2   '
C
      IERROR='NO'
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT/MOVED MAY 1992 (JJF)
CCCCC KPAR=K
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)
   46   FORMAT('***** ERROR IN PROBABILITY PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)
   47   FORMAT('      THE NUMBER OF OBSERVATIONS WAS LESS THAN OR')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,48)
   48   FORMAT('      EQUAL TO 1.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,49)N
   49   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IDATSW.EQ.'RAW')THEN
        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 PROBABILITY PLOT--')
        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
      ENDIF
   69 CONTINUE
C
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'PPP2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)
   71   FORMAT('***** AT THE BEGINNING OF DPPP2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)ICASPL,IDATSW,N,NPLOTV
   72   FORMAT('ICASPL,IDATSW,N,NPLOTV = ',A4,2X,A4,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 ')
        WRITE(ICOUT,75)MINMAX
   75   FORMAT('MINMAX = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(N.GE.1)THEN
          DO85I=1,N
            WRITE(ICOUT,86)I,Y(I),X(I),XHIGH(I)
   86       FORMAT('I,Y(I),X(I),XHIGH(I) = ',I8,3G12.5)
            CALL DPWRST('XXX','BUG ')
   85     CONTINUE
        ENDIF
        WRITE(ICOUT,89)IPPLDP,IDATSW
   89   FORMAT('      IPPLDP, IDATSW = ',I8,1X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **************************************************
C               **  STEP 1B-                                    **
C               **  IF SET PROBABILITY PLOT DATA POINTS COMMAND **
C               **  WAS ENTERED, THIN DATA SET BY COMPUTING     **
C               **  PERCENTILES OF THE DATA.  CURRENTLY         **
C               **  ONLY SUPPORTED FOR UNBINNED DATA.           **
C               **************************************************

      IF(IPPLDP.GT.0 .AND. IDATSW.EQ.'RAW' .AND. ICENSO.EQ.'OFF')THEN
        NPERC=MAX(20,IPPLDP)
        NPERC=MIN(NPERC,N)
        CALL SORT(Y,N,Y2)
        ASTRT=0.0
        ASTOP=100.0
        AINC=(ASTOP - ASTRT)/REAL(NPERC+1)
        IWRITE='OFF'
        DO110I=1,NPERC
          P100=ASTRT + REAL(I)*AINC
          CALL PERCEN(P100,Y2,N,IWRITE,X2,MAXOBV,
     1                XPERC,IBUGG3,IERROR)
          Y(I)=XPERC
  110   CONTINUE
        N=NPERC
        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'PPP2')THEN
          WRITE(ICOUT,113)IPPLDP,NPERC,N
  113     FORMAT('      IPPLDP, NPERC, N = ',3I8)
          CALL DPWRST('XXX','BUG ')
          DO117I=1,N
            WRITE(ICOUT,118)I,Y(I)
  118       FORMAT('      I, Y(I) = ',I8,G15.7)
            CALL DPWRST('XXX','BUG ')
  117     CONTINUE
        ENDIF
      ENDIF
C
C               **************************************
C               **  STEP 4--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  AND DETERMINE PLOT COORDINATES  **
C               **************************************
C
      IF(IDATSW.EQ.'RAW')GOTO1100
      IF(IDATSW.EQ.'FREQ')GOTO2100
      IF(IDATSW.EQ.'FRE2')GOTO2100
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPPP2 ',
     1'AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      IDATSW SHOULD BE EITHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      RAW, FRE2, OR FREQ, BUT IS NONE OF THESE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)IDATSW
 1014 FORMAT('      IDATSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ****************************************
C               **  STEP 4.1--                        **
C               **  DETERMINE PLOT COORDINATES        **
C               **  FOR THE 1-VARIABLE CASE           **
C               **  (THAT IS, FOR THE RAW DATA CASE)  **
C               ****************************************
C
 1100 CONTINUE
C
CCCCC OCTOBER 2004.  FOR CENSORED CASE, CHECK THAT SECOND VARIABLE
CCCCC                CONTAINS TWO DISTINCT VALUES, SET TO 1 AND 0.
C
      IF(ICENSO.EQ.'ON')THEN
        CALL DISTIN(X,N,IWRITE,X2,NDIST,IBUGG3,IERROR)
        IF(NDIST.EQ.1)THEN
          DO1102I=1,N
            X(I)=1.0
 1102     CONTINUE
        ELSEIF(NDIST.EQ.2)THEN
          IF(X2(1).EQ.1.0 .OR. X2(2).EQ.1.0)THEN
            DO1103I=1,N
              IF(X(I).NE.1.0)X(I)=0.0
 1103       CONTINUE
          ELSE
            ATEMP1=MIN(X2(1),X2(2))
            ATEMP2=MAX(X2(1),X2(2))
            DO1108I=1,N
              IF(X(I).EQ.ATEMP1)X(I)=1.0
              IF(X(I).EQ.ATEMP2)X(I)=0.0
 1108       CONTINUE
          ENDIF
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1104)
 1104     FORMAT('***** ERROR IN PROBABILITY PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1105)
 1105     FORMAT('      FOR CENSORED DATA, THE CENSORING VARIABLE')
          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
        CALL SORTC(Y,X,N,Y2,X)
        XMIN=Y2(1)
        XMAX=Y2(N)
        CALL UNIME3(N,X2,X,IMETHD)
      ELSE
        CALL SORT(Y,N,Y2)
        XMIN=Y2(1)
        XMAX=Y2(N)
        CALL UNIMED(N,X2)
      ENDIF
C
      ICNT=0
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
CCCCC THE FOLLOWING 4 LINES WERE ADDED MAY 1990
      IF(ICASPL.EQ.'IGPP')GOTO1350
      IF(ICASPL.EQ.'WAPP')GOTO1360
      IF(ICASPL.EQ.'RIPP')GOTO1370
      IF(ICASPL.EQ.'FLPP')GOTO1380
CCCCC THE FOLLOWING LINE WAS ADDED     DECEMBER 1993
      IF(ICASPL.EQ.'GPPP')GOTO1390
CCCCC THE FOLLOWING SECTION WAS ADDED  SEPTEMBER 1994
      IF(ICASPL.EQ.'DUPP')GOTO1400
      IF(ICASPL.EQ.'NTPP')GOTO1410
      IF(ICASPL.EQ.'NFPP')GOTO1420
      IF(ICASPL.EQ.'NCPP')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
CCCCC THE FOLLOWING SECTION WAS ADDED  APRIL 1995
      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.'YUPP')GOTO1585
      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
         GAMMA=-1.0
         GOTO1670
      ENDIF
      IF(ICASPL.EQ.'GZPP')GOTO1670
      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.'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.'LDPP')GOTO1850
      IF(ICASPL.EQ.'JBPP')GOTO1860
      IF(ICASPL.EQ.'JUPP')GOTO1870
      IF(ICASPL.EQ.'IWPP')GOTO1880
      IF(ICASPL.EQ.'LXPP')GOTO1890
      IF(ICASPL.EQ.'EEPP')GOTO11900
      IF(ICASPL.EQ.'TSPP')GOTO11910
      IF(ICASPL.EQ.'BWPP')GOTO11920
      IF(ICASPL.EQ.'GHPP')GOTO11930
      IF(ICASPL.EQ.'LUPP')GOTO11940
      IF(ICASPL.EQ.'ERPP')GOTO11950
      IF(ICASPL.EQ.'TZPP')GOTO11960
      IF(ICASPL.EQ.'GTPP')GOTO11970
      IF(ICASPL.EQ.'FTPP')GOTO11980
      IF(ICASPL.EQ.'SLPP')GOTO11990
      IF(ICASPL.EQ.'SNPP')GOTO11200
      IF(ICASPL.EQ.'STPP')GOTO11210
      IF(ICASPL.EQ.'IBPP')GOTO11220
      IF(ICASPL.EQ.'GMPP')GOTO11230
      IF(ICASPL.EQ.'LZPP')GOTO11240
      IF(ICASPL.EQ.'LTPP')GOTO11250
      IF(ICASPL.EQ.'ASPP')GOTO11260
      IF(ICASPL.EQ.'PZPP')GOTO11270
      IF(ICASPL.EQ.'HEPP')GOTO11280
      IF(ICASPL.EQ.'SDPP')GOTO11290
      IF(ICASPL.EQ.'ADPP')GOTO11300
      IF(ICASPL.EQ.'MXPP')GOTO11310
      IF(ICASPL.EQ.'RAPP')GOTO11320
      IF(ICASPL.EQ.'GIGP')GOTO11330
      IF(ICASPL.EQ.'GALP')GOTO11340
      IF(ICASPL.EQ.'MCPP')GOTO11350
      IF(ICASPL.EQ.'BEIP')GOTO11360
      IF(ICASPL.EQ.'BEIK')GOTO11370
      IF(ICASPL.EQ.'GMCP')GOTO11380
      IF(ICASPL.EQ.'G5PP')GOTO11390
      IF(ICASPL.EQ.'WKPP')GOTO11400
      IF(ICASPL.EQ.'BNPP')GOTO11410
      IF(ICASPL.EQ.'G2PP')GOTO11420
      IF(ICASPL.EQ.'G3PP')GOTO11430
      IF(ICASPL.EQ.'G4PP')GOTO11440
      IF(ICASPL.EQ.'AXPP')GOTO11450
C
 1110 CONTINUE
      DO1111I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1111
      ICNT=ICNT+1
      CALL UNIPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1111 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      DO1121I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1121
      ICNT=ICNT+1
      CALL NORPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1121 CONTINUE
      GOTO1900
C
 1130 CONTINUE
      DO1131I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1131
      ICNT=ICNT+1
      CALL LOGPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1131 CONTINUE
      GOTO1900
C
 1140 CONTINUE
      DO1141I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1141
      ICNT=ICNT+1
      CALL DEXPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1141 CONTINUE
      GOTO1900
C
 1150 CONTINUE
      DO1151I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1151
      ICNT=ICNT+1
      CALL CAUPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1151 CONTINUE
      GOTO1900
C
 1160 CONTINUE
      DO1161I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1161
      ICNT=ICNT+1
      CALL LAMPPF(X2(I),ALAMBA,X2OUT)
      X2(ICNT)=X2OUT
 1161 CONTINUE
      GOTO1900
C
 1170 CONTINUE
      DO1171I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1171
      ICNT=ICNT+1
      CALL LGNPPF(X2(I),SIGMA,X2OUT)
      X2(ICNT)=X2OUT
 1171 CONTINUE
      GOTO1900
C
 1180 CONTINUE
      DO1181I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1181
      ICNT=ICNT+1
      CALL HFNPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1181 CONTINUE
      GOTO1900
C
 1190 CONTINUE
      DO1191I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1191
      ICNT=ICNT+1
      CALL TPPF(X2(I),NU,X2OUT)
      X2(ICNT)=X2OUT
 1191 CONTINUE
      GOTO1900
C
 1200 CONTINUE
      DO1201I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1201
      ICNT=ICNT+1
      CALL CHSPPF(X2(I),NU,X2OUT)
      X2(ICNT)=X2OUT
 1201 CONTINUE
      GOTO1900
C
 1210 CONTINUE
      DO1211I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1211
      ICNT=ICNT+1
      CALL FPPF(X2(I),NU1,NU2,X2OUT)
      X2(ICNT)=X2OUT
 1211 CONTINUE
      GOTO1900
C
 1220 CONTINUE
      DO1221I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1221
      ICNT=ICNT+1
      CALL EXPPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1221 CONTINUE
      GOTO1900
C
 1230 CONTINUE
      DO1231I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1231
      ICNT=ICNT+1
      CALL GAMPPF(X2(I),GAMMA,X2OUT)
      X2(ICNT)=X2OUT
 1231 CONTINUE
      GOTO1900
C
 1240 CONTINUE
      DO1241I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1241
      ICNT=ICNT+1
      CALL BETPPF(X2(I),ALPHA,BETA,X2OUT)
      X2(ICNT)=X2OUT
 1241 CONTINUE
      GOTO1900
C
 1250 CONTINUE
      DO1251I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1251
      ICNT=ICNT+1
      CALL WEIPPF(X2(I),GAMMA,MINMAX,X2OUT)
      X2(ICNT)=X2OUT
 1251 CONTINUE
      GOTO1900
C
 1260 CONTINUE
      DO1261I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1261
      ICNT=ICNT+1
      CALL EV1PPF(X2(I),MINMAX,X2OUT)
      X2(ICNT)=X2OUT
 1261 CONTINUE
      GOTO1900
C
 1270 CONTINUE
      DO1271I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1271
      ICNT=ICNT+1
      CALL EV2PPF(X2(I),GAMMA,MINMAX,X2OUT)
      X2(ICNT)=X2OUT
 1271 CONTINUE
      GOTO1900
C
 1280 CONTINUE
      ZLOC=A
      IF(ZLOC.GT.XMIN)ZLOC=XMIN
      DO1281I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1281
      ICNT=ICNT+1
      CALL PARPPF(X2(I),GAMMA,ZLOC,X2OUT)
      X2(ICNT)=X2OUT
 1281 CONTINUE
      GOTO1900
C
 1290 CONTINUE
      DO1291I=1,N
      CALL BINPPF(X2(I),P,NPAR,X2OUT)
      X2(ICNT)=X2OUT
 1291 CONTINUE
      GOTO1900
C
 1300 CONTINUE
      DO1301I=1,N
      CALL GEOPPF(X2(I),P,X2OUT)
      X2(ICNT)=X2OUT
 1301 CONTINUE
      GOTO1900
C
 1310 CONTINUE
      IF(ALAMBA.LE.60.0)GOTO1311
      GOTO1313
 1311 CONTINUE
      DO1312I=1,N
      CALL POIPPF(X2(I),ALAMBA,X2OUT)
      X2(ICNT)=X2OUT
 1312 CONTINUE
      GOTO1900
 1313 CONTINUE
      SQRTAL=SQRT(ALAMBA)
      DO1314I=1,N
      CALL NORPPF(X2(I),X2OUT)
      X2OUT=ALAMBA+SQRTAL*X2OUT
      X2(ICNT)=X2OUT
 1314 CONTINUE
      GOTO1900
C
 1320 CONTINUE
      DO1321I=1,N
      CALL NBPPF(X2(I),P,AK,X2OUT)
      X2(ICNT)=X2OUT
 1321 CONTINUE
      GOTO1900
C
 1330 CONTINUE
      DO1331I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1331
      ICNT=ICNT+1
      CALL SEMPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1331 CONTINUE
      GOTO1900
C
 1340 CONTINUE
      ZLOWLM=-1.0
      ZUPPLM=1.0
      DO1341I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1341
      ICNT=ICNT+1
      CALL TRIPPF(X2(I),C,ZLOWLM,ZUPPLM,X2OUT)
      X2(ICNT)=X2OUT
 1341 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1350 CONTINUE
      DO1351I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1351
      ICNT=ICNT+1
      CALL IGPPF(X2(I),GAMMA,AMU,X2OUT)
      X2(ICNT)=X2OUT
 1351 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1360 CONTINUE
      DO1361I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1361
      ICNT=ICNT+1
      CALL WALPPF(X2(I),GAMMA,X2OUT)
      X2(ICNT)=X2OUT
 1361 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1370 CONTINUE
      DO1371I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1371
      ICNT=ICNT+1
      CALL RIGPPF(X2(I),GAMMA,AMU,X2OUT)
      X2(ICNT)=X2OUT
 1371 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1380 CONTINUE
      DO1381I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1381
      ICNT=ICNT+1
      CALL FLPPF(X2(I),GAMMA,X2OUT)
      X2(ICNT)=X2OUT
 1381 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED      DECEMBER 1993
 1390 CONTINUE
      DO1391I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1391
      ICNT=ICNT+1
      CALL GEPPPF(X2(I),GAMMA,MINMAX,IGEPDF,X2OUT)
      X2(ICNT)=X2OUT
 1391 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED      SEPTEMBER 1994
 1400 CONTINUE
      DO1401I=1,N
      CALL DISPPF(X2(I),NDUN,X2OUT)
      X2(ICNT)=X2OUT
 1401 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED      SEPTEMBER 1994
 1410 CONTINUE
      DO1411I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1411
      ICNT=ICNT+1
      CALL NCTPPF(X2(I),ANU,ALAMBA,X2OUT)
      X2(ICNT)=X2OUT
 1411 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED      SEPTEMBER 1994
 1420 CONTINUE
      DO1421I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1421
      ICNT=ICNT+1
      CALL NCFPPF(X2(I),ANU1,ANU2,ALAMBA,X2OUT)
      X2(ICNT)=X2OUT
 1421 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED      SEPTEMBER 1994
 1430 CONTINUE
      DO1431I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1431
      ICNT=ICNT+1
      CALL NCCPPF(X2(I),ANU,ALAMBA,X2OUT)
      X2(ICNT)=X2OUT
 1431 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED      SEPTEMBER 1994
 1440 CONTINUE
      DO1441I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1441
      ICNT=ICNT+1
      CALL NCBPPF(X2(I),ALPHA,BETA,ALAMBA,X2OUT)
      X2(ICNT)=X2OUT
 1441 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED      SEPTEMBER 1994
 1450 CONTINUE
      DO1451I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1451
      ICNT=ICNT+1
      CALL DNTPPF(X2(I),ANU,ALAMB1,ALAMB2,X2OUT)
      X2(ICNT)=X2OUT
 1451 CONTINUE
      GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED      SEPTEMBER 1994
 1460 CONTINUE
      DO1461I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1461
      ICNT=ICNT+1
      CALL DNFPPF(X2(I),ANU1,ANU2,ALAMB1,ALAMB2,X2OUT)
      X2(ICNT)=X2OUT
 1461 CONTINUE
      GOTO1900
C
 1470 CONTINUE
      DO1471I=1,N
      CALL HYPPPF(X2(I),K,NPAR,MPAR,X2OUT)
      X2(ICNT)=X2OUT
 1471 CONTINUE
      GOTO1900
C
 1480 CONTINUE
      DO1481I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1481
      ICNT=ICNT+1
      CALL VONPPF(X2(I),B,X2OUT)
      X2(ICNT)=X2OUT
 1481 CONTINUE
      GOTO1900
C
 1490 CONTINUE
      DO1491I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1491
      ICNT=ICNT+1
      CALL PNRPPF(X2(I),P,SD,X2OUT)
      X2(ICNT)=X2OUT
 1491 CONTINUE
      GOTO1900
C
 1500 CONTINUE
      DO1501I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1501
      ICNT=ICNT+1
      CALL PLNPPF(X2(I),P,SD,X2OUT)
      X2(ICNT)=X2OUT
 1501 CONTINUE
      GOTO1900
C
 1510 CONTINUE
      DO1511I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1511
      ICNT=ICNT+1
      CALL ALPPPF(X2(I),ALPHA,BETA,X2OUT)
      X2(ICNT)=X2OUT
 1511 CONTINUE
      GOTO1900
C
 1520 CONTINUE
      DO1521I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1521
      ICNT=ICNT+1
      CALL COSPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1521 CONTINUE
      GOTO1900
C
 1530 CONTINUE
      DO1531I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1531
      ICNT=ICNT+1
      CALL POWPPF(X2(I),C,X2OUT)
      X2(ICNT)=X2OUT
 1531 CONTINUE
      GOTO1900
C
 1540 CONTINUE
      DO1541I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1541
      ICNT=ICNT+1
      CALL CHPPF(X2(I),ANU,X2OUT)
      X2(ICNT)=X2OUT
 1541 CONTINUE
      GOTO1900
C
 1550 CONTINUE
      DO1551I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1551
      ICNT=ICNT+1
      CALL DLGPPF(X2(I),THETA,X2OUT)
      X2(ICNT)=X2OUT
 1551 CONTINUE
      GOTO1900
C
 1560 CONTINUE
      DO1561I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1561
      ICNT=ICNT+1
      CALL LLGPPF(X2(I),DELTA,X2OUT)
      X2(ICNT)=X2OUT
 1561 CONTINUE
      GOTO1900
C
 1570 CONTINUE
      DO1571I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1571
      ICNT=ICNT+1
      CALL GGDPPF(X2(I),ALPHA,C,X2OUT)
      X2(ICNT)=X2OUT
 1571 CONTINUE
      GOTO1900
C
 1580 CONTINUE
      DO1581I=1,N
      CALL WARPPF(X2(I),C,A,X2OUT,'NOTR')
      X2(ICNT)=X2OUT
 1581 CONTINUE
      GOTO1900
C
 1585 CONTINUE
      DO1586I=1,N
      CALL YULPPF(X2(I),P,X2OUT)
      X2(ICNT)=X2OUT
 1586 CONTINUE
      GOTO1900
C
 1590 CONTINUE
      DO1591I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1591
      ICNT=ICNT+1
      CALL ANGPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1591 CONTINUE
      GOTO1900
C
 1600 CONTINUE
      DO1601I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1601
      ICNT=ICNT+1
      CALL ARSPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1601 CONTINUE
      GOTO1900
C
 1610 CONTINUE
      DO1611I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1611
      ICNT=ICNT+1
      CALL FNRPPF(X2(I),AMU,SD,X2OUT)
      X2(ICNT)=X2OUT
 1611 CONTINUE
      GOTO1900
C
 1620 CONTINUE
      DO1621I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1621
      ICNT=ICNT+1
      CALL TNRPPF(X2(I),A,B,AM,SD,X2OUT)
      X2(ICNT)=X2OUT
 1621 CONTINUE
      GOTO1900
C
 1630 CONTINUE
      DO1631I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1631
      ICNT=ICNT+1
      CALL LGAPPF(X2(I),GAMMA,ILGADF,X2OUT)
      X2(ICNT)=X2OUT
 1631 CONTINUE
      GOTO1900
C
 1640 CONTINUE
      DO1641I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1641
      ICNT=ICNT+1
      CALL HSEPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1641 CONTINUE
      GOTO1900
C
 1650 CONTINUE
      DO1651I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1651
      ICNT=ICNT+1
      CALL GOMPPF(X2(I),C,B,X2OUT)
      X2(ICNT)=X2OUT
 1651 CONTINUE
      GOTO1900
C
 1660 CONTINUE
      DO1661I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1661
      ICNT=ICNT+1
      CALL HFCPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
 1661 CONTINUE
      GOTO1900
C
 1670 CONTINUE
      DO1671I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1671
      ICNT=ICNT+1
      CALL HFLPPF(X2(I),GAMMA,X2OUT)
      X2(ICNT)=X2OUT
 1671 CONTINUE
      GOTO1900
C
 1680 CONTINUE
      DO1681I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1681
      ICNT=ICNT+1
      CALL GEVPPF(X2(I),GAMMA,MINMAX,X2OUT)
      X2(ICNT)=X2OUT
 1681 CONTINUE
      GOTO1900
C
 1690 CONTINUE
      ZLOC=A
      IF(ZLOC.LE.0.0)ZLOC=1.0
      DO1691I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1691
      ICNT=ICNT+1
      CALL PA2PPF(X2(I),GAMMA,ZLOC,X2OUT)
      X2(ICNT)=X2OUT
 1691 CONTINUE
      GOTO1900
C
 1700 CONTINUE
      DO1701I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1701
      ICNT=ICNT+1
      CALL DWEPPF(X2(I),GAMMA,X2OUT)
      X2(ICNT)=X2OUT
 1701 CONTINUE
      GOTO1900
C
 1710 CONTINUE
      DO1711I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1711
      ICNT=ICNT+1
      CALL WCAPPF(X2(I),P,X2OUT)
      X2(ICNT)=X2OUT
 1711 CONTINUE
      GOTO1900
C
 1720 CONTINUE
      IARG1=1
      DO1721I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1721
      ICNT=ICNT+1
      CALL EWEPPF(X2(I),GAMMA,THETA,IARG1,X2OUT)
      X2(ICNT)=X2OUT
 1721 CONTINUE
      GOTO1900
C
 1730 CONTINUE
      DO1731I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1731
      ICNT=ICNT+1
      CALL TNEPPF(X2(I),X0,AM,SD,X2OUT)
      X2(ICNT)=X2OUT
 1731 CONTINUE
      GOTO1900
C
 1740 CONTINUE
      DO1741I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1741
      ICNT=ICNT+1
      CALL GLOPPF(X2(I),ALPHA,X2OUT)
      X2(ICNT)=X2OUT
 1741 CONTINUE
      GOTO1900
C
 1750 CONTINUE
      DO1751I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1751
      ICNT=ICNT+1
      CALL PEXPPF(X2(I),ALPHA,BETA,X2OUT)
      X2(ICNT)=X2OUT
 1751 CONTINUE
      GOTO1900
C
 1760 CONTINUE
      DO1761I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1761
      ICNT=ICNT+1
      CALL DGAPPF(X2(I),GAMMA,X2OUT)
      X2(ICNT)=X2OUT
 1761 CONTINUE
      GOTO1900
C
 1770 CONTINUE
      DO1771I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1771
      ICNT=ICNT+1
      CALL KAPPPF(X2(I),ANU,BETA,THETA,X2OUT)
      X2(ICNT)=X2OUT
 1771 CONTINUE
      GOTO1900
C
 1780 CONTINUE
      DO1781I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1781
      ICNT=ICNT+1
      CALL FCAPPF(X2(I),AM,SD,X2OUT)
      X2(ICNT)=X2OUT
 1781 CONTINUE
      GOTO1900
C
 1790 CONTINUE
      DO1791I=1,N
      CALL BBNPPF(X2(I),ALPHA,BETA,NU,X2OUT)
      X2(ICNT)=X2OUT
 1791 CONTINUE
      GOTO1900
C
 1800 CONTINUE
      DO1801I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1801
      ICNT=ICNT+1
      CALL BRAPPF(X2(I),BETA,X2OUT)
      X2(ICNT)=X2OUT
 1801 CONTINUE
      GOTO1900
C
 1810 CONTINUE
      DO1811I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1811
      ICNT=ICNT+1
      CALL GEXPPF(X2(I),ALAMB1,ALAMB2,GAMMA,X2OUT)
      X2(ICNT)=X2OUT
 1811 CONTINUE
      GOTO1900
C
 1820 CONTINUE
      DO1821I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1821
      ICNT=ICNT+1
      CALL RECPPF(X2(I),B,X2OUT)
      X2(ICNT)=X2OUT
 1821 CONTINUE
      GOTO1900
C
 1830 CONTINUE
      DO1831I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1831
      ICNT=ICNT+1
      CALL NMXPPF(X2(I),U1,SD1,U2,SD2,P,X2OUT)
      X2(ICNT)=X2OUT
 1831 CONTINUE
      GOTO1900
C
 1840 CONTINUE
      DO1841I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1841
      ICNT=ICNT+1
      CALL IGAPPF(X2(I),GAMMA,X2OUT)
      X2(ICNT)=X2OUT
 1841 CONTINUE
      GOTO1900
C
 1850 CONTINUE
      DO1851I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1851
      ICNT=ICNT+1
      IWRITE='OFF'
CCCCC IF(IGLDDF.EQ.'RAMB')THEN
CCCCC   IARG1=1
CCCCC   ARG3=-1.0
CCCCC   ZSCALE=1.0
CCCCC   CALL GLDCHK(ALAMB3,ALAMB4,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC   IF(ISIGN.LT.0)ZSCALE=-1.0
CCCCC ENDIF
      CALL GLDPPF(DBLE(X2(I)),DBLE(ALAMB3),DBLE(ALAMB4),DX2OUT,
     1            IGLDDF,IWRITE)
      IF(IGLDDF.EQ.'RAMB')THEN
        X2OUT=ZSCALE*REAL(DX2OUT)
      ELSE
        X2OUT=REAL(DX2OUT)
      ENDIF
      X2(ICNT)=X2OUT
 1851 CONTINUE
      GOTO1900
C
 1860 CONTINUE
      DO1861I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1861
      ICNT=ICNT+1
      CALL JSBPPF(X2(I),ALPHA1,ALPHA2,X2OUT)
      X2(ICNT)=X2OUT
 1861 CONTINUE
      GOTO1900
C
 1870 CONTINUE
      DO1871I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1871
      ICNT=ICNT+1
      CALL JSUPPF(X2(I),ALPHA1,ALPHA2,X2OUT)
      X2(ICNT)=X2OUT
 1871 CONTINUE
      GOTO1900
C
 1880 CONTINUE
      DO1881I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1881
      ICNT=ICNT+1
      CALL IWEPPF(X2(I),GAMMA,X2OUT)
      X2(ICNT)=X2OUT
 1881 CONTINUE
      GOTO1900
C
 1890 CONTINUE
      DO1891I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1891
      ICNT=ICNT+1
      CALL LDEPPF(X2(I),ALPHA,X2OUT)
      X2(ICNT)=X2OUT
 1891 CONTINUE
      GOTO1900
C
11900 CONTINUE
      DO11901I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11901
      ICNT=ICNT+1
      CALL GEEPPF(X2(I),GAMMA,X2OUT)
      X2(ICNT)=X2OUT
11901 CONTINUE
      GOTO1900
C
11910 CONTINUE
      DO11911I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11911
      ICNT=ICNT+1
      CALL TSPPPF(X2(I),THETA,ANU,X2OUT)
      X2(ICNT)=X2OUT
11911 CONTINUE
      GOTO1900
C
11920 CONTINUE
      DO11921I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11921
      ICNT=ICNT+1
      CALL BWEPPF(X2(I),ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,X2OUT,DX2OUT)
      X2(ICNT)=X2OUT
11921 CONTINUE
      GOTO1900
C
11930 CONTINUE
      DO11931I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11931
      ICNT=ICNT+1
      CALL GHPPF(X2(I),G,H,X2OUT,DBLE(X2(I)),DX2OUT)
      X2(ICNT)=X2OUT
11931 CONTINUE
      GOTO1900
C
11940 CONTINUE
      DO11941I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11941
      ICNT=ICNT+1
      X2OUT=LANPPF(X2(I))
      X2(ICNT)=X2OUT
11941 CONTINUE
      GOTO1900
C
11950 CONTINUE
      DO11951I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11951
      ICNT=ICNT+1
      X2IN=X2(I)
      CALL ERRPPF(X2IN,ALPHA,X2OUT)
      X2(ICNT)=X2OUT
11951 CONTINUE
      GOTO1900
C
11960 CONTINUE
      DO11961I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11961
      ICNT=ICNT+1
      CALL TRAPPF(X2(I),A,B,C,DZ,X2OUT)
      X2(ICNT)=X2OUT
11961 CONTINUE
      GOTO1900
C
11970 CONTINUE
      DO11971I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11971
      ICNT=ICNT+1
      CALL GTRPPF(X2(I),A,B,C,DZ,ANU1,ANU3,ALPHA,X2OUT)
      X2(ICNT)=X2OUT
11971 CONTINUE
      GOTO1900
C
11980 CONTINUE
      DO11981I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11981
      ICNT=ICNT+1
      CALL FTPPF(X2(I),NU,X2OUT)
      X2(ICNT)=X2OUT
11981 CONTINUE
      GOTO1900
C
11990 CONTINUE
      DO11991I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11991
      ICNT=ICNT+1
      CALL SLAPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
11991 CONTINUE
      GOTO1900
C
11200 CONTINUE
      DO11201I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11201
      ICNT=ICNT+1
      CALL SNPPF(X2(I),ALAMBA,ISKNDF,X2OUT)
      X2(ICNT)=X2OUT
11201 CONTINUE
      GOTO1900
C
11210 CONTINUE
      DO11211I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11211
      ICNT=ICNT+1
      CALL STPPF(X2(I),NU,ALAMBA,X2OUT)
      X2(ICNT)=X2OUT
11211 CONTINUE
      GOTO1900
C
11220 CONTINUE
      DO11221I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11221
      ICNT=ICNT+1
      CALL IBPPF(X2(I),ALPHA,BETA,X2OUT)
      X2(ICNT)=X2OUT
11221 CONTINUE
      GOTO1900
C
11230 CONTINUE
      DO11231I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11231
      ICNT=ICNT+1
      IF(IMAKDF.EQ.'DLMF')THEN
        CALL MAKPPF(X2(I),XI,ALAMBA,THETA,X2OUT)
      ELSEIF(IMAKDF.EQ.'MEEK')THEN
        XI=GAMMA/AK
        THETA=ALAMB/GAMMA
        ALAMB=AK
        CALL MAKPPF(X2(I),XI,ALAMBA,THETA,X2OUT)
      ELSEIF(IMAKDF.EQ.'REPA')THEN
        CALL MA2PPF(X2(I),ZETA,ETA,X2OUT)
      ENDIF
      X2(ICNT)=X2OUT
11231 CONTINUE
      GOTO1900
C
11240 CONTINUE
      DO11241I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11241
      ICNT=ICNT+1
      CALL LSNPPF(X2(I),ALAMBA,SD,X2OUT)
      X2(ICNT)=X2OUT
11241 CONTINUE
      GOTO1900
C
11250 CONTINUE
      DO11251I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11251
      ICNT=ICNT+1
      CALL LSTPPF(X2(I),NU,ALAMBA,SD,X2OUT)
      X2(ICNT)=X2OUT
11251 CONTINUE
      GOTO1900
C
11260 CONTINUE
      DO11261I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11261
      ICNT=ICNT+1
      CALL ARSPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
11261 CONTINUE
      GOTO1900
C
11270 CONTINUE
      DO11271I=1,N
      CALL POLPPF(X2(I),ALPHA,BETA,NU,X2OUT)
      X2(ICNT)=X2OUT
11271 CONTINUE
      GOTO1900
C
11280 CONTINUE
      DO11281I=1,N
      CALL HERPPF(X2(I),ALPHA,BETA,X2OUT)
      X2(ICNT)=X2OUT
11281 CONTINUE
      GOTO1900
C
11290 CONTINUE
      DO11291I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11291
      ICNT=ICNT+1
      CALL SDEPPF(X2(I),ALAMBA,X2OUT)
      X2(ICNT)=X2OUT
11291 CONTINUE
      GOTO1900
C
11300 CONTINUE
      DO11301I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11301
      ICNT=ICNT+1
      IF(IADEDF.EQ.'K')THEN
        CALL ADEPPF(X2(I),AK,IADEDF,X2OUT)
      ELSE
        CALL ADEPPF(X2(I),AMU,IADEDF,X2OUT)
      ENDIF
      X2(ICNT)=X2OUT
11301 CONTINUE
      GOTO1900
C
11310 CONTINUE
      DO11311I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11311
      ICNT=ICNT+1
      CALL MAXPPF(X2(I),SIGMA,X2OUT)
      X2(ICNT)=X2OUT
11311 CONTINUE
      GOTO1900
C
11320 CONTINUE
      DO11321I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11321
      ICNT=ICNT+1
      CALL RAYPPF(X2(I),X2OUT)
      X2(ICNT)=X2OUT
11321 CONTINUE
      GOTO1900
C
11330 CONTINUE
      DO11331I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11331
      ICNT=ICNT+1
      CALL GIGPPF(DBLE(X2(I)),DBLE(CHI),DBLE(ALAMBA),DBLE(THETA),
     1            DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11331 CONTINUE
      GOTO1900
C
11340 CONTINUE
      DO11341I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11341
      ICNT=ICNT+1
      CALL GALPPF(DBLE(X2(I)),DBLE(AK),DBLE(TAU),IADEDF,DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11341 CONTINUE
      GOTO1900
C
11350 CONTINUE
      DO11351I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11351
      ICNT=ICNT+1
      CALL MCLPPF(DBLE(X2(I)),DBLE(ALPHA),DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11351 CONTINUE
      GOTO1900
C
11360 CONTINUE
      IF(IBEIDF.EQ.'1')THEN
        DO11361I=1,N
        IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11361
        ICNT=ICNT+1
        CALL BEIPPF(DBLE(X2(I)),DBLE(SD1),DBLE(SD2),DBLE(ANU),IBEIDF,
     1              DX2OUT)
        X2OUT=REAL(DX2OUT)
        X2(ICNT)=X2OUT
11361   CONTINUE
      ELSE
        DO11366I=1,N
        IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11366
        ICNT=ICNT+1
        CALL BEIPPF(DBLE(X2(I)),DBLE(B),DBLE(C),DBLE(AM),IBEIDF,
     1              DX2OUT)
        X2OUT=REAL(DX2OUT)
        X2(ICNT)=X2OUT
11366   CONTINUE
      ENDIF
      GOTO1900
C
11370 CONTINUE
      DO11371I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11371
      ICNT=ICNT+1
CCCCC CALL BEKPPF(DBLE(X2(I)),DBLE(SD1),DBLE(SD2),DBLE(ANU),DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11371 CONTINUE
      GOTO1900
C
11380 CONTINUE
      DO11381I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11381
      ICNT=ICNT+1
      CALL GMCPPF(DBLE(X2(I)),DBLE(ALPHA),DBLE(A),DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11381 CONTINUE
      GOTO1900
C
11390 CONTINUE
      XPAR(1)=0.0D0
      XPAR(2)=1.0D0
      XPAR(3)=DBLE(ALPHA)
      DO11391I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11391
      ICNT=ICNT+1
      DX2OUT=QUAGLO(DBLE(X2(I)),XPAR)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11391 CONTINUE
      GOTO1900
C
11400 CONTINUE
      XPAR(1)=0.0D0
      XPAR(2)=1.0D0
      XPAR(3)=DBLE(BETA)
      XPAR(4)=DBLE(GAMMA)
      XPAR(5)=DBLE(DELTA)
      DO11401I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11401
      ICNT=ICNT+1
      DX2OUT=QUAWAK(DBLE(X2(I)),XPAR)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11401 CONTINUE
      GOTO1900
C
11410 CONTINUE
      DO11411I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11411
      ICNT=ICNT+1
      CALL BNOPPF(DBLE(X2(I)),DBLE(ALPHA),DBLE(BETA),DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11411 CONTINUE
      GOTO1900
C
11420 CONTINUE
      DO11421I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11421
      ICNT=ICNT+1
      CALL GL2PPF(DBLE(X2(I)),DBLE(ALPHA),DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11421 CONTINUE
      GOTO1900
C
11430 CONTINUE
      DO11431I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11431
      ICNT=ICNT+1
      CALL GL3PPF(DBLE(X2(I)),DBLE(ALPHA),DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11431 CONTINUE
      GOTO1900
C
11440 CONTINUE
      DO11441I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11441
      ICNT=ICNT+1
      CALL GL4PPF(DBLE(X2(I)),DBLE(P),DBLE(Q),DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11441 CONTINUE
      GOTO1900
C
11450 CONTINUE
      DO11451I=1,N
      IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO11451
      ICNT=ICNT+1
      CALL ALDPPF(DBLE(X2(I)),DBLE(ALPHA),DBLE(BETA),DX2OUT)
      X2OUT=REAL(DX2OUT)
      X2(ICNT)=X2OUT
11451 CONTINUE
      GOTO1900
C
 1900 CONTINUE
      N2=ICNT
      DO1910I=1,N2
        D2(I)=1.0
 1910 CONTINUE
      ICNT=0
      DO1912I=1,N
        IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1912
        ICNT=ICNT+1
        Y2(ICNT)=Y2(I)
 1912 CONTINUE
      NPLOTV=2
      GOTO9000
C
C               ********************************************
C               **  STEP 4.2--                            **
C               **  DETERMINE PLOT COORDINATES            **
C               **  FOR THE 2-VARIABLE CASE               **
C               **  (THAT IS, FOR THE GROUPED DATA CASE)  **
C               ********************************************
C
 2100 CONTINUE
C
CCCCC OCTOBER 2004: REMOVE BINS WITH ZERO FREQUENCY
C
      ICNT=0
      DO22101I=1,N
        IF(Y(I).GT.0.0)THEN
          ICNT=ICNT+1
          Y2(ICNT)=Y(I)
          X2(ICNT)=X(I)
          D2(ICNT)=XHIGH(I)
        ENDIF
22101 CONTINUE
      N=ICNT
      DO22103I=1,N
        Y(I)=Y2(I)
        X(I)=X2(I)
        XHIGH(I)=D2(I)
22103 CONTINUE
C
CCCCC MAY 2005: FOR CASE WHERE BINS SPECIFIED AS LOWER AND UPPER
CCCCC           LIMITS, COMPUTE THE MID-POINTS OF EACH OF THE BINS.
C
      IF(IDATSW.EQ.'FRE2')THEN
        DO22111I=1,N
          X(I)=(X(I) + XHIGH(I))/2.0
22111   CONTINUE
      ENDIF
C
      CALL SORTC(X,Y,N,Y2,D2)
      XMIN=Y2(1)
      XMAX=Y2(N)
C
CCCCC JANUARY 1996.  DO NOT HANDLE LOG-NORMAL CASE SEPARATELY.
CCCCC IF(ICASPL.EQ.'LNPP')GOTO2101
CCCCC GOTO2108
C2101 CONTINUE
CCCCC DO2102I=1,N
CCCCC Y2HOLD=Y2(I)
CCCCC IF(Y2HOLD.LE.0.0)GOTO2103
CCCCC Y2(I)=ALOG(Y2HOLD)
C2102 CONTINUE
CCCCC GOTO2108
C2103 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2104)
C2104 FORMAT('***** ERROR IN PROBABILITY PLOT--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2105)
C2105 FORMAT('      A LOGNORMAL PROBABILITY PLOT WAS ATTEMPTED')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2106)
C2106 FORMAT('      ON A DATA SET THAT HAD A NON-POSITIVE VALUE.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2107)Y2HOLD
C2107 FORMAT('      THE NON-POSITIVE VALUE = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
C2108 CONTINUE
C
      SUM=0.0
      DO2009I=1,N
      SUM=SUM+Y(I)
 2009 CONTINUE
      NTOT=SUM+0.5
C
      IF(ICASPL.EQ.'UNPP')GOTO2110
      IF(ICASPL.EQ.'NOPP')GOTO2120
      IF(ICASPL.EQ.'LOPP')GOTO2130
      IF(ICASPL.EQ.'DEPP')GOTO2140
      IF(ICASPL.EQ.'CAPP')GOTO2150
      IF(ICASPL.EQ.'LAPP')GOTO2160
      IF(ICASPL.EQ.'LNPP')GOTO2170
      IF(ICASPL.EQ.'HNPP')GOTO2180
      IF(ICASPL.EQ.'TPP')GOTO2190
      IF(ICASPL.EQ.'CSPP')GOTO2200
      IF(ICASPL.EQ.'FPP')GOTO2210
      IF(ICASPL.EQ.'EXPP')GOTO2220
      IF(ICASPL.EQ.'GAPP')GOTO2230
      IF(ICASPL.EQ.'BEPP')GOTO2240
      IF(ICASPL.EQ.'WEPP')GOTO2250
      IF(ICASPL.EQ.'E1PP')GOTO2260
      IF(ICASPL.EQ.'E2PP')GOTO2270
      IF(ICASPL.EQ.'PAPP')GOTO2280
      IF(ICASPL.EQ.'BIPP')GOTO2290
      IF(ICASPL.EQ.'GEPP')GOTO2300
      IF(ICASPL.EQ.'POPP')GOTO2310
      IF(ICASPL.EQ.'NBPP')GOTO2320
      IF(ICASPL.EQ.'SEPP')GOTO2330
      IF(ICASPL.EQ.'TRPP')GOTO2340
CCCCC FOLLOWING SECTION ADDED DECEMBER 1994.
      IF(ICASPL.EQ.'IGPP')GOTO2350
      IF(ICASPL.EQ.'WAPP')GOTO2360
      IF(ICASPL.EQ.'RIPP')GOTO2370
      IF(ICASPL.EQ.'FLPP')GOTO2380
      IF(ICASPL.EQ.'GPPP')GOTO2390
      IF(ICASPL.EQ.'DUPP')GOTO2400
      IF(ICASPL.EQ.'NTPP')GOTO2410
      IF(ICASPL.EQ.'NFPP')GOTO2420
      IF(ICASPL.EQ.'NCPP')GOTO2430
      IF(ICASPL.EQ.'NCBP')GOTO2440
      IF(ICASPL.EQ.'DNCT')GOTO2450
      IF(ICASPL.EQ.'DNCF')GOTO2460
      IF(ICASPL.EQ.'HYPP')GOTO2470
      IF(ICASPL.EQ.'VMPP')GOTO2480
      IF(ICASPL.EQ.'PNPP')GOTO2490
      IF(ICASPL.EQ.'PLPP')GOTO2500
      IF(ICASPL.EQ.'ALPP')GOTO2510
      IF(ICASPL.EQ.'COPP')GOTO2520
      IF(ICASPL.EQ.'PFPP')GOTO2530
      IF(ICASPL.EQ.'CHPP')GOTO2540
      IF(ICASPL.EQ.'LSPP')GOTO2550
      IF(ICASPL.EQ.'LLPP')GOTO2560
      IF(ICASPL.EQ.'GGPP')GOTO2570
      IF(ICASPL.EQ.'WRPP')GOTO2580
      IF(ICASPL.EQ.'YUPP')GOTO2585
      IF(ICASPL.EQ.'ANPP')GOTO2590
      IF(ICASPL.EQ.'ARPP')GOTO2600
      IF(ICASPL.EQ.'FNPP')GOTO2610
      IF(ICASPL.EQ.'TNPP')GOTO2620
      IF(ICASPL.EQ.'LGPP')GOTO2630
      IF(ICASPL.EQ.'HSPP')GOTO2640
      IF(ICASPL.EQ.'GOPP')GOTO2650
      IF(ICASPL.EQ.'HCPP')GOTO2660
      IF(ICASPL.EQ.'HLPP')THEN
        GAMMA=-1.0
        GOTO2670
      ENDIF
      IF(ICASPL.EQ.'GZPP')GOTO2670
      IF(ICASPL.EQ.'GVPP')GOTO2680
      IF(ICASPL.EQ.'P2PP')GOTO2690
      IF(ICASPL.EQ.'DWPP')GOTO2700
      IF(ICASPL.EQ.'WCPP')GOTO2710
      IF(ICASPL.EQ.'EWPP')GOTO2720
      IF(ICASPL.EQ.'TEPP')GOTO2730
      IF(ICASPL.EQ.'GLPP')GOTO2740
      IF(ICASPL.EQ.'PEPP')GOTO2750
      IF(ICASPL.EQ.'DGPP')GOTO2760
      IF(ICASPL.EQ.'KAPP')GOTO2770
      IF(ICASPL.EQ.'FCPP')GOTO2780
      IF(ICASPL.EQ.'BBPP')GOTO2790
      IF(ICASPL.EQ.'BRPP')GOTO2800
      IF(ICASPL.EQ.'GXPP')GOTO2810
      IF(ICASPL.EQ.'REPP')GOTO2820
      IF(ICASPL.EQ.'NMPP')GOTO2830
      IF(ICASPL.EQ.'GIPP')GOTO2840
      IF(ICASPL.EQ.'LDPP')GOTO2850
      IF(ICASPL.EQ.'JBPP')GOTO2860
      IF(ICASPL.EQ.'JUPP')GOTO2870
      IF(ICASPL.EQ.'IWPP')GOTO2880
      IF(ICASPL.EQ.'LXPP')GOTO2890
      IF(ICASPL.EQ.'EEPP')GOTO12900
      IF(ICASPL.EQ.'TSPP')GOTO12910
      IF(ICASPL.EQ.'BWPP')GOTO12920
      IF(ICASPL.EQ.'GHPP')GOTO12930
      IF(ICASPL.EQ.'LUPP')GOTO12940
      IF(ICASPL.EQ.'ERPP')GOTO12950
      IF(ICASPL.EQ.'TZPP')GOTO12960
      IF(ICASPL.EQ.'GTPP')GOTO12970
      IF(ICASPL.EQ.'FTPP')GOTO12980
      IF(ICASPL.EQ.'SLPP')GOTO12990
      IF(ICASPL.EQ.'SNPP')GOTO13000
      IF(ICASPL.EQ.'STPP')GOTO13010
      IF(ICASPL.EQ.'IBPP')GOTO13020
      IF(ICASPL.EQ.'GMPP')GOTO13030
      IF(ICASPL.EQ.'LZPP')GOTO13040
      IF(ICASPL.EQ.'LTPP')GOTO13050
      IF(ICASPL.EQ.'ASPP')GOTO13060
      IF(ICASPL.EQ.'PZPP')GOTO13070
      IF(ICASPL.EQ.'HEPP')GOTO13080
      IF(ICASPL.EQ.'SDPP')GOTO13090
      IF(ICASPL.EQ.'ADPP')GOTO13100
      IF(ICASPL.EQ.'MXPP')GOTO13110
      IF(ICASPL.EQ.'RAPP')GOTO13120
      IF(ICASPL.EQ.'GIGP')GOTO13130
      IF(ICASPL.EQ.'GALP')GOTO13140
      IF(ICASPL.EQ.'MCPP')GOTO13150
      IF(ICASPL.EQ.'BEIP')GOTO13160
      IF(ICASPL.EQ.'BEKP')GOTO13170
      IF(ICASPL.EQ.'GMCP')GOTO13180
      IF(ICASPL.EQ.'G5PP')GOTO13190
      IF(ICASPL.EQ.'WKPP')GOTO13200
      IF(ICASPL.EQ.'BNPP')GOTO13210
      IF(ICASPL.EQ.'G2PP')GOTO13220
      IF(ICASPL.EQ.'G3PP')GOTO13230
      IF(ICASPL.EQ.'G4PP')GOTO13240
      IF(ICASPL.EQ.'AXPP')GOTO13250
C
 2110 CONTINUE
      I2=0
      DO2111I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2111
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2112K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL UNIPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2112 CONTINUE
      X2(I)=SUM/ANI
 2111 CONTINUE
      GOTO2900
C
 2120 CONTINUE
      I2=0
      DO2121I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2121
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2122K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL NORPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2122 CONTINUE
      X2(I)=SUM/ANI
 2121 CONTINUE
      GOTO2900
C
 2130 CONTINUE
      I2=0
      DO2131I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2131
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2132K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL LOGPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2132 CONTINUE
      X2(I)=SUM/ANI
 2131 CONTINUE
      GOTO2900
C
 2140 CONTINUE
      I2=0
      DO2141I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2141
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2142K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL DEXPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2142 CONTINUE
      X2(I)=SUM/ANI
 2141 CONTINUE
      GOTO2900
C
 2150 CONTINUE
      I2=0
      DO2151I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2151
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2152K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL CAUPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2152 CONTINUE
      X2(I)=SUM/ANI
 2151 CONTINUE
      GOTO2900
C
 2160 CONTINUE
      I2=0
      DO2161I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2161
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2162K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL LAMPPF(UNIOSM,ALAMBA,DISOSM)
      SUM=SUM+DISOSM
 2162 CONTINUE
      X2(I)=SUM/ANI
 2161 CONTINUE
      GOTO2900
C
 2170 CONTINUE
      I2=0
      DO2171I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2171
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2172K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
CCCCC APRIL 1995.  CHANGE FOLLOWING LINE.
CCCCC CALL NORPPF(UNIOSM,DISOSM)
      CALL LGNPPF(UNIOSM,SIGMA,DISOSM)
      SUM=SUM+DISOSM
 2172 CONTINUE
      X2(I)=SUM/ANI
 2171 CONTINUE
      GOTO2900
C
 2180 CONTINUE
      I2=0
      DO2181I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2181
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2182K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL HFNPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2182 CONTINUE
      X2(I)=SUM/ANI
 2181 CONTINUE
      GOTO2900
C
 2190 CONTINUE
      I2=0
      DO2191I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2191
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2192K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL TPPF(UNIOSM,NU,DISOSM)
      SUM=SUM+DISOSM
 2192 CONTINUE
      X2(I)=SUM/ANI
 2191 CONTINUE
      GOTO2900
C
 2200 CONTINUE
      I2=0
      DO2201I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2201
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2202K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL CHSPPF(UNIOSM,NU,DISOSM)
      SUM=SUM+DISOSM
 2202 CONTINUE
      X2(I)=SUM/ANI
 2201 CONTINUE
      GOTO2900
C
 2210 CONTINUE
      I2=0
      DO2211I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2211
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2212K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL FPPF(UNIOSM,NU1,NU2,DISOSM)
      SUM=SUM+DISOSM
 2212 CONTINUE
      X2(I)=SUM/ANI
 2211 CONTINUE
      GOTO2900
C
 2220 CONTINUE
      I2=0
      DO2221I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2221
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2222K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL EXPPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2222 CONTINUE
      X2(I)=SUM/ANI
 2221 CONTINUE
      GOTO2900
C
 2230 CONTINUE
      I2=0
      DO2231I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2231
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2232K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GAMPPF(UNIOSM,GAMMA,DISOSM)
      SUM=SUM+DISOSM
 2232 CONTINUE
      X2(I)=SUM/ANI
 2231 CONTINUE
      GOTO2900
C
 2240 CONTINUE
      I2=0
      DO2241I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2241
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2242K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL BETPPF(UNIOSM,ALPHA,BETA,DISOSM)
      SUM=SUM+DISOSM
 2242 CONTINUE
      X2(I)=SUM/ANI
 2241 CONTINUE
      GOTO2900
C
 2250 CONTINUE
      I2=0
      DO2251I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2251
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2252K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
CCCCC THE FOLLOWING LINE WAS CHANGED   MAY 1993
CCCCC CALL WEIPPF(UNIOSM,GAMMA,DISOSM)
      CALL WEIPPF(UNIOSM,GAMMA,MINMAX,DISOSM)
      SUM=SUM+DISOSM
 2252 CONTINUE
      X2(I)=SUM/ANI
 2251 CONTINUE
      GOTO2900
C
 2260 CONTINUE
      I2=0
      DO2261I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2261
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2262K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
CCCCC THE FOLLOWING LINE WAS CHANGED   MAY 1993
CCCCC CALL EV1PPF(UNIOSM,DISOSM)
      CALL EV1PPF(UNIOSM,MINMAX,DISOSM)
      SUM=SUM+DISOSM
 2262 CONTINUE
      X2(I)=SUM/ANI
 2261 CONTINUE
      GOTO2900
C
 2270 CONTINUE
      I2=0
      DO2271I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2271
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2272K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
CCCCC THE FOLLOWING LINE WAS CHANGED   MAY 1993
CCCCC CALL EV2PPF(UNIOSM,GAMMA,DISOSM)
      CALL EV2PPF(UNIOSM,GAMMA,MINMAX,DISOSM)
      SUM=SUM+DISOSM
 2272 CONTINUE
      X2(I)=SUM/ANI
 2271 CONTINUE
      GOTO2900
C
 2280 CONTINUE
      I2=0
      ZLOC=A
      IF(ZLOC.GT.XMIN)ZLOC=XMIN
      DO2281I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2281
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2282K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL PARPPF(UNIOSM,GAMMA,ZLOC,DISOSM)
      SUM=SUM+DISOSM
 2282 CONTINUE
      X2(I)=SUM/ANI
 2281 CONTINUE
      GOTO2900
C
 2290 CONTINUE
      I2=0
      DO2291I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2291
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2292K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL BINPPF(UNIOSM,P,NPAR,DISOSM)
      SUM=SUM+DISOSM
 2292 CONTINUE
      X2(I)=SUM/ANI
 2291 CONTINUE
      GOTO2900
C
 2300 CONTINUE
      I2=0
      DO2301I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2301
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2302K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GEOPPF(UNIOSM,P,DISOSM)
      SUM=SUM+DISOSM
 2302 CONTINUE
      X2(I)=SUM/ANI
 2301 CONTINUE
      GOTO2900
C
 2310 CONTINUE
      I2=0
      DO2311I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2311
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2312K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL POIPPF(UNIOSM,ALAMBA,DISOSM)
      SUM=SUM+DISOSM
 2312 CONTINUE
      X2(I)=SUM/ANI
 2311 CONTINUE
      GOTO2900
C
 2320 CONTINUE
      I2=0
      DO2321I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2321
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2322K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1992 (JJF)
CCCCC KPAR=K
      CALL NBPPF(UNIOSM,P,AK,DISOSM)
      SUM=SUM+DISOSM
 2322 CONTINUE
      X2(I)=SUM/ANI
 2321 CONTINUE
      GOTO2900
C
 2330 CONTINUE
      I2=0
      DO2331I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2331
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2332K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL SEMPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2332 CONTINUE
      X2(I)=SUM/ANI
 2331 CONTINUE
      GOTO2900
C
 2340 CONTINUE
      ZLOWLM=-1.0
      ZUPPLM=1.0
      I2=0
      DO2341I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2341
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2342K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
CCCCC CALL TRIPPF(UNIOSM,DISOSM)
      CALL TRIPPF(UNIOSM,C,ZLOWLM,ZUPPLM,DISOSM)
      SUM=SUM+DISOSM
 2342 CONTINUE
      X2(I)=SUM/ANI
 2341 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2350 CONTINUE
      I2=0
      DO2351I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2351
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2352K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL IGPPF(UNIOSM,GAMMA,AMU,DISOSM)
      SUM=SUM+DISOSM
 2352 CONTINUE
      X2(I)=SUM/ANI
 2351 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2360 CONTINUE
      I2=0
      DO2361I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2361
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2362K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL WALPPF(UNIOSM,GAMMA,DISOSM)
      SUM=SUM+DISOSM
 2362 CONTINUE
      X2(I)=SUM/ANI
 2361 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2370 CONTINUE
      I2=0
      DO2371I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2371
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2372K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL RIGPPF(UNIOSM,GAMMA,AMU,DISOSM)
      SUM=SUM+DISOSM
 2372 CONTINUE
      X2(I)=SUM/ANI
 2371 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2380 CONTINUE
      I2=0
      DO2381I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2381
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2382K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL FLPPF(UNIOSM,GAMMA,DISOSM)
      SUM=SUM+DISOSM
 2382 CONTINUE
      X2(I)=SUM/ANI
 2381 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2390 CONTINUE
      I2=0
      DO2391I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2391
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2392K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GEPPPF(UNIOSM,GAMMA,MINMAX,IGEPDF,DISOSM)
      SUM=SUM+DISOSM
 2392 CONTINUE
      X2(I)=SUM/ANI
 2391 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2400 CONTINUE
      I2=0
      DO2401I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2401
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2402K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL DISPPF(UNIOSM,NDUN,DISOSM)
      SUM=SUM+DISOSM
 2402 CONTINUE
      X2(I)=SUM/ANI
 2401 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2410 CONTINUE
      I2=0
      DO2411I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2411
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2412K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL NCTPPF(UNIOSM,ANU,ALAMBA,DISOSM)
      SUM=SUM+DISOSM
 2412 CONTINUE
      X2(I)=SUM/ANI
 2411 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2420 CONTINUE
      I2=0
      DO2421I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2421
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2422K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL NCFPPF(UNIOSM,ANU1,ANU2,ALAMBA,DISOSM)
      SUM=SUM+DISOSM
 2422 CONTINUE
      X2(I)=SUM/ANI
 2421 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2430 CONTINUE
      I2=0
      DO2431I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2431
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2432K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL NCCPPF(UNIOSM,ANU,ALAMBA,DISOSM)
      SUM=SUM+DISOSM
 2432 CONTINUE
      X2(I)=SUM/ANI
 2431 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2440 CONTINUE
      I2=0
      DO2441I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2441
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2442K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL NCBPPF(UNIOSM,ALPHA,BETA,ALAMBA,DISOSM)
      SUM=SUM+DISOSM
 2442 CONTINUE
      X2(I)=SUM/ANI
 2441 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2450 CONTINUE
      I2=0
      DO2451I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2451
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2452K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL DNTPPF(UNIOSM,ANU,ALAMB1,ALAMB2,DISOSM)
      SUM=SUM+DISOSM
 2452 CONTINUE
      X2(I)=SUM/ANI
 2451 CONTINUE
      GOTO2900
C
CCCCC ADDED SEPTEMBER 1994.
 2460 CONTINUE
      I2=0
      DO2461I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2461
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2462K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL DNFPPF(UNIOSM,ANU1,ANU2,ALAMB1,ALAMB2,DISOSM)
      SUM=SUM+DISOSM
 2462 CONTINUE
      X2(I)=SUM/ANI
 2461 CONTINUE
      GOTO2900
C
 2470 CONTINUE
      I2=0
      DO2471I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2471
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2472K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL HYPPPF(UNIOSM,K,NPAR,MPAR,DISOSM)
      SUM=SUM+DISOSM
 2472 CONTINUE
      X2(I)=SUM/ANI
 2471 CONTINUE
      GOTO2900
C
 2480 CONTINUE
      I2=0
      DO2481I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2481
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2482K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL VONPPF(UNIOSM,B,DISOSM)
      SUM=SUM+DISOSM
 2482 CONTINUE
      X2(I)=SUM/ANI
 2481 CONTINUE
      GOTO2900
C
 2490 CONTINUE
      I2=0
      DO2491I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2491
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2492K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL PNRPPF(UNIOSM,P,SD,DISOSM)
      SUM=SUM+DISOSM
 2492 CONTINUE
      X2(I)=SUM/ANI
 2491 CONTINUE
      GOTO2900
C
 2500 CONTINUE
      I2=0
      DO2501I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2501
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2502K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL PLNPPF(UNIOSM,P,SD,DISOSM)
      SUM=SUM+DISOSM
 2502 CONTINUE
      X2(I)=SUM/ANI
 2501 CONTINUE
      GOTO2900
C
 2510 CONTINUE
      I2=0
      DO2511I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2511
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2512K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL ALPPPF(UNIOSM,ALPHA,BETA,DISOSM)
      SUM=SUM+DISOSM
 2512 CONTINUE
      X2(I)=SUM/ANI
 2511 CONTINUE
      GOTO2900
C
 2520 CONTINUE
      I2=0
      DO2521I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2521
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2522K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL COSPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2522 CONTINUE
      X2(I)=SUM/ANI
 2521 CONTINUE
      GOTO2900
C
 2530 CONTINUE
      I2=0
      DO2531I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2531
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2532K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL POWPPF(UNIOSM,C,DISOSM)
      SUM=SUM+DISOSM
 2532 CONTINUE
      X2(I)=SUM/ANI
 2531 CONTINUE
      GOTO2900
C
 2540 CONTINUE
      I2=0
      DO2541I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2541
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2542K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL CHPPF(UNIOSM,ANU,DISOSM)
      SUM=SUM+DISOSM
 2542 CONTINUE
      X2(I)=SUM/ANI
 2541 CONTINUE
      GOTO2900
C
 2550 CONTINUE
      I2=0
      DO2551I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2551
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2552K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL DLGPPF(UNIOSM,THETA,DISOSM)
      SUM=SUM+DISOSM
 2552 CONTINUE
      X2(I)=SUM/ANI
 2551 CONTINUE
      GOTO2900
C
 2560 CONTINUE
      I2=0
      DO2561I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2561
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2562K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL LLGPPF(UNIOSM,DELTA,DISOSM)
      SUM=SUM+DISOSM
 2562 CONTINUE
      X2(I)=SUM/ANI
 2561 CONTINUE
      GOTO2900
C
 2570 CONTINUE
      I2=0
      DO2571I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2571
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2572K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GGDPPF(UNIOSM,GAMMA,C,DISOSM)
      SUM=SUM+DISOSM
 2572 CONTINUE
      X2(I)=SUM/ANI
 2571 CONTINUE
      GOTO2900
C
 2580 CONTINUE
      I2=0
      DO2581I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2581
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2582K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL WARPPF(UNIOSM,C,A,DISOSM,'NOTR')
      SUM=SUM+DISOSM
 2582 CONTINUE
      X2(I)=SUM/ANI
 2581 CONTINUE
      GOTO2900
C
 2585 CONTINUE
      I2=0
      DO2586I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO2586
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2587K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL YULPPF(UNIOSM,P,DISOSM)
      SUM=SUM+DISOSM
 2587 CONTINUE
      X2(I)=SUM/ANI
 2586 CONTINUE
      GOTO2900
C
 2590 CONTINUE
      I2=0
      DO2591I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2591
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2592K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL ANGPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2592 CONTINUE
      X2(I)=SUM/ANI
 2591 CONTINUE
      GOTO2900
C
 2600 CONTINUE
      I2=0
      DO2601I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2601
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2602K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL ARSPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2602 CONTINUE
      X2(I)=SUM/ANI
 2601 CONTINUE
      GOTO2900
C
 2610 CONTINUE
      I2=0
      DO2611I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2611
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2612K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL FNRPPF(UNIOSM,AM,SD,DISOSM)
      SUM=SUM+DISOSM
 2612 CONTINUE
      X2(I)=SUM/ANI
 2611 CONTINUE
      GOTO2900
C
 2620 CONTINUE
      I2=0
      DO2621I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2621
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2622K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL TNRPPF(UNIOSM,A,B,AM,SD,DISOSM)
      SUM=SUM+DISOSM
 2622 CONTINUE
      X2(I)=SUM/ANI
 2621 CONTINUE
      GOTO2900
C
 2630 CONTINUE
      I2=0
      DO2631I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2631
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2632K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL LGAPPF(UNIOSM,GAMMA,ILGADF,DISOSM)
      SUM=SUM+DISOSM
 2632 CONTINUE
      X2(I)=SUM/ANI
 2631 CONTINUE
      GOTO2900
C
 2640 CONTINUE
      I2=0
      DO2641I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2641
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2642K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL HSEPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2642 CONTINUE
      X2(I)=SUM/ANI
 2641 CONTINUE
      GOTO2900
C
 2650 CONTINUE
      I2=0
      DO2651I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2651
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2652K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GOMPPF(UNIOSM,C,B,DISOSM)
      SUM=SUM+DISOSM
 2652 CONTINUE
      X2(I)=SUM/ANI
 2651 CONTINUE
      GOTO2900
C
 2660 CONTINUE
      I2=0
      DO2661I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2661
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2662K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL HFCPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2662 CONTINUE
      X2(I)=SUM/ANI
 2661 CONTINUE
      GOTO2900
C
 2670 CONTINUE
      I2=0
      DO2671I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2671
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2672K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL HFLPPF(UNIOSM,GAMMA,DISOSM)
      SUM=SUM+DISOSM
 2672 CONTINUE
      X2(I)=SUM/ANI
 2671 CONTINUE
      GOTO2900
C
 2680 CONTINUE
      I2=0
      DO2681I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2681
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2682K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GEVPPF(UNIOSM,GAMMA,MINMAX,DISOSM)
      SUM=SUM+DISOSM
 2682 CONTINUE
      X2(I)=SUM/ANI
 2681 CONTINUE
      GOTO2900
C
 2690 CONTINUE
      I2=0
      ZLOC=A
      IF(ZLOC.LE.0.0)ZLOC=1.0
      DO2691I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2691
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2692K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL PA2PPF(UNIOSM,GAMMA,ZLOC,DISOSM)
      SUM=SUM+DISOSM
 2692 CONTINUE
      X2(I)=SUM/ANI
 2691 CONTINUE
      GOTO2900
C
 2700 CONTINUE
      I2=0
      DO2701I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2701
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2702K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL DWEPPF(UNIOSM,GAMMA,DISOSM)
      SUM=SUM+DISOSM
 2702 CONTINUE
      X2(I)=SUM/ANI
 2701 CONTINUE
      GOTO2900
C
 2710 CONTINUE
      I2=0
      DO2711I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2711
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2712K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL WCAPPF(UNIOSM,P,DISOSM)
      SUM=SUM+DISOSM
 2712 CONTINUE
      X2(I)=SUM/ANI
 2711 CONTINUE
      GOTO2900
C
 2720 CONTINUE
      I2=0
      DO2721I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2721
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2722K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL EWEPPF(UNIOSM,GAMMA,THETA,IARG1,DISOSM)
      SUM=SUM+DISOSM
 2722 CONTINUE
      X2(I)=SUM/ANI
 2721 CONTINUE
      GOTO2900
C
 2730 CONTINUE
      I2=0
      DO2731I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2731
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2732K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL TNEPPF(UNIOSM,X0,AM,SD,DISOSM)
      SUM=SUM+DISOSM
 2732 CONTINUE
      X2(I)=SUM/ANI
 2731 CONTINUE
      GOTO2900
C
 2740 CONTINUE
      I2=0
      DO2741I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2741
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2742K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL GLOPPF(UNIOSM,ALPHA,DISOSM)
      SUM=SUM+DISOSM
 2742 CONTINUE
      X2(I)=SUM/ANI
 2741 CONTINUE
      GOTO2900
C
 2750 CONTINUE
      I2=0
      DO2751I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2751
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2752K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL PEXPPF(UNIOSM,ALPHA,BETA,DISOSM)
      SUM=SUM+DISOSM
 2752 CONTINUE
      X2(I)=SUM/ANI
 2751 CONTINUE
      GOTO2900
C
 2760 CONTINUE
      I2=0
      DO2761I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2761
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2762K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL DGAPPF(UNIOSM,GAMMA,DISOSM)
      SUM=SUM+DISOSM
 2762 CONTINUE
      X2(I)=SUM/ANI
 2761 CONTINUE
      GOTO2900
C
 2770 CONTINUE
      I2=0
      DO2771I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2771
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2772K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL KAPPPF(UNIOSM,ANU,BETA,THETA,DISOSM)
      SUM=SUM+DISOSM
 2772 CONTINUE
      X2(I)=SUM/ANI
 2771 CONTINUE
      GOTO2900
C
 2780 CONTINUE
      I2=0
      DO2781I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2781
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2782K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL FCAPPF(UNIOSM,AM,SD,DISOSM)
      SUM=SUM+DISOSM
 2782 CONTINUE
      X2(I)=SUM/ANI
 2781 CONTINUE
      GOTO2900
C
 2790 CONTINUE
      I2=0
      DO2791I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2791
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2792K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL BBNPPF(UNIOSM,ALPHA,BETA,NU,DISOSM)
      SUM=SUM+DISOSM
 2792 CONTINUE
      X2(I)=SUM/ANI
 2791 CONTINUE
      GOTO2900
C
 2800 CONTINUE
      I2=0
      DO2801I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2801
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2802K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL BRAPPF(UNIOSM,BETA,DISOSM)
      SUM=SUM+DISOSM
 2802 CONTINUE
      X2(I)=SUM/ANI
 2801 CONTINUE
      GOTO2900
C
 2810 CONTINUE
      I2=0
      DO2811I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2811
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2812K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL GEXPPF(UNIOSM,ALAMB1,ALAMB2,GAMMA,DISOSM)
      SUM=SUM+DISOSM
 2812 CONTINUE
      X2(I)=SUM/ANI
 2811 CONTINUE
      GOTO2900
C
 2820 CONTINUE
      I2=0
      DO2821I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2821
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2822K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL RECPPF(UNIOSM,B,DISOSM)
      SUM=SUM+DISOSM
 2822 CONTINUE
      X2(I)=SUM/ANI
 2821 CONTINUE
      GOTO2900
C
 2830 CONTINUE
      I2=0
      DO2831I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2831
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2832K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL NMXPPF(UNIOSM,U1,SD1,U2,SD2,P,DISOSM)
      SUM=SUM+DISOSM
 2832 CONTINUE
      X2(I)=SUM/ANI
 2831 CONTINUE
      GOTO2900
C
 2840 CONTINUE
      I2=0
      DO2841I=1,N
      NI=D2(I)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      IF(NI.LE.0)GOTO2841
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2842K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL IGAPPF(UNIOSM,GAMMA,DISOSM)
      SUM=SUM+DISOSM
 2842 CONTINUE
      X2(I)=SUM/ANI
 2841 CONTINUE
      GOTO2900
C
 2850 CONTINUE
      I2=0
      DO2851I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO2851
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2852K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IWRITE='OFF'
      IF(IGLDDF.EQ.'RAMB')THEN
        IARG1=1
        ARG3=-1.0
        ZSCALE=1.0
        CALL GLDCHK(ALAMB3,ALAMB4,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
      ENDIF
      CALL GLDPPF(DBLE(UNIOSM),DBLE(ALAMB3),DBLE(ALAMB4),
     1            DX2OUT,IGLDDF,IWRITE)
      DISOSM=REAL(DX2OUT)
      IF(IGLDDF.EQ.'RAMB')THEN
        SUM=SUM+(ZSCALE*DISOSM)
      ELSE
        SUM=SUM+DISOSM
      ENDIF
 2852 CONTINUE
      X2(I)=SUM/ANI
 2851 CONTINUE
      GOTO2900
C
 2860 CONTINUE
      I2=0
      DO2861I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO2861
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2862K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL JSBPPF(UNIOSM,ALPHA1,ALPHA2,DISOSM)
      SUM=SUM+DISOSM
 2862 CONTINUE
      X2(I)=SUM/ANI
 2861 CONTINUE
      GOTO2900
C
 2870 CONTINUE
      I2=0
      DO2871I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO2871
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2872K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL JSUPPF(UNIOSM,ALPHA1,ALPHA2,DISOSM)
      SUM=SUM+DISOSM
 2872 CONTINUE
      X2(I)=SUM/ANI
 2871 CONTINUE
      GOTO2900
C
 2880 CONTINUE
      I2=0
      DO2881I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO2881
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2882K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL IWEPPF(UNIOSM,GAMMA,DISOSM)
      SUM=SUM+DISOSM
 2882 CONTINUE
      X2(I)=SUM/ANI
 2881 CONTINUE
      GOTO2900
C
 2890 CONTINUE
      I2=0
      DO2891I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO2891
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2892K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL LDEPPF(UNIOSM,ALPHA,DISOSM)
      SUM=SUM+DISOSM
 2892 CONTINUE
      X2(I)=SUM/ANI
 2891 CONTINUE
      GOTO2900
C
12900 CONTINUE
      I2=0
      DO12901I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12901
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12902K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GEEPPF(UNIOSM,GAMMA,DISOSM)
      SUM=SUM+DISOSM
12902 CONTINUE
      X2(I)=SUM/ANI
12901 CONTINUE
      GOTO2900
C
12910 CONTINUE
      I2=0
      DO12911I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12911
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12912K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL TSPPPF(UNIOSM,THETA,ANU,DISOSM)
      SUM=SUM+DISOSM
12912 CONTINUE
      X2(I)=SUM/ANI
12911 CONTINUE
      GOTO2900
C
12920 CONTINUE
      I2=0
      DO12921I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12921
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12922K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL BWEPPF(UNIOSM,ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,DISOSM,
     1            DX2OUT)
      SUM=SUM+DISOSM
12922 CONTINUE
      X2(I)=SUM/ANI
12921 CONTINUE
      GOTO2900
C
12930 CONTINUE
      I2=0
      DO12931I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12931
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12932K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GHPPF(UNIOSM,G,H,DISOSM,DBLE(UNIOSM),DX2OUT)
      SUM=SUM+DISOSM
12932 CONTINUE
      X2(I)=SUM/ANI
12931 CONTINUE
      GOTO2900
C
12940 CONTINUE
      I2=0
      DO12941I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12941
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12942K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      DISOSM=LANPPF(UNIOSM)
      SUM=SUM+DISOSM
12942 CONTINUE
      X2(I)=SUM/ANI
12941 CONTINUE
      GOTO2900
C
12950 CONTINUE
      I2=0
      DO12951I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12951
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12952K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL ERRPPF(UNIOSM,ALPHA,DISOSM)
      SUM=SUM+DISOSM
12952 CONTINUE
      X2(I)=SUM/ANI
12951 CONTINUE
      GOTO2900
C
12960 CONTINUE
      I2=0
      DO12961I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12961
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12962K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL TRAPPF(UNIOSM,A,B,C,DZ,DISOSM)
      SUM=SUM+DISOSM
12962 CONTINUE
      X2(I)=SUM/ANI
12961 CONTINUE
      GOTO2900
C
12970 CONTINUE
      I2=0
      DO12971I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12971
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12972K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GTRPPF(UNIOSM,A,B,C,DZ,ANU1,ANU3,ALPHA,DISOSM)
      SUM=SUM+DISOSM
12972 CONTINUE
      X2(I)=SUM/ANI
12971 CONTINUE
      GOTO2900
C
12980 CONTINUE
      I2=0
      DO12981I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12981
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12982K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL FTPPF(UNIOSM,NU,DISOSM)
      SUM=SUM+DISOSM
12982 CONTINUE
      X2(I)=SUM/ANI
12981 CONTINUE
      GOTO2900
C
12990 CONTINUE
      I2=0
      DO12991I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO12991
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO12992K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL SLAPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
12992 CONTINUE
      X2(I)=SUM/ANI
12991 CONTINUE
      GOTO2900
C
13000 CONTINUE
      I2=0
      DO13001I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13001
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13002K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL SNPPF(UNIOSM,ALAMBA,ISKNDF,DISOSM)
      SUM=SUM+DISOSM
13002 CONTINUE
      X2(I)=SUM/ANI
13001 CONTINUE
      GOTO2900
C
13010 CONTINUE
      I2=0
      DO13011I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13011
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13012K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL STPPF(UNIOSM,NU,ALAMBA,DISOSM)
      SUM=SUM+DISOSM
13012 CONTINUE
      X2(I)=SUM/ANI
13011 CONTINUE
      GOTO2900
C
13020 CONTINUE
      I2=0
      DO13021I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13021
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13022K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL IBPPF(UNIOSM,ALPHA,BETA,DISOSM)
      SUM=SUM+DISOSM
13022 CONTINUE
      X2(I)=SUM/ANI
13021 CONTINUE
      GOTO2900
C
13030 CONTINUE
      I2=0
      DO13031I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13031
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13032K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IF(IMAKDF.EQ.'DLMF')THEN
        CALL MAKPPF(UNIOSM,XI,ALAMB,THETA,DISOSM)
      ELSEIF(IMAKDF.EQ.'MEEK')THEN
        XI=GAMMA/AK
        THETA=ALAMB/GAMMA
        ALAMB=AK
        CALL MAKPPF(UNIOSM,XI,ALAMB,THETA,DISOSM)
      ELSEIF(IMAKDF.EQ.'REPA')THEN
        CALL MA2PPF(UNIOSM,ZETA,ETA,DISOSM)
      ENDIF
      SUM=SUM+DISOSM
13032 CONTINUE
      X2(I)=SUM/ANI
13031 CONTINUE
      GOTO2900
C
13040 CONTINUE
      I2=0
      DO13041I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13041
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13042K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL LSNPPF(UNIOSM,ALAMBA,SD,DISOSM)
      SUM=SUM+DISOSM
13042 CONTINUE
      X2(I)=SUM/ANI
13041 CONTINUE
      GOTO2900
C
13050 CONTINUE
      I2=0
      DO13051I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13051
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13052K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL LSTPPF(UNIOSM,NU,ALAMBA,SD,DISOSM)
      SUM=SUM+DISOSM
13052 CONTINUE
      X2(I)=SUM/ANI
13051 CONTINUE
      GOTO2900
C
13060 CONTINUE
      I2=0
      DO13061I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13061
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13062K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL ARSPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
13062 CONTINUE
      X2(I)=SUM/ANI
13061 CONTINUE
      GOTO2900
C
13070 CONTINUE
      I2=0
      DO13071I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13071
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13072K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL POLPPF(UNIOSM,ALPHA,BETA,NU,DISOSM)
      SUM=SUM+DISOSM
13072 CONTINUE
      X2(I)=SUM/ANI
13071 CONTINUE
      GOTO2900
C
13080 CONTINUE
      I2=0
      DO13081I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13081
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13082K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IARG1=1
      CALL HERPPF(UNIOSM,ALPHA,BETA,DISOSM)
      SUM=SUM+DISOSM
13082 CONTINUE
      X2(I)=SUM/ANI
13081 CONTINUE
      GOTO2900
C
13090 CONTINUE
      I2=0
      DO13091I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13091
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13092K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL SDEPPF(UNIOSM,ALAMBA,DISOSM)
      SUM=SUM+DISOSM
13092 CONTINUE
      X2(I)=SUM/ANI
13091 CONTINUE
      GOTO2900
C
13100 CONTINUE
      I2=0
      DO13101I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13101
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13102K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      IF(IADEDF.EQ.'K')THEN
        CALL ADEPPF(UNIOSM,AK,IADEDF,DISOSM)
      ELSE
        CALL ADEPPF(UNIOSM,AMU,IADEDF,DISOSM)
      ENDIF
      SUM=SUM+DISOSM
13102 CONTINUE
      X2(I)=SUM/ANI
13101 CONTINUE
      GOTO2900
C
13110 CONTINUE
      I2=0
      DO13111I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13111
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13112K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL MAXPPF(UNIOSM,SIGMA,DISOSM)
      SUM=SUM+DISOSM
13112 CONTINUE
      X2(I)=SUM/ANI
13111 CONTINUE
      GOTO2900
C
13120 CONTINUE
      I2=0
      DO13121I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13121
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13122K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL RAYPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
13122 CONTINUE
      X2(I)=SUM/ANI
13121 CONTINUE
      GOTO2900
C
13130 CONTINUE
      I2=0
      DO13131I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13131
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13132K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GIGPPF(DBLE(UNIOSM),DBLE(CHI),DBLE(ALAMBA),DBLE(THETA),
     1            DX2OUT)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13132 CONTINUE
      X2(I)=SUM/ANI
13131 CONTINUE
      GOTO2900
C
13140 CONTINUE
      I2=0
      DO13141I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13141
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13142K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GALPPF(DBLE(UNIOSM),DBLE(AK),DBLE(TAU),IADEDF,DX2OUT)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13142 CONTINUE
      X2(I)=SUM/ANI
13141 CONTINUE
      GOTO2900
C
13150 CONTINUE
      I2=0
      DO13151I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13151
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13152K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL MCLPPF(DBLE(UNIOSM),DBLE(ALPHA),DX2OUT)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13152 CONTINUE
      X2(I)=SUM/ANI
13151 CONTINUE
      GOTO2900
C
13160 CONTINUE
      I2=0
      IF(IBEIDF.EQ.'1')THEN
        DO13161I=1,N
        NI=D2(I)
        IF(NI.LE.0)GOTO13161
        ANI=NI
        I1=I2+1
        I2=I1+NI-1
        SUM=0.0
        DO13162K=I1,I2
        CALL UNIME2(NTOT,K,UNIOSM)
        CALL BEIPPF(DBLE(UNIOSM),DBLE(SD1),DBLE(SD2),DBLE(ANU),IBEIDF,
     1              DX2OUT)
        DISOSM=REAL(DX2OUT)
        SUM=SUM+DISOSM
13162   CONTINUE
        X2(I)=SUM/ANI
13161   CONTINUE
      ELSE
        DO13166I=1,N
        NI=D2(I)
        IF(NI.LE.0)GOTO13166
        ANI=NI
        I1=I2+1
        I2=I1+NI-1
        SUM=0.0
        DO13167K=I1,I2
        CALL UNIME2(NTOT,K,UNIOSM)
        CALL BEIPPF(DBLE(UNIOSM),DBLE(B),DBLE(C),DBLE(AM),IBEIDF,
     1              DX2OUT)
        DISOSM=REAL(DX2OUT)
        SUM=SUM+DISOSM
13167   CONTINUE
        X2(I)=SUM/ANI
13166   CONTINUE
      ENDIF
      GOTO2900
C
13170 CONTINUE
      I2=0
      IF(IBEIDF.EQ.'1')THEN
        DO13171I=1,N
        NI=D2(I)
        IF(NI.LE.0)GOTO13171
        ANI=NI
        I1=I2+1
        I2=I1+NI-1
        SUM=0.0
        DO13172K=I1,I2
        CALL UNIME2(NTOT,K,UNIOSM)
CCCCC   CALL BEKPPF(DBLE(UNIOSM),DBLE(SD1),DBLE(SD2),DBLE(ANU),DX2OUT)
        DISOSM=REAL(DX2OUT)
        SUM=SUM+DISOSM
13172   CONTINUE
        X2(I)=SUM/ANI
13171   CONTINUE
      ELSE
        DO13176I=1,N
        NI=D2(I)
        IF(NI.LE.0)GOTO13176
        ANI=NI
        I1=I2+1
        I2=I1+NI-1
        SUM=0.0
        DO13177K=I1,I2
        CALL UNIME2(NTOT,K,UNIOSM)
CCCCC   CALL BEKPPF(DBLE(UNIOSM),DBLE(B),DBLE(C),DBLE(AM),DX2OUT)
        DISOSM=REAL(DX2OUT)
        SUM=SUM+DISOSM
13177   CONTINUE
        X2(I)=SUM/ANI
13176   CONTINUE
      ENDIF
      GOTO2900
C
13180 CONTINUE
      I2=0
      DO13181I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13181
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13182K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GMCPPF(DBLE(UNIOSM),DBLE(ALPHA),DBLE(A),DX2OUT)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13182 CONTINUE
      X2(I)=SUM/ANI
13181 CONTINUE
      GOTO2900
C
13190 CONTINUE
      I2=0
      XPAR(1)=0.0D0
      XPAR(2)=1.0D0
      XPAR(3)=DBLE(ALPHA)
      DO13191I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13191
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13192K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      DX2OUT=QUAGLO(DBLE(UNIOSM),XPAR)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13192 CONTINUE
      X2(I)=SUM/ANI
13191 CONTINUE
      GOTO2900
C
13200 CONTINUE
      I2=0
      XPAR(1)=0.0D0
      XPAR(2)=1.0D0
      XPAR(3)=DBLE(BETA)
      XPAR(4)=DBLE(GAMMA)
      XPAR(5)=DBLE(DELTA)
      DO13201I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13201
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13202K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      DX2OUT=QUAWAK(DBLE(UNIOSM),XPAR)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13202 CONTINUE
      X2(I)=SUM/ANI
13201 CONTINUE
      GOTO2900
C
13210 CONTINUE
      I2=0
      DO13211I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13211
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13212K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL BNOPPF(DBLE(UNIOSM),DBLE(ALPHA),DBLE(BETA),DX2OUT)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13212 CONTINUE
      X2(I)=SUM/ANI
13211 CONTINUE
      GOTO2900
C
13220 CONTINUE
      I2=0
      DO13221I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13221
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13222K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GL2PPF(DBLE(UNIOSM),DBLE(ALPHA),DX2OUT)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13222 CONTINUE
      X2(I)=SUM/ANI
13221 CONTINUE
      GOTO2900
C
13230 CONTINUE
      I2=0
      DO13231I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13231
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13232K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GL3PPF(DBLE(UNIOSM),DBLE(ALPHA),DX2OUT)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13232 CONTINUE
      X2(I)=SUM/ANI
13231 CONTINUE
      GOTO2900
C
13240 CONTINUE
      I2=0
      DO13241I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13241
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13242K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL GL4PPF(DBLE(UNIOSM),DBLE(P),DBLE(Q),DX2OUT)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13242 CONTINUE
      X2(I)=SUM/ANI
13241 CONTINUE
      GOTO2900
C
13250 CONTINUE
      I2=0
      DO13251I=1,N
      NI=D2(I)
      IF(NI.LE.0)GOTO13251
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO13252K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL ALDPPF(DBLE(UNIOSM),DBLE(ALPHA),DBLE(BETA),DX2OUT)
      DISOSM=REAL(DX2OUT)
      SUM=SUM+DISOSM
13252 CONTINUE
      X2(I)=SUM/ANI
13251 CONTINUE
      GOTO2900
C
 2900 CONTINUE
      DO2910I=1,N
      D2(I)=1.0
 2910 CONTINUE
      N2=N
      NPLOTV=2
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IDATSW,N2,IERROR
 9012 FORMAT('ICASPL,IDATSW,N2,IERROR = ',A4,2X,A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NTOT
 9014 FORMAT('NTOT = ',I8)
      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),D2(I)
 9021 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPPCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICASP2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PROBABILITY PLOT CORRELATION COEFFICIENT PLOT
C              FOR ONE OF THE FOLLOWING DISTRIBUTIONAL FAMILIES--
C              UNIVARIATE CONTINUOUS (ONE SHAPE PARAMETER)
C               1) TUKEY LAMBDA
C               2) T
C               3) CHI-SQUARED
C               4) GAMMA
C               5) WEIBULL --MIN & MAX
C               6) EXTREME VALUE TYPE 2 (FRECHET) --MIN & MAX
C               7) PARETO
C               8) WALD
C               9) FATIGUE LIFE
C              10) EXTREME VALUE (GENERAL)
C                        EXTREME VALUE PPCC PLOT Y
C                        EXTREME PPCC PLOT Y
C                        EV PPCCC PLOT Y
C              11) GENERALIZED PARETO
C                        GENERALIZED PARETO PPCC PLOT Y
C                        GEP PPCC PLOT Y
C                        GP PPCC PLOT Y
C              12) LOGNORMAL
C              13) POWER NORMAL
C              14) POWER FUNCTION
C              15) CHI
C              16) VON MISES
C              17) LOG LOGISTIC
C              18) LOG GAMMA
C              19) DOUBLE WEIBULL
C              20) GENERALIZED EXTREME VALUE
C              21) PARETO SECOND KIND
C              22) GENERALIZED HALF LOGISTIC
C              23) WRAPPED CAUCHY
C              24) GENERALIZED LOGISTIC
C              25) DOUBLE GAMMA
C              26) BRADFORD
C              27) RECIPROCAL
C              28) INVERTED GAMMA
C              29) INVERTED WEIBULL
C              30) LOG DOUBLE EXPONENTIAL
C              31) GEOMETRIC EXTREME  EXPONENTIAL
C              32) ERROR (SUBBOTIN/EXPONENTIAL POWER)
C              33) FOLDED T
C              34) SKEW NORMAL
C              35) SKEW DOUBLE EXPONENTIAL
C              36) ASYMMETRIC DOUBLE EXPONENTIAL
C              37) MAXWELL
C              38) MCLEISH
C              39) GENERALIZED LOGISTIC TYPE 5
C              40) GENERALIZED LOGISTIC TYPE 2
C              41) GENERALIZED LOGISTIC TYPE 3
C
C              NOTE: EVEN THOUGH PARETO, PARETO SECOND KIND
C                    ACTUALLY HAVE A SECOND SHAPE PARAMETER, TREAT
C                    THIS AS KNOWN AND FIXED (SET TO MINIMUM OF
C                    THE DATA FOR THE PARETO, LET USER SET FOR
C                    PARETO SECOND KIND (DEFAULT TO 1)).
C
C              UNIVARIATE DISCRETE (USE A LITTLE IFFY HERE, BUT
C              INCLUDE FOR EXPERIMENTAL PURPOSES, KS PLOT WORKS
C              BETTER THAN THE PPCC PLOT HERE)
C               1) GEOMETRIC
C               2) POISSON
C               3) LOGARITHMIC SERIES
C               4) NEGATIVE BIONOMIAL
C               5) BETA-BINOMIAL (ASSUME N PARAMETER KNOWN)
C               6) POLYA (ASSUME N PARAMETER KNOWN)
C               7) HYPERGEOMETRIC
C               8) YULE
C               9) WARING (RESTRICT TO A >= 1 CASE FOR NOW,
C                  IF GET BETTER APPROXIMATION FOR CDF/PPF
C                  FOR A < 1, THEN CAN IMPLEMENT FURTHER).
C              10) HERMITE
C              11) BINOMIAL
C
C              WE DO NOT INCLUDE BINOMIAL OR DISCRETE UNIFORM
C              SINCE THE PROBABILITY PLOT IS NOT PARTICULARLY
C              MEANINGFUL IN THESE CASES.
C
C              SUPPORT FOR FOLLOWING DISTRIBUTIONS WITH 2 SHAPE
C              PARAMETERS (AUGUST 2001).  FOR THESE, WE WILL
C              GENERATE A 3-D PLOT.  FOR SOME OF THESE, PPCC PLOT
C              CAN BE SLOW DUE TO FACT THAT PPCC MAY BE EXPENSIVE
C              TO COMPUTE.
C               1) GENERALIZED TUKEY LAMBDA
C               2) BETA
C               3) GENERALIZED GAMMA
C               4) GOMPERTZ
C               5) EXPONENTIAL POWER
C               6) POWER LOGNORMAL
C               7) ALPHA
C               8) EXPONENTIATED WEIBULL
C               9) JOHNSON SB
C              10) JOHNSON SU
C              11) TWO-SIDED POWER
C              12) F
C              13) INVERSE GAUSSIAN
C              14) RECIPROCAL INVERSE GAUSSIAN
C              15) SKEW T
C              16) INVERTED BETA
C              17) G-AND-H
C              18) LOG-SKEW-NORMAL
C              19) NON-CENTRAL T
C              20) NON-CENTRAL CHI-SQUARE
C              21) FOLDED NORMAL
C              22) FOLDED CAUCHY
C              23) TRUNCATED EXPONENTIAL
C                  (ASSUME TRUNCATION POINT X0 IS KNOWN)
C              24) GOMPERTZ-MAKEHAM (FOR MEEKER REPARAMETERIZATION TO
C                  CASE WITH TWO SHAPE PARAMETERS AND SCALE PARAMETER)
C              25) GENERALIZED ASYMMETRIC LAPLACE
C              26) GENERALIZED MCLEISH
C              27) BETA NORMAL
C              28) HYPERBOLIC (NOT WORKING)
C              29) GENERALIZED LOGISTIC TYPE 4
C              30) ASYMMETRIC LOG DOUBLE EXPONENTIAL
C
C              NOTE 1: FOR THE TRUNCATED EXPONENTIAL, IF YOU SET
C                      MU1 =MU2, A PPCC PLOT FOR SD ONLY IS GENERATED.
C
C              NOTE 2: THE NON-CENTRAL T, NON-CENTRAL CHI-SQUARE,
C                      SKEW T, INVERTED BETA, LOG-SKEW-NORMAL,
C                      GENERALIZED ASYMMETRIC LAPLACE,
C                      GENERALIZED MCLEISH, HYPERBOLIC
C                      HAVE EXPENSIVE PERCENT POINT FUNCTIONS, SO
C                      THE PPCC PLOT CAN TAKE A LONG TIME (SO MAY
C                      NOT BE PRACTICAL EXCEPT FOR RATHER SMALL DATA
C                      SETS).  WE ADDRESS THIS WITH THE COMMAND
C
C                         SET PPCC PLOT DATA POINTS <VALUE>
C
C                      IF THIS VALUE IS SET, THEN THE PPCC/KS
C                      PLOT WILL COMPUTE THAT NUMBER OF EQUALLY
C                      SPACED PERCENTILES OF THE DATA RATHER
C                      THAN THE RAW DATA.
C
C              FOLLOWING DATAPLOT SUPPORTED DISTRIBUTIONS ONLY
C              HAVE LOCATION AND SCALE PARAMETERS, SO PPCC PLOT
C              IS NOT APPLICABLE (I.E., JUST GENERATE PROB PLOT)
C               1) NORMAL
C               2) UNIFORM
C               3) LOGISTIC
C               4) DOUBLE EXPONENTIAL
C               5) CAUCHY
C               6) SEMI-CIRCULAR
C               7) COSINE
C               8) ANGLIT
C               9) HYPERBOLIC SECANT
C              10) HALF-NORMAL
C              11) ARCSIN
C              12) EXPONENTIAL
C              13) EXTREME VALUE TYPE I (GUMBEL)
C              14) HALF-CAUCHY
C              15) LANDAU
C              16) SLASH
C              17) RAYLEIGH
C
C              FOLLOWING HAVE MORE THAN 2 SHAPE PARAMETERS, SO
C              NOTHING IMPLEMENTED AT THIS TIME
C               1) TRUNCATED NORMAL
C               2) NON-CENTRAL F
C               3) DOUBLY NON-CENTRAL F
C               4) DOUBLY NON-CENTRAL T
C               5) LOG-SKEW-T
C               6) NON-CENTRAL BETA
C               7) GENERALIZED EXPONENTIAL
C               8) GOMPERTZ-MAKEHAM
C                  NOTE: AVAILABLE IF MEEKER REPARAMERIZATION TO
C                  TWO SHAPE PARAMETERS AND A SCALE PARAMETER IS USED
C               9) MIELKE'S BETA-KAPPA
C              10) NORMAL MIXTURE (MAXIMUM LIKELIHOOD ESTIMATE AVAILABLE)
C              11) BI-WEIBULL
C              12) GENERALIZED INVERSE GAUSSIAN
C              13) BESSEL I-FUNCTION
C              14) BESSEL K-FUNCTION
C              15) WAKEBY (L-MOMENT ESTIMATES AVAILABLE)
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--82/7
C     ORIGINAL VERSION--FEBRUARY  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MAY       1990.  IG, WALD, RIG, FL (SAUNDERS)
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --MAY       1993. MINMAX FOR EV1/EV2/WEIB DIST.
C     UPDATED         --MAY       1993. ADD FRECHET NAME FOR EV2
C     UPDATED         --DECEMBER  1993. ADD EXTREME VALUE (GENERAL)
C     UPDATED         --DECEMBER  1993. ADD GENERALIZED PARETO
C     UPDATED         --APRIL     1995. ADD LOGNORMAL
C     UPDATED         --APRIL     1995. ADD POWER NORMAL
C     UPDATED         --APRIL     1995. ADD POWER LOGNORMAL
C     UPDATED         --APRIL     1995. ADD POWER FUNCTION
C     UPDATED         --APRIL     1995. ADD CHI
C     UPDATED         --APRIL     1995. ADD VON MISES
C     UPDATED         --APRIL     1995. ADD LOG LOGISTIC
C     UPDATED         --OCTOBER   1995. ADD LOG GAMMA, 5 OTHERS
C     UPDATED         --JANUARY   1996. ADD DOUBLE GAMMA
C     UPDATED         --FEBRUARY  1996. ADD BRADFORD
C     UPDATED         --MAY       1996. ADD RECIPROCAL
C     UPDATED         --JANUARY   1998. ADD LOG SERIES, BINOMIAL,
C                                       NEGATIVE BINOMIAL
C     UPDATED         --MAY       1998. ADD INVERTED GAMMA
C     UPDATED         --AUGUST    2001. SUPPORT FOR A NUMBER OF
C                                       2-SHAPE PARAMETER
C                                       DISTRIBUTIONS
C     UPDATED         --SEPTEMBER 2001. 4 ADDITIONAL DISTRIBUTIONS
C     UPDATED         --NOVEMBER  2001. GEOM EXTREME EXPONENTIAL
C     UPDATED         --MAY       2002. TWO-SIDED POWER
C     UPDATED         --MAY       2003. ERROR (=SUBBOTIN/EXPO POWE)
C     UPDATED         --NOVEMBER  2003. FOLDED T
C     UPDATED         --NOVEMBER  2003. F
C     UPDATED         --DECEMBER  2003. SKEW NORMAL
C     UPDATED         --DECEMBER  2003. SKEW T
C     UPDATED         --DECEMBER  2003. INVERTED BETA
C     UPDATED         --DECEMBER  2003. G-AND-H
C     UPDATED         --MARCH     2004. MAKE COMMAND SEARCH TABLE
C                                       DRIVEN
C     UPDATED         --MARCH     2004. SIGNIFICANT CLEAN-UP/BUG FIXES
C                                       FOR 2 SHAPE PARAMETER CASES
C                                       AND DISCRETE CASES
C     UPDATED         --MARCH     2004. NON-CENTRAL CHI-SQUARE
C     UPDATED         --MARCH     2004. NON-CENTRAL T
C     UPDATED         --MARCH     2004. LOG-SKEW-NORMAL
C     UPDATED         --APRIL     2004. HERMITE
C     UPDATED         --MAY       2004. SUPPORT FOR ROBUST CORRELATION
C                                       MEASURES
C     UPDATED         --MAY       2004. SUPPORT FOR A KOLMOGOROV-SMIRNOV
C                                       PLOT VARIANT
C     UPDATED         --MAY       2004. SUPPORT FOR GENERATING 2-SHAPE
C                                       PARAMETER CASE AS A MULTI-TRACE
C                                       PLOT
C     UPDATED         --JUNE      2004. SKEW DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. ASYMMETRIC DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. ARGUMENT LIST TO GEPPPF
C     UPDATED         --JUNE      2004. MAXWELL
C     UPDATED         --JULY      2004. GOMPERTZ-MAKEHAM IF MEEKER
C                                       REPARAMETERIZATION CASE USED
C     UPDATED         --AUGUST    2004. GENERALIZED ASYMMETRIC LAPLACE
C     UPDATED         --AUGUST    2004. BINOMIAL
C     UPDATED         --AUGUST    2004. MCLEISH
C     UPDATED         --SEPTEMBER 2004. GENERALIZED MCLEISH
C     UPDATED         --SEPTEMBER 2004. HYPERBOLIC
C     UPDATED         --SEPTEMBER 2004. SUPPORT FOR FOLLOWING OPTIONS:
C                                       1) SET PPCC PLOT DATA POINTS
C                                       2) SET PPCC PLOT AXIS POINTS
C                                       3) SET PPCC PLOT AXIS ORDER
C     UPDATED         --OCTOBER   2004. SUPPORT FOR CENSORED DATA
C                                       (UNBINNED CASE ONLY)
C     UPDATED         --APRIL     2005. SUPPORT FOR REPLICATION (I.E.,
C                                       GROUPS AS OPPOSSED TO BINS)
C     UPDATED         --APRIL     2005. FOR BINNED DATA, SUPPORT CASE
C                                       WHERE LOWER AND UPPER BIN
C                                       BOUNDARIES SPECIFIED RATHER
C                                       THAN THE MID-POINTS.  THIS
C                                       ALLOWS USER FLEXIBILITY IN
C                                       COMBINING BINS
C     UPDATED         --AUGUST    2005. LOG LAPLACE AS SYNONYM FOR
C                                       LOG DOUBLE EXPONENTIAL
C     UPDATED         --FEBRUARY  2006. GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006. FMKL PARAMETERIZATION OF
C                                       GENERALIZED TUKEY LAMBDA
C     UPDATED         --MARCH     2006. SUPPORT FOR DIFFERENT DEFAULT
C                                       BINNING ALGORITHMS
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 LAPLACE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
 
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICASP2
      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 IDATSW
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHRI2H
      CHARACTER*4 IHRI22
      CHARACTER*4 IHRI3H
      CHARACTER*4 IHRI32
      CHARACTER*4 IERRO4
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MAY 1993
      CHARACTER*4 IWRITE
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
CCCCC THE FOLLOWING LINE WAS ADDED      DECEMBER 1993
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 LOWLTY
      CHARACTER*4 UPPLTY
      CHARACTER*30 IDIST
      CHARACTER*4 ICENSO
      CHARACTER*4 IREPL
      CHARACTER*4 IMETHD
C
      PARAMETER (NUMCHS=142)
      CHARACTER*4 INAME(NUMCHS,4)
      CHARACTER*4 INCASE(NUMCHS)
      INTEGER ISHAPE(NUMCHS)
C
      REAL KSLOC
      REAL KSSCAL
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION X1UPP(MAXOBV)
      DIMENSION X1UTMP(MAXOBV)
      DIMENSION XCENS(MAXOBV)
      DIMENSION XREPL(MAXOBV)
      DIMENSION XREPDS(MAXOBV)
      DIMENSION DISPAR(MAXOBV)
      DIMENSION DISPA2(MAXOBV)
      DIMENSION DISPA3(MAXOBV)
      DIMENSION CORR(MAXOBV)
      DIMENSION CORR2(MAXOBV)
      DIMENSION XTEMP1(MAXOBV)
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      DIMENSION XTEMP4(MAXOBV)
      DIMENSION XTEMP5(MAXOBV)
      DIMENSION XTEMP6(MAXOBV)
      DIMENSION XTEMP7(MAXOBV)
      DIMENSION XTEMP8(MAXOBV)
      DIMENSION XTEMP9(MAXOBV)
      DIMENSION X2TEMP(MAXOBV)
      DIMENSION Y2TEMP(MAXOBV)
      DIMENSION D2TEMP(MAXOBV)
      DIMENSION Y3(MAXOBV)
      DIMENSION XLOW(MAXOBV)
      DIMENSION XHIGH(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),X1(1))
      EQUIVALENCE (G2RBAG(IGAR12),Y1(1))
      EQUIVALENCE (G2RBAG(IGAR13),DISPAR(1))
      EQUIVALENCE (G2RBAG(IGAR14),DISPA2(1))
      EQUIVALENCE (G2RBAG(IGAR15),DISPA3(1))
      EQUIVALENCE (G2RBAG(IGAR16),CORR(1))
      EQUIVALENCE (G2RBAG(IGAR17),XTEMP1(1))
      EQUIVALENCE (G2RBAG(IGAR18),XTEMP2(1))
      EQUIVALENCE (G2RBAG(IGAR19),CORR2(1))
      EQUIVALENCE (G2RBAG(IGAR20),XTEMP3(1))
      EQUIVALENCE (G2RBAG(IGAR21),XTEMP4(1))
      EQUIVALENCE (G2RBAG(IGAR22),XTEMP5(1))
      EQUIVALENCE (G2RBAG(IGAR23),XTEMP6(1))
      EQUIVALENCE (G2RBAG(IGAR24),XREPL(1))
      EQUIVALENCE (G2RBAG(IGAR25),XCENS(1))
      EQUIVALENCE (G2RBAG(IGAR26),Y3(1))
      EQUIVALENCE (G2RBAG(IGAR27),XLOW(1))
      EQUIVALENCE (G2RBAG(IGAR28),XHIGH(1))
      EQUIVALENCE (G2RBAG(IGAR29),XREPDS(1))
      EQUIVALENCE (G2RBAG(IGAR30),Y2TEMP(1))
      EQUIVALENCE (G2RBAG(IGAR31),D2TEMP(1))
      EQUIVALENCE (G2RBAG(IGAR32),X2TEMP(1))
      EQUIVALENCE (G2RBAG(IGAR33),X1UPP(1))
      EQUIVALENCE (G2RBAG(IGAR34),X1UTMP(1))
      EQUIVALENCE (G2RBAG(IGAR35),XTEMP7(1))
      EQUIVALENCE (G2RBAG(IGAR36),XTEMP8(1))
      EQUIVALENCE (G2RBAG(IGAR37),XTEMP9(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
CCCCC THE FOLLOWING LINE WAS ADDED (FOR MINMAX)   MAY 1993
      INCLUDE 'DPCOSU.INC'
CCCCC THE FOLLOWING LINE WAS ADDED (FOR MINMAX)   MAY 1993
      INCLUDE 'DPCOS2.INC'
CCCCC THE FOLLOWING LINE WAS ADDED (FOR IHOST1/2)   MAY 1993
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C  MARCH 2004.  MAKE SEARCH TABLE DRIVEN
C
      DATA INCASE(1)/'LACP'/
      DATA ISHAPE(1)/1/
      DATA (INAME(1,J),J=1,4)/'TUKE','LAMB','    ','    '/
      DATA INCASE(2)/'LACP'/
      DATA ISHAPE(2)/1/
      DATA (INAME(2,J),J=1,4)/'TUKE','    ','    ','    '/
      DATA INCASE(3)/'LACP'/
      DATA ISHAPE(3)/1/
      DATA (INAME(3,J),J=1,4)/'LAMB','    ','    ','    '/
      DATA INCASE(4)/'LNCP'/
      DATA ISHAPE(4)/1/
      DATA (INAME(4,J),J=1,4)/'LOG ','NORM','    ','    '/
      DATA INCASE(5)/'LNCP'/
      DATA ISHAPE(5)/1/
      DATA (INAME(5,J),J=1,4)/'LOGN','    ','    ','    '/
      DATA INCASE(6)/'TCP'/
      DATA ISHAPE(6)/1/
      DATA (INAME(6,J),J=1,4)/'T   ','    ','    ','    '/
      DATA INCASE(7)/'TCP'/
      DATA ISHAPE(7)/1/
      DATA (INAME(7,J),J=1,4)/'STUD','T   ','    ','    '/
      DATA INCASE(8)/'CSCP'/
      DATA ISHAPE(8)/1/
      DATA (INAME(8,J),J=1,4)/'CHIS','    ','    ','    '/
      DATA INCASE(9)/'CSCP'/
      DATA ISHAPE(9)/1/
      DATA (INAME(9,J),J=1,4)/'CHI ','SQUA','    ','    '/
      DATA INCASE(10)/'FCP'/
      DATA ISHAPE(10)/2/
      DATA (INAME(10,J),J=1,4)/'F   ','    ','    ','    '/
      DATA INCASE(11)/'FCP'/
      DATA ISHAPE(11)/2/
      DATA (INAME(11,J),J=1,4)/'SNED','F   ','    ','    '/
      DATA INCASE(12)/'GACP'/
      DATA ISHAPE(12)/1/
      DATA (INAME(12,J),J=1,4)/'GAMM','    ','    ','    '/
      DATA INCASE(13)/'BNCP'/
      DATA ISHAPE(13)/2/
      DATA (INAME(13,J),J=1,4)/'BETA','NORM','    ','    '/
      DATA INCASE(14)/'WECP'/
      DATA ISHAPE(14)/1/
      DATA (INAME(14,J),J=1,4)/'WEIB','    ','    ','    '/
      DATA INCASE(15)/'E2CP'/
      DATA ISHAPE(15)/1/
      DATA (INAME(15,J),J=1,4)/'EXTR','VALU','TYPE','2   '/
      DATA INCASE(16)/'E2CP'/
      DATA ISHAPE(16)/1/
      DATA (INAME(16,J),J=1,4)/'EXTR','VALU','TYPE','II  '/
      DATA INCASE(17)/'E2CP'/
      DATA ISHAPE(17)/1/
      DATA (INAME(17,J),J=1,4)/'EVII','    ','    ','    '/
      DATA INCASE(18)/'E2CP'/
      DATA ISHAPE(18)/1/
      DATA (INAME(18,J),J=1,4)/'EV2 ','    ','    ','    '/
      DATA INCASE(19)/'E2CP'/
      DATA ISHAPE(19)/1/
      DATA (INAME(19,J),J=1,4)/'FREC','    ','    ','    '/
      DATA INCASE(20)/'PACP'/
      DATA ISHAPE(20)/1/
      DATA (INAME(20,J),J=1,4)/'PARE','    ','    ','    '/
      DATA INCASE(21)/'BICP'/
      DATA ISHAPE(21)/1/
      DATA (INAME(21,J),J=1,4)/'BINO','    ','    ','    '/
      DATA INCASE(22)/'GECP'/
      DATA ISHAPE(22)/1/
      DATA (INAME(22,J),J=1,4)/'GEOM','    ','    ','    '/
      DATA INCASE(23)/'POCP'/
      DATA ISHAPE(23)/1/
      DATA (INAME(23,J),J=1,4)/'POIS','    ','    ','    '/
      DATA INCASE(24)/'NBCP'/
      DATA ISHAPE(24)/2/
      DATA (INAME(24,J),J=1,4)/'NEGA','BINO','    ','    '/
      DATA INCASE(25)/'TRCP'/
      DATA ISHAPE(25)/1/
      DATA (INAME(25,J),J=1,4)/'TRIA','    ','    ','    '/
      DATA INCASE(26)/'IGCP'/
      DATA ISHAPE(26)/2/
      DATA (INAME(26,J),J=1,4)/'INVE','GAUS','    ','    '/
      DATA INCASE(27)/'IGCP'/
      DATA ISHAPE(27)/2/
      DATA (INAME(27,J),J=1,4)/'IG  ','    ','    ','    '/
      DATA INCASE(28)/'WACP'/
      DATA ISHAPE(28)/1/
      DATA (INAME(28,J),J=1,4)/'WALD','    ','    ','    '/
      DATA INCASE(29)/'RICP'/
      DATA ISHAPE(29)/2/
      DATA (INAME(29,J),J=1,4)/'RIG ','    ','    ','    '/
      DATA INCASE(30)/'RICP'/
      DATA ISHAPE(30)/2/
      DATA (INAME(30,J),J=1,4)/'TWEE','    ','    ','    '/
      DATA INCASE(31)/'RICP'/
      DATA ISHAPE(31)/2/
      DATA (INAME(31,J),J=1,4)/'RECI','INVE','GAUS','    '/
      DATA INCASE(32)/'FLCP'/
      DATA ISHAPE(32)/1/
      DATA (INAME(32,J),J=1,4)/'FATI','LIFE','    ','    '/
      DATA INCASE(33)/'FLCP'/
      DATA ISHAPE(33)/1/
      DATA (INAME(33,J),J=1,4)/'FL  ','    ','    ','    '/
      DATA INCASE(34)/'FLCP'/
      DATA ISHAPE(34)/1/
      DATA (INAME(34,J),J=1,4)/'BIRN','SAUN','    ','    '/
      DATA INCASE(35)/'FLCP'/
      DATA ISHAPE(35)/1/
      DATA (INAME(35,J),J=1,4)/'SAUN','BIRN','    ','    '/
      DATA INCASE(36)/'GPCP'/
      DATA ISHAPE(36)/1/
      DATA (INAME(36,J),J=1,4)/'GENE','PARE','    ','    '/
      DATA INCASE(37)/'GPCP'/
      DATA ISHAPE(37)/1/
      DATA (INAME(37,J),J=1,4)/'GEP ','    ','    ','    '/
      DATA INCASE(38)/'GPCP'/
      DATA ISHAPE(38)/1/
      DATA (INAME(38,J),J=1,4)/'GP  ','    ','    ','    '/
      DATA ISHAPE(39)/2/
      DATA INCASE(39)/'NTCP'/
      DATA (INAME(39,J),J=1,4)/'NONC','T   ','    ','    '/
      DATA INCASE(40)/'NTCP'/
      DATA ISHAPE(40)/2/
      DATA (INAME(40,J),J=1,4)/'NON-','T   ','    ','    '/
      DATA INCASE(41)/'NTCP'/
      DATA ISHAPE(41)/2/
      DATA (INAME(41,J),J=1,4)/'NON ','CENT','T   ','    '/
      DATA INCASE(42)/'NCCP'/
      DATA ISHAPE(42)/2/
      DATA (INAME(42,J),J=1,4)/'NON ','CENT','CHIS','    '/
      DATA INCASE(43)/'NCCP'/
      DATA ISHAPE(43)/2/
      DATA (INAME(43,J),J=1,4)/'NON ','CENT','CHI ','SQUA'/
      DATA INCASE(44)/'NCCP'/
      DATA ISHAPE(44)/2/
      DATA (INAME(44,J),J=1,4)/'NONC','CHI ','SQUA','    '/
      DATA INCASE(45)/'NCCP'/
      DATA ISHAPE(45)/2/
      DATA (INAME(45,J),J=1,4)/'NON ','CHI ','SQUA','    '/
      DATA INCASE(46)/'NCCP'/
      DATA ISHAPE(46)/2/
      DATA (INAME(46,J),J=1,4)/'NONC','CHI ','SQUA','    '/
      DATA INCASE(47)/'NCCP'/
      DATA ISHAPE(47)/2/
      DATA (INAME(47,J),J=1,4)/'NONC','CHIS','    ','    '/
      DATA INCASE(48)/'VMCP'/
      DATA ISHAPE(48)/1/
      DATA (INAME(48,J),J=1,4)/'VON ','MISE','    ','    '/
      DATA INCASE(49)/'VMCP'/
      DATA ISHAPE(49)/1/
      DATA (INAME(49,J),J=1,4)/'VONM','    ','    ','    '/
      DATA INCASE(50)/'PNCP'/
      DATA ISHAPE(50)/1/
      DATA (INAME(50,J),J=1,4)/'POWE','NORM','    ','    '/
      DATA INCASE(51)/'PLCP'/
      DATA ISHAPE(51)/2/
      DATA (INAME(51,J),J=1,4)/'POWE','LOGN','    ','    '/
      DATA INCASE(52)/'PLCP'/
      DATA ISHAPE(52)/2/
      DATA (INAME(52,J),J=1,4)/'POWE','LGNO','    ','    '/
      DATA INCASE(53)/'PLCP'/
      DATA ISHAPE(53)/2/
      DATA (INAME(53,J),J=1,4)/'POWE','LOG ','    ','    '/
      DATA INCASE(54)/'ALCP'/
      DATA ISHAPE(54)/2/
      DATA (INAME(54,J),J=1,4)/'ALPH','    ','    ','    '/
      DATA INCASE(55)/'PECP'/
      DATA ISHAPE(55)/2/
      DATA (INAME(55,J),J=1,4)/'POWE','EXPO','    ','    '/
      DATA INCASE(56)/'PFCP'/
      DATA ISHAPE(56)/1/
      DATA (INAME(56,J),J=1,4)/'POWE','FUNC','    ','    '/
      DATA INCASE(57)/'CHCP'/
      DATA ISHAPE(57)/1/
      DATA (INAME(57,J),J=1,4)/'CHI ','    ','    ','    '/
      DATA INCASE(58)/'DLCP'/
      DATA ISHAPE(58)/1/
      DATA (INAME(58,J),J=1,4)/'LOGA','SERI','    ','    '/
      DATA INCASE(59)/'LLCP'/
      DATA ISHAPE(59)/1/
      DATA (INAME(59,J),J=1,4)/'LOG ','LOGI','    ','    '/
      DATA INCASE(60)/'LLCP'/
      DATA ISHAPE(60)/1/
      DATA (INAME(60,J),J=1,4)/'LOGL','    ','    ','    '/
      DATA INCASE(61)/'GGCP'/
      DATA ISHAPE(61)/2/
      DATA (INAME(61,J),J=1,4)/'GENE','GAMM','    ','    '/
      DATA INCASE(62)/'GICP'/
      DATA ISHAPE(62)/1/
      DATA (INAME(62,J),J=1,4)/'INVE','GAMM','    ','    '/
      DATA INCASE(63)/'FNCP'/
      DATA ISHAPE(63)/2/
      DATA (INAME(63,J),J=1,4)/'FOLD','NORM','    ','    '/
      DATA INCASE(64)/'LGCP'/
      DATA ISHAPE(64)/1/
      DATA (INAME(64,J),J=1,4)/'LOG ','GAMM','    ','    '/
      DATA INCASE(65)/'GOCP'/
      DATA ISHAPE(65)/2/
      DATA (INAME(65,J),J=1,4)/'GOMP','    ','    ','    '/
      DATA INCASE(66)/'GVCP'/
      DATA ISHAPE(66)/1/
      DATA (INAME(66,J),J=1,4)/'GENE','EXTR','VALU','    '/
      DATA INCASE(67)/'GVCP'/
      DATA ISHAPE(67)/1/
      DATA (INAME(67,J),J=1,4)/'GEV ','    ','    ','    '/
      DATA INCASE(68)/'P2CP'/
      DATA ISHAPE(68)/1/
      DATA (INAME(68,J),J=1,4)/'PARE','SECO','KIND','    '/
      DATA INCASE(69)/'P2CP'/
      DATA ISHAPE(69)/1/
      DATA (INAME(69,J),J=1,4)/'PARE','TYPE','2   ','    '/
      DATA INCASE(70)/'P2CP'/
      DATA ISHAPE(70)/1/
      DATA (INAME(70,J),J=1,4)/'PARE','TYPE','II  ','    '/
      DATA INCASE(71)/'DWCP'/
      DATA ISHAPE(71)/1/
      DATA (INAME(71,J),J=1,4)/'DOUB','WEIB','    ','    '/
      DATA INCASE(72)/'EWCP'/
      DATA ISHAPE(72)/2/
      DATA (INAME(72,J),J=1,4)/'EXPO','WEIB','    ','    '/
      DATA INCASE(73)/'WCCP'/
      DATA ISHAPE(73)/1/
      DATA (INAME(73,J),J=1,4)/'WRAP','CAUC','    ','    '/
      DATA INCASE(74)/'G5CP'/
      DATA ISHAPE(74)/1/
      DATA (INAME(74,J),J=1,4)/'GENE','LOGI','TYPE','5   '/
      DATA INCASE(75)/'PECP'/
      DATA ISHAPE(75)/2/
      DATA (INAME(75,J),J=1,4)/'EXPO','POWE','    ','    '/
      DATA INCASE(76)/'DGCP'/
      DATA ISHAPE(76)/1/
      DATA (INAME(76,J),J=1,4)/'DOUB','GAMM','    ','    '/
      DATA INCASE(77)/'FCCP'/
      DATA ISHAPE(77)/2/
      DATA (INAME(77,J),J=1,4)/'FOLD','CAUC','    ','    '/
      DATA INCASE(78)/'BBCP'/
      DATA ISHAPE(78)/2/
      DATA (INAME(78,J),J=1,4)/'BETA','BINO','    ','    '/
      DATA INCASE(79)/'BRCP'/
      DATA ISHAPE(79)/1/
      DATA (INAME(79,J),J=1,4)/'BRAD','    ','    ','    '/
      DATA INCASE(80)/'RECP'/
      DATA ISHAPE(80)/1/
      DATA (INAME(80,J),J=1,4)/'RECI','    ','    ','    '/
      DATA INCASE(81)/'IWCP'/
      DATA ISHAPE(81)/1/
      DATA (INAME(81,J),J=1,4)/'INVE','WEIB','    ','    '/
      DATA INCASE(82)/'LXCP'/
      DATA ISHAPE(82)/1/
      DATA (INAME(82,J),J=1,4)/'LOG ','DOUB','EXPO','    '/
      DATA INCASE(83)/'LDCP'/
      DATA ISHAPE(83)/2/
      DATA (INAME(83,J),J=1,4)/'GENE','TUKE','LAMB','    '/
      DATA INCASE(84)/'JBCP'/
      DATA ISHAPE(84)/2/
      DATA (INAME(84,J),J=1,4)/'JOHN','SB  ','    ','    '/
      DATA INCASE(85)/'JUCP'/
      DATA ISHAPE(85)/2/
      DATA (INAME(85,J),J=1,4)/'JOHN','SU  ','    ','    '/
      DATA INCASE(86)/'EECP'/
      DATA ISHAPE(86)/1/
      DATA (INAME(86,J),J=1,4)/'GEOM','EXTR','EXPO','    '/
      DATA INCASE(87)/'TSCP'/
      DATA ISHAPE(87)/2/
      DATA (INAME(87,J),J=1,4)/'TWO ','SIDE','POWE','    '/
      DATA INCASE(88)/'ERCP'/
      DATA ISHAPE(88)/1/
      DATA (INAME(88,J),J=1,4)/'ERRO','    ','    ','    '/
      DATA INCASE(89)/'ERCP'/
      DATA ISHAPE(89)/1/
      DATA (INAME(89,J),J=1,4)/'SUBB','    ','    ','    '/
      DATA INCASE(90)/'PFCP'/
      DATA ISHAPE(90)/1/
      DATA (INAME(90,J),J=1,4)/'POWE','    ','    ','    '/
CCCCC DATA INCASE(90)/'ERCP'/
CCCCC DATA ISHAPE(90)/1/
CCCCC DATA (INAME(90,J),J=1,4)/'EXPO','POWE','    ','    '/
      DATA INCASE(91)/'FTCP'/
      DATA ISHAPE(91)/1/
      DATA (INAME(91,J),J=1,4)/'FOLD','T   ','    ','    '/
      DATA INCASE(92)/'SNCP'/
      DATA ISHAPE(92)/1/
      DATA (INAME(92,J),J=1,4)/'SKEW','NORM','    ','    '/
      DATA INCASE(93)/'STCP'/
      DATA ISHAPE(93)/2/
      DATA (INAME(93,J),J=1,4)/'SKEW','T   ','    ','    '/
      DATA INCASE(94)/'IBCP'/
      DATA ISHAPE(94)/2/
      DATA (INAME(94,J),J=1,4)/'INVE','BETA','    ','    '/
      DATA INCASE(95)/'GHCP'/
      DATA ISHAPE(95)/2/
      DATA (INAME(95,J),J=1,4)/'G-H ','    ','    ','    '/
      DATA INCASE(96)/'GHCP'/
      DATA ISHAPE(96)/2/
      DATA (INAME(96,J),J=1,4)/'GH  ','    ','    ','    '/
      DATA INCASE(97)/'GHCP'/
      DATA ISHAPE(97)/2/
      DATA (INAME(97,J),J=1,4)/'G   ','H   ','    ','    '/
      DATA INCASE(98)/'GHCP'/
      DATA ISHAPE(98)/2/
      DATA (INAME(98,J),J=1,4)/'G   ','AND ','H   ','    '/
      DATA INCASE(99)/'LZCP'/
      DATA ISHAPE(99)/2/
      DATA (INAME(99,J),J=1,4)/'LOG ','SKEW','NORM','    '/
      DATA INCASE(100)/'GZCP'/
      DATA ISHAPE(100)/1/
      DATA (INAME(100,J),J=1,4)/'GENE','HALF','LOGI','    '/
      DATA INCASE(101)/'TECP'/
      DATA ISHAPE(101)/2/
      DATA (INAME(101,J),J=1,4)/'TRUN','EXPO','    ','    '/
      DATA INCASE(102)/'WRCP'/
      DATA ISHAPE(102)/2/
      DATA (INAME(102,J),J=1,4)/'WARI','    ','    ','    '/
      DATA INCASE(103)/'YUCP'/
      DATA ISHAPE(103)/1/
      DATA (INAME(103,J),J=1,4)/'YULE','    ','    ','    '/
      DATA INCASE(104)/'PZCP'/
      DATA ISHAPE(104)/2/
      DATA (INAME(104,J),J=1,4)/'POLY','    ','    ','    '/
      DATA INCASE(105)/'HYCP'/
      DATA ISHAPE(105)/2/
      DATA (INAME(105,J),J=1,4)/'HYPE','    ','    ','    '/
      DATA INCASE(106)/'HECP'/
      DATA ISHAPE(106)/2/
      DATA (INAME(106,J),J=1,4)/'HERM','    ','    ','    '/
      DATA INCASE(107)/'SDCP'/
      DATA ISHAPE(107)/1/
      DATA (INAME(107,J),J=1,4)/'SKEW','DOUB','EXPO','    '/
      DATA INCASE(108)/'SDCP'/
      DATA ISHAPE(108)/1/
      DATA (INAME(108,J),J=1,4)/'SKEW','LAPL','    ','    '/
      DATA INCASE(109)/'ADCP'/
      DATA ISHAPE(109)/1/
      DATA (INAME(109,J),J=1,4)/'ASYM','DOUB','EXPO','    '/
      DATA INCASE(110)/'ADCP'/
      DATA ISHAPE(110)/1/
      DATA (INAME(110,J),J=1,4)/'ASYM','LAPL','    ','    '/
      DATA INCASE(111)/'MXCP'/
      DATA ISHAPE(111)/1/
      DATA (INAME(111,J),J=1,4)/'MAXW','    ','    ','    '/
      DATA INCASE(112)/'GMCP'/
      DATA ISHAPE(112)/2/
      DATA (INAME(112,J),J=1,4)/'GOMP','MAKE','    ','    '/
      DATA INCASE(113)/'GALP'/
      DATA ISHAPE(113)/2/
      DATA (INAME(113,J),J=1,4)/'GENE','ASYM','DOUB','EXPO'/
      DATA INCASE(114)/'GALP'/
      DATA ISHAPE(114)/2/
      DATA (INAME(114,J),J=1,4)/'GENE','ASYM','LAPL','    '/
      DATA INCASE(115)/'MCCP'/
      DATA ISHAPE(115)/1/
      DATA (INAME(115,J),J=1,4)/'MCLE','    ','    ','    '/
      DATA INCASE(116)/'GMLP'/
      DATA ISHAPE(116)/2/
      DATA (INAME(116,J),J=1,4)/'GENE','MCLE','    ','    '/
      DATA INCASE(117)/'LXCP'/
      DATA ISHAPE(117)/1/
      DATA (INAME(117,J),J=1,4)/'LOG ','LAPL','    ','    '/
      DATA INCASE(118)/'LDCP'/
      DATA ISHAPE(118)/2/
      DATA (INAME(118,J),J=1,4)/'GENE','LAMB','    ','    '/
      DATA INCASE(119)/'BECP'/
      DATA ISHAPE(119)/2/
      DATA (INAME(119,J),J=1,4)/'BETA','    ','    ','    '/
      DATA INCASE(120)/'G5CP'/
      DATA ISHAPE(120)/1/
      DATA (INAME(120,J),J=1,4)/'GENE','LOGI','TYPE','V   '/
      DATA INCASE(121)/'G5CP'/
      DATA ISHAPE(121)/1/
      DATA (INAME(121,J),J=1,4)/'GENE','LOGI','HOSK','    '/
      DATA INCASE(122)/'G5CP'/
      DATA ISHAPE(122)/1/
      DATA (INAME(122,J),J=1,4)/'TYPE','5   ','GENE','LOGI'/
      DATA INCASE(123)/'G5CP'/
      DATA ISHAPE(123)/1/
      DATA (INAME(123,J),J=1,4)/'TYPE','V   ','GENE','LOGI'/
      DATA INCASE(124)/'G5CP'/
      DATA ISHAPE(124)/1/
      DATA (INAME(124,J),J=1,4)/'HOSK','GENE','LOGI','    '/
      DATA INCASE(125)/'G5CP'/
      DATA ISHAPE(125)/1/
      DATA (INAME(125,J),J=1,4)/'GENE','LOGI','TYPE','V   '/
      DATA INCASE(126)/'G5CP'/
      DATA ISHAPE(126)/1/
      DATA (INAME(126,J),J=1,4)/'GENE','LOGI','TYPE','5   '/
      DATA INCASE(127)/'G2CP'/
      DATA ISHAPE(127)/1/
      DATA (INAME(127,J),J=1,4)/'TYPE','2   ','GENE','LOGI'/
      DATA INCASE(128)/'G2CP'/
      DATA ISHAPE(128)/1/
      DATA (INAME(128,J),J=1,4)/'TYPE','II  ','GENE','LOGI'/
      DATA INCASE(129)/'G2CP'/
      DATA ISHAPE(129)/1/
      DATA (INAME(129,J),J=1,4)/'GENE','LOGI','TYPE','2   '/
      DATA INCASE(130)/'G2CP'/
      DATA ISHAPE(130)/1/
      DATA (INAME(130,J),J=1,4)/'GENE','LOGI','TYPE','II  '/
      DATA INCASE(131)/'G3CP'/
      DATA ISHAPE(131)/1/
      DATA (INAME(131,J),J=1,4)/'TYPE','3   ','GENE','LOGI'/
      DATA INCASE(132)/'G3CP'/
      DATA ISHAPE(132)/1/
      DATA (INAME(132,J),J=1,4)/'TYPE','III ','GENE','LOGI'/
      DATA INCASE(133)/'G3CP'/
      DATA ISHAPE(133)/1/
      DATA (INAME(133,J),J=1,4)/'GENE','LOGI','TYPE','3   '/
      DATA INCASE(134)/'G3CP'/
      DATA ISHAPE(134)/1/
      DATA (INAME(134,J),J=1,4)/'GENE','LOGI','TYPE','III '/
      DATA INCASE(135)/'G4CP'/
      DATA ISHAPE(135)/2/
      DATA (INAME(135,J),J=1,4)/'TYPE','4   ','GENE','LOGI'/
      DATA INCASE(136)/'G4CP'/
      DATA ISHAPE(136)/2/
      DATA (INAME(136,J),J=1,4)/'TYPE','IV  ','GENE','LOGI'/
      DATA INCASE(137)/'G4CP'/
      DATA ISHAPE(137)/2/
      DATA (INAME(137,J),J=1,4)/'GENE','LOGI','TYPE','4   '/
      DATA INCASE(138)/'G4CP'/
      DATA ISHAPE(138)/2/
      DATA (INAME(138,J),J=1,4)/'GENE','LOGI','TYPE','IV  '/
      DATA INCASE(139)/'GLCP'/
      DATA ISHAPE(139)/1/
      DATA (INAME(139,J),J=1,4)/'GENE','LOGI','    ','    '/
      DATA INCASE(140)/'LXCP'/
      DATA ISHAPE(140)/1/
      DATA (INAME(140,J),J=1,4)/'LOG ','LAPL','    ','    '/
      DATA INCASE(141)/'AXCP'/
      DATA ISHAPE(141)/2/
      DATA (INAME(141,J),J=1,4)/'ASYM','LOG ','DOUB','EXPO'/
      DATA INCASE(142)/'AXCP'/
      DATA ISHAPE(142)/2/
      DATA (INAME(142,J),J=1,4)/'ASYM','LOG ','LAPL','    '/
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      ICENSO='OFF'
      IREPL='OFF'
      IMETHD='UNIM'
      IF(IPPCCN.EQ.'KAPL')IMETHD='KAPL'
C
      ISUBN1='DPPP'
      ISUBN2='CC  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=3
      NUMSHA=1
C
      ICOLR=0
      ICOLR2=0
C
C               *********************************************
C               **  TREAT THE PROBABILITY PLOT CORRELATION **
C               **  COEFFICIENT (PPCC) PLOT CASE           **
C               *********************************************
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPPPCC--')
        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,ISUBRO
   53   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      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
        IF(IHARG(I1).EQ.'PPCC'.AND.IHARG(I2).EQ.'PLOT')THEN
          ILASTC=I2
          GOTO112
        ELSEIF(IHARG(I1).EQ.'KS  '.AND.IHARG(I2).EQ.'PLOT')THEN
          ILASTC=I2
          GOTO112
        ELSEIF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'SMIR'.AND.
     1         IHARG(I3).EQ.'PLOT')THEN
          ILASTC=I3
          GOTO112
        ELSEIF(IHARG(I1).EQ.'CENS'.AND.
     1    IHARG(I2).EQ.'PPCC'.AND.IHARG(I3).EQ.'PLOT')THEN
          ICENSO='ON'
          ILASTC=I3
          GOTO112
        ELSEIF(IHARG(I1).EQ.'CENS'.AND.
     1    IHARG(I2).EQ.'KS  '.AND.IHARG(I3).EQ.'PLOT')THEN
          ICENSO='ON'
          ILASTC=I3
          GOTO112
        ELSEIF(IHARG(I1).EQ.'CENS'.AND.
     1    IHARG(I2).EQ.'KOLM'.AND.IHARG(I3).EQ.'SMIR'.AND.
     1         IHARG(I4).EQ.'PLOT')THEN
          ICENSO='ON'
          ILASTC=I4
          GOTO112
        ELSEIF(IHARG(I1).EQ.'REPL'.AND.
     1    IHARG(I2).EQ.'PPCC'.AND.IHARG(I3).EQ.'PLOT')THEN
          IREPL='ON'
          ILASTC=I3
          GOTO112
        ELSEIF(IHARG(I1).EQ.'REPL'.AND.
     1    IHARG(I2).EQ.'KS  '.AND.IHARG(I3).EQ.'PLOT')THEN
          IREPL='ON'
          ILASTC=I3
          GOTO112
        ELSEIF(IHARG(I1).EQ.'REPL'.AND.
     1    IHARG(I2).EQ.'KOLM'.AND.IHARG(I3).EQ.'SMIR'.AND.
     1         IHARG(I4).EQ.'PLOT')THEN
          IREPL='ON'
          ILASTC=I4
          GOTO112
        ELSEIF(IHARG(I1).EQ.'REPL'.AND.IHARG(I2).EQ.'CENS'.AND.
     1    IHARG(I3).EQ.'PPCC'.AND.IHARG(I4).EQ.'PLOT')THEN
          IREPL='ON'
          ICENSO='ON'
          ILASTC=I4
          GOTO112
        ELSEIF(IHARG(I1).EQ.'REPL'.AND.IHARG(I2).EQ.'CENS'.AND.
     1    IHARG(I3).EQ.'KS  '.AND.IHARG(I4).EQ.'PLOT')THEN
          IREPL='ON'
          ICENSO='ON'
          ILASTC=I4
          GOTO112
        ELSEIF(IHARG(I1).EQ.'REPL'.AND.IHARG(I2).EQ.'CENS'.AND.
     1    IHARG(I3).EQ.'KOLM'.AND.IHARG(I4).EQ.'SMIR'.AND.
     1         IHARG(I5).EQ.'PLOT')THEN
          IREPL='ON'
          ICENSO='ON'
          ILASTC=I5
          GOTO112
        ELSEIF(IHARG(I1).EQ.'CENS'.AND.IHARG(I2).EQ.'REPL'.AND.
     1    IHARG(I3).EQ.'PPCC'.AND.IHARG(I4).EQ.'PLOT')THEN
          IREPL='ON'
          ICENSO='ON'
          ILASTC=I4
          GOTO112
        ELSEIF(IHARG(I1).EQ.'CENS'.AND.IHARG(I2).EQ.'REPL'.AND.
     1    IHARG(I3).EQ.'KS  '.AND.IHARG(I4).EQ.'PLOT')THEN
          IREPL='ON'
          ICENSO='ON'
          ILASTC=I4
          GOTO112
        ELSEIF(IHARG(I1).EQ.'CENS'.AND.IHARG(I2).EQ.'REPL'.AND.
     1    IHARG(I3).EQ.'KOLM'.AND.IHARG(I4).EQ.'SMIR'.AND.
     1         IHARG(I5).EQ.'PLOT')THEN
          IREPL='ON'
          ICENSO='ON'
          ILASTC=I5
          GOTO112
        END IF
C
  100 CONTINUE
C
C ----------NO MATCH FOUND----------
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  112 CONTINUE
      ICASPL=INCASE(IROW)
      NUMSHA=ISHAPE(IROW)
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      IFOUND='YES'
C
      DO121I=1,MAXOBV
        Y1(I)=0.0
        X1(I)=0.0
        X1UPP(I)=0.0
        XCENS(I)=0.0
        XREPL(I)=0.0
  121 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.'PPCC')
     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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
        WRITE(ICOUT,311)IHLEFT,IHLEF2,ICOLL,NLEFT
  311   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      **
C               **  (NLEFT) FOR THE RESPONSE VARIABLE IS POSITIVE.   **
C               *******************************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,411)
  411   FORMAT('***** ERROR IN PPCC PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,412)IHLEFT,IHLEF2
  412   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS IN ',
     1         'VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,413)
  413   FORMAT('      FOR WHICH A PPCC PLOT WAS TO HAVE BEEN FORMED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,415)MINN2
  415   FORMAT('      MUST BE ',I8,' OR LARGER;  SUCH WAS NOT THE ',
     1         'CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,417)
  417   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
  418     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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,581)
  581   FORMAT('***** INTERNAL ERROR IN DPPPCC')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,582)
  582   FORMAT('      AT BRANCH POINT 481--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,583)
  583   FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH NUMARG HAD ',
     1         'PREVIOUSLY')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,585)NUMARG
  585   FORMAT('      PASSED THIS TEST ONCE ALREADY.  VALUE OF ',
     1         'NUMARG = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,586)
  586   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,417)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO500J=1,NUMARG
        J1=J
        IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')THEN
          ICASEQ='SUBS'
          ILOCQ=J1
          GOTO590
        ELSEIF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')THEN
          ICASEQ='SUBS'
          ILOCQ=J1
          GOTO590
        ELSEIF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')THEN
          ICASEQ='FOR'
          ILOCQ=J1
          GOTO590
        ENDIF
  500 CONTINUE
C
  590 CONTINUE
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
        WRITE(ICOUT,591)NUMARG,ILOCQ,ICASEQ
  591   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C     *********************************************************
C     **  STEP 6--                                           **
C     **  THE FOLLOWING CASES OF MORE THAN ONE ARGUMENT      **
C     **  ARE SUPPORTED:                                     **
C     **  ... PPCC PLOT Y X1           - FREQUENCY DATA      **
C     **  ... PPCC PLOT Y XLOW XUPP    - FREQUENCY DATA      **
C     **  ... PPCC PLOT Y X1           - CENSORED DATA       **
C     **  ... PPCC PLOT Y X1           - REPLICATED DATA     **
C     **  ... PPCC PLOT Y X1 X2        - FREQUENCY DATA WITH **
C     **                                 REPLICATION         **
C     **  ... PPCC PLOT Y XLOW XUPP X1 - FREQUENCY DATA WITH **
C     **                                 REPLICATION         **
C     **  ... PPCC PLOT Y X1 X2        - CENSORED DATA WITH  **
C     **                                 REPLICATION         **
C     *********************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IRESV=1
      IREPV=0
      ICENV=0
      IFREV=0
      IFREV2=0
C
      NUMEXP=1
      IF(ICENSO.EQ.'ON')NUMEXP=NUMEXP+1
      IF(IREPL.EQ.'ON')NUMEXP=NUMEXP+1
C
      IF(NUMV2.EQ.NUMEXP)THEN
        IDATSW='RAW'
        IF(ICENSO.EQ.'ON')ICENV=2
        IF(IREPL.EQ.'ON')THEN
          IF(ICENSO.EQ.'ON')IREPV=3
          IF(ICENSO.EQ.'OFF')IREPV=2
        ENDIF
      ELSEIF(NUMV2.EQ.NUMEXP+1)THEN
        IDATSW='FREQ'
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,611)
  611     FORMAT('***** ERROR IN PPCC PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,613)
  613     FORMAT('      FREQUENCY DATA NOT SUPPORTED FOR CENSORED ',
     1           'CASE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,417)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ELSE
          IFREV=2
          IFREV2=0
          IF(IREPL.EQ.'ON')IREPV=3
        ENDIF
      ELSEIF(NUMV2.EQ.NUMEXP+2)THEN
        IDATSW='FRE2'
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,616)
  616     FORMAT('***** ERROR IN PPCC PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,618)
  618     FORMAT('      FREQUENCY DATA NOT SUPPORTED FOR CENSORED ',
     1           'CASE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,417)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ELSE
          IFREV=2
          IFREV2=3
          IF(IREPL.EQ.'ON')IREPV=4
        ENDIF
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,621)
  621   FORMAT('***** ERROR IN PPCC PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,623)NUMEXP,NUMEXP+1,NUMEXP+2
  623   FORMAT('      EITHER ',I8,', ',I8,' OR ',I8,
     1         ' VARIABLES EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,625)NUMV2
  625   FORMAT('      NUMBER OF VARIABLES ENTERED = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,417)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMV2.GE.2)THEN
        IHRIGH=IHARG(2)
        IHRIG2=IHARG2(2)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLR=IVALUE(ILOCV)
        NRIGHT=IN(ILOCV)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
          WRITE(ICOUT,641)IHRIGH,IHRIG2,ICOLR,NRIGHT
  641     FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(NRIGHT.NE.NLEFT)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,651)
  651     FORMAT('***** ERROR IN PPCC PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,652)
  652     FORMAT('      FOR A ... PPCC PLOT WITH TWO VARIABLES ',
     1           'SPECIFIED,')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,653)
  653     FORMAT('      THE NUMBER OF ELEMENTS IN THE TWO VARIABLES')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,655)
  655     FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,657)IHLEFT,IHLEF2,NLEFT
  657     FORMAT('      THE FIRST  VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,658)IHRIGH,IHRIG2,NRIGHT
  658     FORMAT('      THE SECOND VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,417)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
      IF(NUMV2.GE.3)THEN
        IHRI2H=IHARG(3)
        IHRI22=IHARG2(3)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHRI2H,IHRI22,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLR2=IVALUE(ILOCV)
        NRIGH2=IN(ILOCV)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
          WRITE(ICOUT,661)IHRI2H,IHRI22,ICOLR2,NRIGH2
  661     FORMAT('IHRI2H,IHRI22,ICOLR2,NRIGH2 = ',A4,2X,A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(NRIGH2.NE.NLEFT)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,671)
  671     FORMAT('***** ERROR IN PPCC PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,672)
  672     FORMAT('      FOR A ... PPCC PLOT WITH THREE VARIABLES ',
     1           'SPECIFIED,')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,673)
  673     FORMAT('      THE NUMBER OF ELEMENTS IN THE THREE VARIABLES')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,675)
  675     FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,677)IHLEFT,IHLEF2,NLEFT
  677     FORMAT('      THE FIRST VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,678)IHRI2H,IHRI22,NRIGH2
  678     FORMAT('      THE THIRD VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,417)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
      IF(NUMV2.GE.4)THEN
        IHRI3H=IHARG(4)
        IHRI32=IHARG2(4)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHRI2H,IHRI22,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLR3=IVALUE(ILOCV)
        NRIGH3=IN(ILOCV)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
          WRITE(ICOUT,681)IHRI3H,IHRI32,ICOLR3,NRIGH3
  681     FORMAT('IHRI3H,IHRI32,ICOLR3,NRIGH3 = ',A4,2X,A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(NRIGH3.NE.NLEFT)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,691)
  691     FORMAT('***** ERROR IN PPCC PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,692)
  692     FORMAT('      FOR A ... PPCC PLOT WITH FOUR VARIABLES ',
     1           'SPECIFIED,')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,693)
  693     FORMAT('      THE NUMBER OF ELEMENTS IN THE FOUR VARIABLES')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,695)
  695     FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,697)IHLEFT,IHLEF2,NLEFT
  697     FORMAT('      THE FIRST VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,698)IHRI3H,IHRI32,NRIGH3
  698     FORMAT('      THE FOURTH VARIABLE (',A4,A4,') HAS ',I8,
     1           'ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,417)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,418)(IANS(I),I=1,MIN(80,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'SUBS')THEN
        NIOLD=NLEFT
        CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
        NQ=NIOLD
      ELSEIF(ICASEQ.EQ.'FOR')THEN
        NIOLD=NLEFT
        CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1             NLOCAL,ILOCS,NS,IBUGQ,IERROR)
        NQ=NFOR
      ELSE
        DO715I=1,NLEFT
          ISUB(I)=1
  715   CONTINUE
        NQ=NLEFT
      ENDIF
C
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO760I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO760
        J=J+1
C
C  RESPONSE VARIABLE IN Y1
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)
C
C  CLASS VARIABLE IN X1 FOR FREQUENCY DATA
C
        IF(IFREV.GT.0)THEN
          ICOLT=ICOLR
          IJ=MAXN*(ICOLT-1)+I
          IF(ICOLT.LE.MAXCOL)X1(J)=V(IJ)
          IF(ICOLT.EQ.MAXCP1)X1(J)=PRED(I)
          IF(ICOLT.EQ.MAXCP2)X1(J)=RES(I)
          IF(ICOLT.EQ.MAXCP3)X1(J)=YPLOT(I)
          IF(ICOLT.EQ.MAXCP4)X1(J)=XPLOT(I)
          IF(ICOLT.EQ.MAXCP5)X1(J)=X2PLOT(I)
          IF(ICOLT.EQ.MAXCP6)X1(J)=TAGPLO(I)
        ENDIF
C
C  IF FREQUENCY DATA GIVEN WITH LOWER AND UPPER CLASS LIMITS, THEN
C  UPPER CLASS LIMIT VARIABLE IN X1UPP
C
        IF(IFREV2.GT.0)THEN
          ICOLT=ICOLR2
          IJ=MAXN*(ICOLT-1)+I
          IF(ICOLT.LE.MAXCOL)X1UPP(J)=V(IJ)
          IF(ICOLT.EQ.MAXCP1)X1UPP(J)=PRED(I)
          IF(ICOLT.EQ.MAXCP2)X1UPP(J)=RES(I)
          IF(ICOLT.EQ.MAXCP3)X1UPP(J)=YPLOT(I)
          IF(ICOLT.EQ.MAXCP4)X1UPP(J)=XPLOT(I)
          IF(ICOLT.EQ.MAXCP5)X1UPP(J)=X2PLOT(I)
          IF(ICOLT.EQ.MAXCP6)X1UPP(J)=TAGPLO(I)
        ENDIF
C
C  CENSORING VARIABLE IN XCENS FOR CENSORED DATA
C
        IF(ICENSO.EQ.'ON')THEN
          ICOLT=ICOLR
          IJ=MAXN*(ICOLT-1)+I
          IF(ICOLT.LE.MAXCOL)XCENS(J)=V(IJ)
          IF(ICOLT.EQ.MAXCP1)XCENS(J)=PRED(I)
          IF(ICOLT.EQ.MAXCP2)XCENS(J)=RES(I)
          IF(ICOLT.EQ.MAXCP3)XCENS(J)=YPLOT(I)
          IF(ICOLT.EQ.MAXCP4)XCENS(J)=XPLOT(I)
          IF(ICOLT.EQ.MAXCP5)XCENS(J)=X2PLOT(I)
          IF(ICOLT.EQ.MAXCP6)XCENS(J)=TAGPLO(I)
        ENDIF
C
C  REPLICATION VARIABLE IN XREPL FOR REPLICATED DATA
C
        IF(IREPL.EQ.'ON')THEN
          ICOLT=ICOLR
          IF(IREPV.EQ.3)ICOLT=ICOLR2
          IF(IREPV.EQ.4)ICOLT=ICOLR3
          IJ=MAXN*(ICOLT-1)+I
          IF(ICOLT.LE.MAXCOL)XREPL(J)=V(IJ)
          IF(ICOLT.EQ.MAXCP1)XREPL(J)=PRED(I)
          IF(ICOLT.EQ.MAXCP2)XREPL(J)=RES(I)
          IF(ICOLT.EQ.MAXCP3)XREPL(J)=YPLOT(I)
          IF(ICOLT.EQ.MAXCP4)XREPL(J)=XPLOT(I)
          IF(ICOLT.EQ.MAXCP5)XREPL(J)=X2PLOT(I)
          IF(ICOLT.EQ.MAXCP6)XREPL(J)=TAGPLO(I)
        ENDIF
  760 CONTINUE
C
      NLOCAL=J
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,771)NLOCAL
  771   FORMAT('NLOCAL = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,772)IRESV,IREPV,ICENV,IFREV
  772   FORMAT('IRESV,IREPV,ICENV,IFREV=',4I8)
        CALL DPWRST('XXX','BUG ')
        DO773I=1,NLOCAL
          WRITE(ICOUT,775)I,Y1(I),X1(I),X1UPP(I),XCENS(I),XREPL(I)
  775     FORMAT('I,Y1(I),X1(I),X1UPP(I),XCENS(I),XREPL(I) = ',
     1           I8,5G15.7)
          CALL DPWRST('XXX','BUG ')
  773   CONTINUE
      ENDIF
C
C               ***********************************************
C               **  STEP 8--                                 **
C               **  DETERMINE IF THE ANALYST                 **
C               **  HAS SPECIFIED LIMITS                     **
C               **  FOR THE PARAMETER VALUES                 **
C               **  (THIS WILL DICTATE WHAT WILL APPEAR      **
C               **  ON THE HORIZONTAL AXIS OF THE PPCC PLOT) **
C               ***********************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'LACP')THEN
        IDIST='TUKEY-LAMBDA'
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-2.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA2 '
        ADEF=2.0
        CALL PARCH2(IHP,IHP2,IDIST,
     1              ALAMB2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERRO2)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'TCP')THEN
        IDIST='T'
        IHP='NU1 '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        IDEF=1
        CALL PARCI2(IHP,IHP2,IDIST,NU1,IDEF,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERRO2)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU2 '
        IHP2='    '
        IDEF=50
        CALL PARCI2(IHP,IHP2,IDIST,NU2,IDEF,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERRO2)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'CSCP')THEN
        IDIST='CHI-SQUARED'
        IHP='NU1 '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        IDEF=1
        CALL PARCI2(IHP,IHP2,IDIST,NU1,IDEF,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU2 '
        IHP2='    '
        IDEF=50
        CALL PARCI2(IHP,IHP2,IDIST,NU2,IDEF,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'FCP')THEN
        IDIST='F '
        IHP='NU11'
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        IDEF=1
        CALL PARCI2(IHP,IHP2,IDIST,NU11,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU12'
        IHP2='    '
        IDEF=25
        CALL PARCI2(IHP,IHP2,IDIST,NU12,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU21'
        IHP2='    '
        IDEF=1
        CALL PARCI2(IHP,IHP2,IDIST,NU21,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU22'
        IHP2='    '
        IDEF=25
        CALL PARCI2(IHP,IHP2,IDIST,NU22,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GACP')THEN
        IDIST='GAMMA'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=50.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'BECP')THEN
        IDIST='BETA'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='1   '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'BNCP')THEN
        IDIST='BETA-NORMAL'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='1   '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'BBCP')THEN
        IDIST='BETA-BINOMIAL'
C
        IHP='N   '
        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='ALPH'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='1   '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'PZCP')THEN
        IDIST='POLYA'
C
        IHP='N   '
        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='ALPH'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='1   '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'HECP')THEN
        IDIST='HERMITE'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='1   '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'WECP')THEN
        IDIST='WEIBULL'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=50.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'E2CP')THEN
        IDIST='EXTREME VALUE TYPE 2'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=50.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'PACP')THEN
        IDIST='PARETO'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.2
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              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
          A1=1.0
        ELSE
          A1=VALUE(ILOCP)
        ENDIF
        IF(A1.LE.0.0)A1=1.0
        GOTO899
C
      ENDIF
      IF(ICASPL.EQ.'BICP')THEN
        IDIST='BINOMIAL'
C
        IHP='N   '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NBINOM,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=0.05
        CALL PARCH2(IHP,IHP2,IDIST,P1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        ADEF=0.95
        CALL PARCH2(IHP,IHP2,IDIST,P2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GECP')THEN
        IDIST='GEOMETRIC'
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=0.01
        CALL PARCH2(IHP,IHP2,IDIST,P1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        ADEF=0.99
        CALL PARCH2(IHP,IHP2,IDIST,P2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'POCP')THEN
        IDIST='POISSON'
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA2 '
        ADEF=50.0
        IDIST='POISSON'
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'NBCP')THEN
        IDIST='NEGATIVE BINOMIAL'
        IHP='K1  '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,AK1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='K2  '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,AK2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=0.05
        CALL PARCH2(IHP,IHP2,IDIST,P1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        ADEF=0.95
        CALL PARCH2(IHP,IHP2,IDIST,P2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'IGCP')THEN
        IDIST='INVERSE GAUSSIAN'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='MU1 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,AMU1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='MU2 '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,AMU2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'EECP')THEN
        IDIST='GEOMETRIC EXTREME EXPONENTIAL'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'ERCP')THEN
        IDIST='ERROR'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=1.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=6.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'WACP')THEN
        IHP='GAMM'
        IHP2='A1  '
        IDIST='WALD'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'RICP')THEN
        IDIST='RECIRPOCAL INVERSE GAUSSIAN'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IDIST='RECIPROCAL INVERSE GAUSSIAN'
        IHP='MU1 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,AMU1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='MU2 '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,AMU2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'FLCP')THEN
        IDIST='FATIGUE LIFE'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GPCP')THEN
        IDIST='GENERALIZED PARETO'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-3.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=3.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'TRCP')THEN
        IDIST='TRIANGULAR'
        IHP='C1  '
        IHP2='    '
        ALOWLM=-1.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=-0.99
        CALL PARCH2(IHP,IHP2,IDIST,C1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='C2  '
        IHP2='    '
        ADEF=0.99
        CALL PARCH2(IHP,IHP2,IDIST,C2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'NCCP')THEN
        IDIST='NON-CENTRAL CHI-SQUARED'
        IHP='NU1 '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        IDEF=5
        CALL PARCI2(IHP,IHP2,IDIST,NU1,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU2 '
        IHP2='    '
        IDEF=15
        CALL PARCI2(IHP,IHP2,IDIST,NU2,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA2 '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'NTCP')THEN
        IDIST='NON-CENTRAL T'
        IHP='NU1 '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        IDEF=5
        CALL PARCI2(IHP,IHP2,IDIST,NU1,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU2 '
        IHP2='    '
        IDEF=20
        CALL PARCI2(IHP,IHP2,IDIST,NU2,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA2 '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'VMCP')THEN
        IDIST='VON MISES'
        IHP='B1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,B1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='B2  '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,B2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'PNCP')THEN
        IDIST='POWER NORMAL'
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,P1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        ADEF=50.0
        CALL PARCH2(IHP,IHP2,IDIST,P2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'PLCP')THEN
        IDIST='POWER LOG-NORMAL'
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,P1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        ADEF=20.0
        CALL PARCH2(IHP,IHP2,IDIST,P2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD1 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,SD1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD2 '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,SD2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'ALCP')THEN
        IDIST='ALPHA'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='1   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'LNCP')THEN
        IDIST='LOGNORMAL'
        IHP='SIGM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,SIGMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SIGM'
        IHP2='A2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,SIGMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'PFCP')THEN
        IDIST='POWER FUNCTION'
        IHP='C1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,C1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='C2  '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,C2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'CHCP')THEN
        IHP='NU1 '
        IHP2='    '
        IDIST='CHI'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,ANU1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU2 '
        IHP2='    '
        ADEF=50.0
        CALL PARCH2(IHP,IHP2,IDIST,ANU2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'DLCP')THEN
        IDIST='LOGARITMIC SERIES'
        IHP='THET'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=0.05
        CALL PARCH2(IHP,IHP2,IDIST,THETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='THET'
        IHP2='A2  '
        ADEF=0.95
        CALL PARCH2(IHP,IHP2,IDIST,THETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'YUCP')THEN
        IDIST='YULE'
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.3
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<   '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,P1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,P2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'WRCP')THEN
        IDIST='WARING'
        IHP='C1  '
        IHP2='    '
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<   '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,C1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='C2  '
        IHP2='    '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,C2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='A1  '
        IHP2='    '
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<   '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,A1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='A2  '
        IHP2='    '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,A2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'LLCP')THEN
        IDIST='LOG-LOGISTIC'
        IHP='DELT'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.2
        CALL PARCH2(IHP,IHP2,IDIST,DELTA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='DELT'
        IHP2='A2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,DELTA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GGCP')THEN
        IDIST='GENERALIZED GAMMA'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='C1  '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,C1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IF(C1.EQ.0.0)C1=ADEF
C
        IHP='C2  '
        IHP2='    '
        ADEF=3.0
        CALL PARCH2(IHP,IHP2,IDIST,C2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'WRCP')THEN
        IDIST='WARING'
        IHP='C1  '
        IHP2='    '
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,C1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='C2  '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,C2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='A1  '
        IHP2='    '
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,A1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='A2  '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,A2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'FNCP')THEN
        IDIST='FOLDED NORMAL'
        IHP='MU1 '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-25.0
        CALL PARCH2(IHP,IHP2,IDIST,AMU1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='MU2 '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,AMU2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD1 '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,SD1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD2 '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,SD2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'LGCP')THEN
        IDIST='LOG-GAMMA'
        IHP='GAMM'
        IHP2='A1   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2   '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GOCP')THEN
        IDIST='GOMPERTZ'
        IHP='C1  '
        IHP2='    '
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.1
        CALL PARCH2(IHP,IHP2,IDIST,C1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='C2  '
        IHP2='    '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,C2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='B1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,B1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='B2  '
        IHP2='    '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,B2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GVCP')THEN
        IDIST='GENERALIZED EXTREME VALUE'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-5.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GZCP')THEN
        IDIST='GENERALIZED HALF-LOGISTIC'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=5.0
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=2.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'P2CP')THEN
        IDIST='PARETO TYPE 2'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              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
          A1=1.0
        ELSE
          A1=VALUE(ILOCP)
        ENDIF
        IF(A1.LE.0.0)A1=1.0
C
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'DWCP')THEN
        IDIST='DOUBLE WEIBULL'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'WCCP')THEN
        IDIST='WRAPPED CAUCHY'
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=1.
        LOWLTY='>=  '
        UPPLTY='<   '
        ADEF=0.0
        CALL PARCH2(IHP,IHP2,IDIST,P1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        ADEF=0.99
        CALL PARCH2(IHP,IHP2,IDIST,P2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'EWCP')THEN
        IDIST='EXPONENTIATED WEIBULL'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='THET'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,THETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='THET'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,THETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GLCP')THEN
        IDIST='GENERALIZED LOGISTIC'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.2
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'G2CP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 2'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'G3CP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 3'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=3.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'G4CP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 4'
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,P1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        ADEF=3.0
        CALL PARCH2(IHP,IHP2,IDIST,P2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='Q1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,Q1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='Q2  '
        IHP2='    '
        ADEF=3.0
        CALL PARCH2(IHP,IHP2,IDIST,Q2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'G5CP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 5 (HOSKING)'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=-2.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=2.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'PECP')THEN
        IDIST='EXPONENTIAL POWER'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='1   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'DGCP')THEN
        IDIST='DOUBLE GAMMA'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'FCCP')THEN
        IDIST='FOLDED CAUCHY'
        IHP='LOC1'
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-25.0
        CALL PARCH2(IHP,IHP2,IDIST,AMU1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LOC2'
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,AMU2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SCAL'
        IHP2='E1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,SD1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SCAL'
        IHP2='E2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,SD2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'BRCP')THEN
        IDIST='BRADFORD'
        IHP='BETA'
        IHP2='1   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'RECP')THEN
        IDIST='RECIPROCAL'
        IHP='B1  '
        IHP2='    '
        ALOWLM=1.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.5
        CALL PARCH2(IHP,IHP2,IDIST,B1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='B2  '
        IHP2='    '
        ADEF=20.0
        CALL PARCH2(IHP,IHP2,IDIST,B2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GICP')THEN
        IDIST='INVERTED GAMMA'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'IWCP')THEN
        IDIST='INVERTED WEIBULL'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='GAMM'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,GAMMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'LXCP')THEN
        IDIST='LOG DOUBLE EXPONENTIAL'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'AXCP')THEN
        IDIST='ASYMMETRIC LOG DOUBLE EXPONENTIAL'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='1   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'JUCP')THEN
        IDIST='JOHNSON SU'
        IHP='ALPH'
        IHP2='A11 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-1.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPH11,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A12 '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPH12,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A21 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPH21,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A22 '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPH22,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'JBCP')THEN
        IDIST='JOHNSON SB'
        IHP='ALPH'
        IHP2='A11 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-3.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPH11,ADEF,
     1              ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A12 '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPH12,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A21 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPH21,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A22 '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPH22,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'LDCP')THEN
        IDIST='GENERALIZED TUKEY-LAMBDA'
        IHP='LAMB'
        IHP2='DA31'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-1.0
        CALL PARCH2(IHP,IHP2,IDIST,ALMB31,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA32'
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALMB32,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA41'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-1.0
        CALL PARCH2(IHP,IHP2,IDIST,ALMB41,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA42'
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALMB42,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'TSCP')THEN
        IDIST='TWO-SIDED POWER'
        IHP='THET'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=1.0
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.05
        CALL PARCH2(IHP,IHP2,IDIST,THETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='THET'
        IHP2='A2  '
        ADEF=0.95
        CALL PARCH2(IHP,IHP2,IDIST,THETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='N1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,ANU1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='N2  '
        IHP2='    '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ANU2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'FTCP')THEN
        IDIST='FOLDED T'
        IHP='NU1 '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        IDEF=1
        CALL PARCI2(IHP,IHP2,IDIST,NU1,IDEF,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERRO2)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU2 '
        IHP2='    '
        IDEF=50
        CALL PARCI2(IHP,IHP2,IDIST,NU2,IDEF,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERRO2)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'SNCP')THEN
        IDIST='SKEWED NORMAL'
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=-5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA2 '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'STCP')THEN
        IDIST='SKEWED T'
        IHP='NU1 '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        IDEF=1
        CALL PARCI2(IHP,IHP2,IDIST,NU1,IDEF,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERRO2)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU2 '
        IHP2='    '
        IDEF=25
        CALL PARCI2(IHP,IHP2,IDIST,NU2,IDEF,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERRO2)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=-3.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA2 '
        ADEF=3.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'IBCP')THEN
        IDIST='INVERTED BETA'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='1   '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='2   '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,BETA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
      IF(ICASPL.EQ.'GHCP')THEN
        IDIST='G-H'
        IHP='G1  '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=   '
        UPPLTY='<=  '
        ADEF=-1.0
        CALL PARCH2(IHP,IHP2,IDIST,G1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='G2  '
        IHP2='    '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,G2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='H1  '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>=   '
        UPPLTY='<=  '
        ADEF=0.0
        CALL PARCH2(IHP,IHP2,IDIST,H1,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='H2  '
        IHP2='    '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,H2,ADEF,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'LZCP')THEN
        IDIST='LOG-SKEW-NORMAL'
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=0.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA2 '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD1 '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>    '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,SD1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD2 '
        IHP2='    '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,SD2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'TECP')THEN
        IDIST='TRUNCATED EXPONENTIAL'
C
        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
C
        IHP='M1  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.0
        CALL PARCH2(IHP,IHP2,IDIST,AMU1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='M2  '
        IHP2='    '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,AMU2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD1 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,SD1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD2 '
        IHP2='    '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,SD2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'SDCP')THEN
        IDIST='SKEWED DOUBLE EXPONENTIAL'
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<   '
        ADEF=0.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA2 '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALAMB2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'ADCP')THEN
        IDIST='ASYMMETRIC DOUBLE EXPONENTIAL'
        IF(IADEDF.EQ.'K')THEN
          IHP='K1  '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          ADEF=0.2
          CALL PARCH2(IHP,IHP2,IDIST,AK1,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='K2  '
          IHP2='    '
          ADEF=10.0
          CALL PARCH2(IHP,IHP2,IDIST,AK2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO899
        ELSE
          IHP='MU1 '
          IHP2='    '
          ALOWLM=CPUMIN
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          ADEF=-5.0
          CALL PARCH2(IHP,IHP2,IDIST,AMU1,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='MU2 '
          IHP2='    '
          ADEF=5.0
          CALL PARCH2(IHP,IHP2,IDIST,AMU2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO899
        ENDIF
      ENDIF
C
      IF(ICASPL.EQ.'MXCP')THEN
        IDIST='MAXWELL'
        IHP='SIGM'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,SIGMA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SIGM'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,SIGMA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'GMCP')THEN
        IF(IMAKDF.NE.'REPA')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,810)
 810      FORMAT('***** ERROR IN PPCC/KS PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,811)
 811      FORMAT('      FOR GOMPERTZ-MAKEHAM, THE PPCC/KS PLOT IS ONLY')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,813)
 813      FORMAT('      ALLOWED FOR THE "REPARAMETERIZATION MEEKER" ',
     1           'DEFINTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,815)
 815      FORMAT('      ENTER THE COMMAND:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,817)
 817      FORMAT('           HELP MAKPDF')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,819)
 819      FORMAT('       FOR DETAILS.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        IDIST='GOMPERTZ-MAKEHAM'
        IHP='ETA1'
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,ETA1,ADEF,ALOWLM,AUPPLM,LOWLTY,
     1              UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ETA2'
        IHP2='    '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ETA2,ADEF,ALOWLM,AUPPLM,LOWLTY,
     1              UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ZETA'
        IHP2='1   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.1
        CALL PARCH2(IHP,IHP2,IDIST,ZETA1,ADEF,ALOWLM,AUPPLM,LOWLTY,
     1              UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ZETA'
        IHP2='2   '
        ADEF=5.0
        CALL PARCH2(IHP,IHP2,IDIST,ZETA2,ADEF,ALOWLM,AUPPLM,LOWLTY,
     1              UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'GALP')THEN
        IDIST='GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL'
        IF(IADEDF.EQ.'K')THEN
          IHP='K1  '
          IHP2='    '
          ALOWLM=0.2
          AUPPLM=CPUMAX
          LOWLTY='>=  '
          UPPLTY='<   '
          ADEF=0.2
          CALL PARCH2(IHP,IHP2,IDIST,AK1,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='K2  '
          IHP2='    '
          ADEF=5.0
          CALL PARCH2(IHP,IHP2,IDIST,AK2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='TAU1'
          IHP2='    '
          ALOWLM=0.2
          AUPPLM=CPUMAX
          LOWLTY='>=  '
          UPPLTY='<   '
          ADEF=0.2
          CALL PARCH2(IHP,IHP2,IDIST,TAU1,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='TAU2'
          IHP2='    '
          ADEF=5.0
          CALL PARCH2(IHP,IHP2,IDIST,TAU2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO899
        ELSE
          IHP='MU1 '
          IHP2='    '
          ALOWLM=CPUMIN
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          ADEF=-5.0
          CALL PARCH2(IHP,IHP2,IDIST,AMU1,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='MU2 '
          IHP2='    '
          ADEF=5.0
          CALL PARCH2(IHP,IHP2,IDIST,AMU2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO899
        ENDIF
      ENDIF
C
      IF(ICASPL.EQ.'MCCP')THEN
        IDIST='MCLEISH'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=15.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'GMLP')THEN
        IDIST='GENERALIZED MCLEISH'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A2  '
        ADEF=10.0
        CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='A1  '
        IHP2='    '
        ALOWLM=-1.0
        AUPPLM=1.0
        LOWLTY='>    '
        UPPLTY='<   '
        ADEF=-0.8
        CALL PARCH2(IHP,IHP2,IDIST,A1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='A2  '
        IHP2='    '
        ADEF=0.8
        CALL PARCH2(IHP,IHP2,IDIST,A2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO899
      ENDIF
C
      IF(ICASPL.EQ.'HYCP')THEN
        IF(ICOM2.EQ.'BOLI')THEN
          IDIST='HYPERBOLIC'
          IHP='ALPH'
          IHP2='A1  '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          ADEF=0.2
          CALL PARCH2(IHP,IHP2,IDIST,ALPHA1,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='ALPH'
          IHP2='A2  '
          ADEF=10.0
          CALL PARCH2(IHP,IHP2,IDIST,ALPHA2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='XI1 '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          ADEF=0.2
          CALL PARCH2(IHP,IHP2,IDIST,XI1,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='XI2 '
          IHP2='    '
          ADEF=10.0
          CALL PARCH2(IHP,IHP2,IDIST,XI2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO899
        ELSE
          IDIST='HYPERGEOMETRIC'
CCCCC     IHP='MU1 '
CCCCC     IHP2='    '
CCCCC     ALOWLM=CPUMIN
CCCCC     AUPPLM=CPUMAX
CCCCC     LOWLTY='>   '
CCCCC     UPPLTY='<   '
CCCCC     ADEF=-5.0
CCCCC     CALL PARCH2(IHP,IHP2,IDIST,AMU1,ADEF,ALOWLM,AUPPLM,
CCCCC1                LOWLTY,UPPLTY,
CCCCC1                ISUBN1,ISUBN2,IERROR)
CCCCC     IF(IERROR.EQ.'YES')GOTO9000
C
CCCCC     IHP='MU2 '
CCCCC     IHP2='    '
CCCCC     ADEF=5.0
CCCCC     CALL PARCH2(IHP,IHP2,IDIST,AMU2,ADEF,ALOWLM,AUPPLM,
CCCCC1                LOWLTY,UPPLTY,
CCCCC1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO899
        ENDIF
      ENDIF
C
  899 CONTINUE
C
      IF(ICASP2.EQ.'KS  ')THEN
C
C  LOCATION AND SCALE FOR KS PLOT
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=CPUMIN
        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
          KSSCAL=CPUMIN
        ELSE
          KSSCAL=VALUE(ILOCP)
        ENDIF
        IF(KSSCAL.LE.0.0)KSSCAL=CPUMIN
      ENDIF
C
      IHP='MINS'
      IHP2='IZE '
      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
        MINSIZ=5
      ELSE
        MINSIZ=INT(VALUE(ILOCP)+0.5)
        IF(MINSIZ.LE.0)MINSIZ=5
      ENDIF
C
      IF(NUMSHA.GT.1 .AND. IREPL.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,901)
  901   FORMAT('***** WARNING FOR PPCC PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,903)
  903   FORMAT('      REPLICATION NOT SUPPORTED FOR CASES WITH MORE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,905)
  905   FORMAT('      THAN ONE SHAPE PARAMETER.  THE REPLICATION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,907)
  907   FORMAT('      VARIABLE WILL BE IGNORED.')
        CALL DPWRST('XXX','BUG ')
        IREPL='OFF'
      ENDIF
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
C               **  RESET THE VECTOR D(.) TO ALL ONES.             **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PPCC')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,911)
  911   FORMAT('***** FROM THE MIDDLE  OF DPPPCC--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,912)ICASPL,NUMV2,IDATSW,NPLOTP,NPLOTV
  912   FORMAT('ICASPL,NUMV2,IDATSW,NPLOTP,NPLOTV = ',A4,I8,2X,A4,2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,913)ALAMB1,ALAMB2,NU1,NU2
  913   FORMAT('ALAMB1,ALAMB2,NU1,NU2 = ',2E15.7,2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,914)GAMMA1,GAMMA2,P1,P2
  914   FORMAT('GAMMA1,GAMMA2,P1,P2 = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,921)NLOCAL,NUMSHA
  921   FORMAT('NLOCAL,NUMSHA = ',2I8)
        CALL DPWRST('XXX','BUG ')
        IF(NLOCAL.GE.1)THEN
          DO922I=1,NLOCAL
            WRITE(ICOUT,923)I,Y1(I),X1(I)
  923       FORMAT('I,Y1(I),X1(I) = ',I8,2F12.5)
            CALL DPWRST('XXX','BUG ')
  922     CONTINUE
  929   ENDIF
        IF(NPLOTP.GT.0)THEN
          DO935I=1,NPLOTP
            WRITE(ICOUT,936)I,Y(I),X(I),D(I)
  936       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
            CALL DPWRST('XXX','BUG ')
  935     CONTINUE
        ENDIF
      ENDIF
C
      CALL DPPPC2(Y1,X1,X1UPP,XCENS,XREPL,XREPDS,NLOCAL,
     1ICASPL,ICASP2,IDATSW,
     1ALAMB1,ALAMB2,NU1,NU2,GAMMA1,GAMMA2,P1,P2,MINMAX,
     1SD,SD1,SD2,C1,C2,ANU1,ANU2,B1,B2,DELTA1,DELTA2,ALPHA1,ALPHA2,
     1BETA1,BETA2,THETA1,THETA2,NBINOM,
     1ALMB11,ALMB12,ALMB21,ALMB22,ALMB31,ALMB32,ALMB41,ALMB42,
     1ALPH11,ALPH12,ALPH21,ALPH22,
     1NU11,NU12,NU21,NU22,
     1AMU1,AMU2,G1,G2,H1,H2,AK1,AK2,
     1A1,A2,NU,X0,SIGMA1,SIGMA2,
     1ETA1,ETA2,ZETA1,ZETA2,
     1TAU1,TAU2,Q1,Q2,
     1DISPAR,DISPA2,DISPA3,CORR,CORR2,NUMSHA,
     1XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,XTEMP6,XTEMP7,XTEMP8,X1UTMP,
     1XTEMP9,IHSTCW,
     1X2TEMP,Y2TEMP,D2TEMP,
     1IPPCCC,IPPCFO,KSLOC,KSSCAL,
     1Y3,XLOW,XHIGH,MINSIZ,
     1IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1ILGADF,ISKNDF,IGLDDF,
     1IPPCDP,IPPCAP,IPPCAO,IMETHD,ICENSO,IREPL,
     1Y,X,X3D,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
CCCCC THE FOLLOWING ENTIRE SECTION WAS ADDED                 MAY 1993
CCCCC TO ALLOW AUTO-COMPUTATION OF THE PROB. PLOT CORR. COEF MAY 1993
CCCCC THE FOLLOWING SECTION WAS SIMPLIFED      DECEMBER 1993
C
C               ***************************************
C               **  STEP 61--                        **
C               **  COMPUTE PROB. PLOT CORR. COEF    **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
CCCCC IF ALTERNATE CORRELATION MEASURE USED, THEN SHAPE WILL
CCCCC BE STANDARD CORRELATION, SHAPE2 WILL BE ALTERNATIVE MEASURE
C
      IF(ICASP2.EQ.'KS  ')THEN
        CALL MINIM(Y,NPLOTP,IWRITE,AKSMIN,IBUGG3,IERROR)
        IF(NUMSHA.LE.1)THEN
          DO6050I=1,NPLOTP
            I2=I
            IF(Y(I).EQ.AKSMIN)GOTO6059
 6050     CONTINUE
 6059     CONTINUE
          SHAPE=X(I2)
          A0=XTEMP3(I2)
          A1=XTEMP4(I2)
        ELSE
          DO6060I=1,NPLOTP
            I2=I
            IF(Y(I).EQ.AKSMIN)GOTO6069
 6060     CONTINUE
 6069     CONTINUE
          IF(IPPCFO.EQ.'TRAC')THEN
            SHAPE2=X(I2)
            SHAPE1=X3D(I2)
          ELSE
            SHAPE1=X(I2)
            SHAPE2=X3D(I2)
          ENDIF
          A0=XTEMP3(I2)
          A1=XTEMP4(I2)
        ENDIF
      ELSEIF(IPPCCC.EQ.'LINE')THEN
        CALL MAXIM(Y,NPLOTP,IWRITE,PPCCMX,IBUGG3,IERROR)
        IF(NUMSHA.LE.1)THEN
          DO6000I=1,NPLOTP
            I2=I
            IF(Y(I).EQ.PPCCMX)GOTO6009
 6000     CONTINUE
 6009     CONTINUE
          SHAPE=X(I2)
        ELSE
          DO6010I=1,NPLOTP
            I2=I
            IF(Y(I).EQ.PPCCMX)GOTO6019
 6010     CONTINUE
 6019     CONTINUE
          IF(IPPCFO.EQ.'TRAC')THEN
            SHAPE2=X(I2)
            SHAPE1=X3D(I2)
          ELSE
            SHAPE1=X(I2)
            SHAPE2=X3D(I2)
          ENDIF
        ENDIF
      ELSE
        IF(NUMSHA.LE.1)THEN
          PPCCMX=-99.0
          PPCCM2=-99.0
          DO6100I=1,NPLOTP
            IF(D(I).EQ.1.0 .AND. Y(I).GT.PPCCMX)PPCCMX=Y(I)
            IF(D(I).EQ.2.0 .AND. Y(I).GT.PPCCM2)PPCCM2=Y(I)
 6100     CONTINUE
          DO6120I=1,NPLOTP
            I2=I
            IF(D(I).EQ.1.0 .AND. Y(I).EQ.PPCCMX)GOTO6129
 6120     CONTINUE
 6129     CONTINUE
          SHAPE=X(I2)
C
          DO6130I=1,NPLOTP
            I2=I
            IF(D(I).EQ.2.0 .AND. Y(I).EQ.PPCCM2)GOTO6139
 6130     CONTINUE
 6139     CONTINUE
          SHAPE2=X(I2)
        ELSE
          PPCCMX=-99.0
          DO6300I=1,NPLOTP
            IF(Y(I).GT.PPCCMX)PPCCMX=Y(I)
 6300     CONTINUE
          DO6310I=1,NPLOTP
            I2=I
            IF(Y(I).EQ.PPCCMX)GOTO6319
 6310     CONTINUE
 6319     CONTINUE
          IF(IPPCFO.EQ.'TRAC')THEN
            SHAPE2=X(I2)
            SHAPE1=X3D(I2)
          ELSE
            SHAPE1=X(I2)
            SHAPE2=X3D(I2)
          ENDIF
        ENDIF
      ENDIF
C
      ISUBN0='PPCC'
C
      IF(ICASP2.EQ.'PPCC')THEN
        IH='MAXP'
        IH2='PCC '
        VALUE0=PPCCMX
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1              IANS,IWIDTH,IBUGG3,IERROR)
      ELSE
        IH='MINK'
        IH2='S   '
        VALUE0=AKSMIN
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1              IANS,IWIDTH,IBUGG3,IERROR)
        IH='KSLO'
        IH2='CS  '
        VALUE0=A0
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1              IANS,IWIDTH,IBUGG3,IERROR)
        IH='KSSC'
        IH2='ALES'
        VALUE0=A1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1              IANS,IWIDTH,IBUGG3,IERROR)
      ENDIF
C
      IF(NUMSHA.LE.1)THEN
        IH='SHAP'
        IH2='E   '
        VALUE0=SHAPE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGG3,IERROR)
        IF(IPPCCC.NE.'LINE')THEN
          IH='SHAP'
          IH2='E2  '
          VALUE0=SHAPE2
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGG3,IERROR)
        ENDIF
      ELSE
        IH='SHAP'
        IH2='E1  '
        VALUE0=SHAPE1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGG3,IERROR)
        IH='SHAP'
        IH2='E2  '
        VALUE0=SHAPE2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGG3,IERROR)
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PPCC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPPCC--')
      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)ALAMB1,ALAMB2,NU1,NU2
 9014 FORMAT('ALAMB1,ALAMB2,NU1,NU2 = ',2E15.7,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)GAMMA1,GAMMA2,P1,P2
 9015 FORMAT('GAMMA1,GAMMA2,P1,P2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NLOCAL
 9021 FORMAT('NLOCAL = ',I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 4 LINES WERE ADDED   MAY 1993
      WRITE(ICOUT,9016)MINMAX
 9016 FORMAT('MINMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)PPCCMX,SHAPE
 9017 FORMAT('PPCCMX,SHAPE = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(NLOCAL.LE.0)GOTO9029
      DO9022I=1,NLOCAL
      WRITE(ICOUT,9023)I,Y1(I),X1(I)
 9023 FORMAT('I,Y1(I),X1(I) = ',I8,2F12.5)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9029 CONTINUE
      IF(NPLOTP.LE.0)GOTO9090
      DO9032I=1,NPLOTP
      WRITE(ICOUT,9033)I,Y(I),X(I),D(I)
 9033 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPPC2(Y1,X1,X1UPP,XCENS,XREPL,XREPDS,N1,
     1ICASPL,ICASP2,IDATSW,
     1ALAMB1,ALAMB2,NU1,NU2,GAMMA1,GAMMA2,P1,P2,MINMAX,
     1SD,SD1,SD2,C1,C2,ANU1,ANU2,B1,B2,DELTA1,DELTA2,ALPHA1,ALPHA2,
     1BETA1,BETA2,THETA1,THETA2,NBINOM,
     1ALMB11,ALMB12,ALMB21,ALMB22,ALMB31,ALMB32,ALMB41,ALMB42,
     1ALPH11,ALPH12,ALPH21,ALPH22,
     1NU11,NU12,NU21,NU22,
     1AMU1,AMU2,G1,G2,H1,H2,AK1,AK2,
     1A1,A2,NU,X0,SIGMA1,SIGMA2,
     1ETA1,ETA2,ZETA1,ZETA2,
     1TAU1,TAU2,Q1,Q2,
     1DISPAR,DISPA2,DISPA3,CORRV,CORRZ,NUMSHA,
     1XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,XTEMP6,XTEMP7,XTEMP8,X1UTMP,
     1XTEMP9,IHSTCW,
     1X2TEMP,Y2TEMP,D2TEMP,
     1IPPCCC,IPPCFO,KSLOC,KSSCAL,
     1Y3,XLOW,XHIGH,MINSIZ,
     1IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1ILGADF,ISKNDF,IGLDDF,
     1IPPCDP,IPPCAP,IPPCAO,IMETHD,ICENSO,IREPL,
     1Y2,X2,X3D2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
CCCCC THE MINMAX ARGUMENT WAS ADDED ABOVE    MAY 1993
CCCCC PARAMETERS FOR NEW DISTRIBUTION        APRIL 1995
CCCCC PARAMETERS FOR NEW DISTRIBUTION        DECEMBER 1995
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              THE PROBABILITY PLOT CORRELATION COEFFICIENT TRACE
C              FOR SOME DISTRIBUTIONAL FAMILY.
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--82/7
C     ORIGINAL VERSION--FEBRUARY  1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MAY       1990.  IG, WALD, RIG, FL (SAUNDERS)
C     UPDATED         --APRIL     1992.  AN TO AN1
C     UPDATED         --DECEMBER  1993.  MINMAX FOR EV1/EV2/WEIB DIST.
C     UPDATED         --MAY       1993.  EXTREME VALUE (GENERAL)
C     UPDATED         --MAY       1993.  GENERALIZED PARETO
C     UPDATED         --APRIL     1995.  NEW DISTRIBUTIONS
C     UPDATED         --OCTOBER   1995.  LOG GAMMA DISTRIBUTION
C     UPDATED         --OCTOBER   1995.  5 DISTRIBUTIONS
C     UPDATED         --DECEMBER  1995.  GENERALIZED LOGISTIC
C     UPDATED         --JANUARY   1996.  DOUBLE GAMMA
C     UPDATED         --FEBRUARY  1996.  BRADFORD
C     UPDATED         --MAY       1996.  RECIPROCAL
C     UPDATED         --JANUARY   1998.  BINOMIAL
C     UPDATED         --JANUARY   1998.  NEGATIVE BINOMIAL
C     UPDATED         --JANUARY   1998.  LOGARITHMIC SERIES
C     UPDATED         --FEBRUARY  1998.  CHECK FOR 0 COUNT FREQUENCIES
C                                        FOR BINNED DATA
C     UPDATED         --AUGUST    2001.  SUPPORT FOR A NUMBER OF
C                                        2 SHAPE PARAMETER
C                                        DISTRIBUTIONS.
C     UPDATED         --SEPTEMBER 2001.  SUPPORT FOR 4 ADDITIONAL
C                                        DISTRIBUTIONS
C     UPDATED         --NOVEMBER  2001.  GEE DISTRIBUTION
C     UPDATED         --NOVEMBER  2001.  ALPHA DISTRIBUTION
C     UPDATED         --NOVEMBER  2001.  POWER LOGNORMAL SUPPORT
C                                        2 SHAPE PARAMETERS
C     UPDATED         --MAY       2003.  ERROR (=SUBBOTIN=EXPO POWER)
C     UPDATED         --NOVEMBER  2003.  FOLDED T
C     UPDATED         --DECEMBER  2003.  SKEW NORMAL, SKEW T,
C                                        INVERTED BETA,
C                                        G-AND-H
C     UPDATED         --MARCH     2004.  LOG SKEW NORMAL,
C                                        NON-CENTRAL T
C                                        NON-CENTRAL CHI-SQUARE
C     UPDATED         --MARCH     2004.  FOR 2 SHAPE PARAMETER CASE,
C                                        WRITE COORDINATES TO FILE
C     UPDATED         --APRIL     2004.  HERMITE
C     UPDATED         --MAY       2004.  SUPPORT DIFFERENT CORRELATION
C                                        MEASURES
C     UPDATED         --MAY       2004.  SUPPORT FOR KS PLOT
C     UPDATED         --MAY       2004.  SUPPORT FOR GENERATING 2-SHAPE
C                                        PARAMETER CASE AS MULTI-TRACE
C                                        PLOT
C     UPDATED         --JUNE      2004.  SKEW DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004.  ASYMMETRIC DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004.  MAXWELL
C     UPDATED         --JULY      2004.  GOMPERTZ-MAKEHAM
C     UPDATED         --AUGUST    2004.  GENERALIZED ASYMMETRIC
C                                        DOUBLE EXPONENTIAL
C     UPDATED         --AUGUST    2004.  MCLEISH
C     UPDATED         --SEPTEMBER 2004. GENERALIZED MCLEISH
C     UPDATED         --SEPTEMBER 2004. HYPERBOLIC (NOT WORKING YET)
C     UPDATED         --SEPTEMBER 2004. SUPPORT FOR FOLLOWING OPTIONS:
C                                       1) SET PPCC PLOT DATA POINTS
C                                       2) SET PPCC PLOT AXIS POINTS
C                                       3) SET PPCC PLOT AXIS ORDER
C     UPDATED         --OCTOBER   2004. MODIFY HOW "ALOC"
C                                       PARAMETER HANDLED
C                                       FOR PARETO DISTRIBUTION
C     UPDATED         --OCTOBER   2004. WRITE LOCATION AND SCALE
C                                       PARAMETERS TO FILE
C     UPDATED         --OCTOBER   2004. FOR BINNED CASE, USE CHI-SQUARE
C                                       RATHER THAN K-S TEST
C     UPDATED         --OCTOBER   2004. FOR UNBINNED DATA, SUPPORT
C                                       CENSORING
C     UPDATED         --OCTOBER   2004. WRITE : PPCC, LOC, SCALE,
C                                               SHAPE1, SHAPE2 TO
C                                               DPST2F.DAT
C     UPDATED         --DECEMBER  2004. IF USER HAS NOT SET KSLOC
C                                       AND KSSCAL, SET THEM TO 0 AND
C                                       1 FOR PARETO DISTRIBUTIONS
C     UPDATED         --APRIL     2005. FOR ONE SHAPE PARAMETER CASE,
C                                       ADD SUPPORT FOR REPLICATION
C                                       CASE (GROUPS, AS OPPOSSED TO
C                                       BINS, IN THE DATA)
C     UPDATED         --APRIL     2005. FOR BINNED DATA, SUPPORT CASE
C                                       WHERE BINS GIVEN AS LOWER AND
C                                       UPPER LIMITS (INSTEAD OF
C                                       JUST THE MID-POINT).  THIS
C                                       ALLOWS UNEQUALLY SPACED BINS.
C     UPDATED         --JULY      2005. CALL LIST TO LGAPPF AND SNPPF
C                                       CALL LIST TO DP1KS2
C                                       CALL LIST TO DPCHS2
C     UPDATED         --FEBRUARY  2006. GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006. FMKL PARAMETERIZATION OF
C                                       GENERALIZED TUKEY LAMBDA
C     UPDATED         --MARCH     2006. SUPPORT FOR DIFFERENT DEFAULT
C                                       BINNING ALGORITHMS
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 LAPLACE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICASP2
      CHARACTER*4 ICASP3
      CHARACTER*4 IPPCCC
      CHARACTER*4 IPPCFO
      CHARACTER*4 IPPCAO
      CHARACTER*4 IADEDF
      CHARACTER*4 IGEPDF
      CHARACTER*4 IMAKDF
      CHARACTER*4 IBEIDF
      CHARACTER*4 ILGADF
      CHARACTER*4 ISKNDF
      CHARACTER*4 IGLDDF
      CHARACTER*4 IMETHD
      CHARACTER*4 ICENSO
      CHARACTER*4 IREPL
      CHARACTER*4 IWRITE
      CHARACTER*4 IDATSW
      CHARACTER*4 IDATS2
      CHARACTER*4 IRHSTG
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IHSTCW
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 IFOUND
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
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*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*4 ISUBN0
C
C---------------------------------------------------------------------
C
      INTEGER IPPCDP
      INTEGER IPPCAP(2)
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
      DIMENSION X1UPP(*)
      DIMENSION XCENS(*)
      DIMENSION XREPL(*)
      DIMENSION XREPDS(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION X3D2(*)
      DIMENSION D2(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
      DIMENSION XTEMP4(*)
      DIMENSION XTEMP5(*)
      DIMENSION XTEMP6(*)
      DIMENSION XTEMP7(*)
      DIMENSION XTEMP8(*)
      DIMENSION X1UTMP(*)
      DIMENSION XTEMP9(*)
      DIMENSION X2TEMP(*)
      DIMENSION Y2TEMP(*)
      DIMENSION D2TEMP(*)
      DIMENSION Y3(*)
      DIMENSION XLOW(*)
      DIMENSION XHIGH(*)
C
CCCCC THE FOLLOWING 2 LINES WERE CHANGED     DECEMBER 1993
CCCCC DIMENSION DISPAR(100)
CCCCC DIMENSION DISPAR(100)
      DIMENSION DISPAR(*)
      DIMENSION DISPA2(*)
      DIMENSION DISPA3(*)
      DIMENSION CORRV(*)
      DIMENSION CORRZ(*)
C
      REAL KSLOC
      REAL KSSCAL
      DOUBLE PRECISION DP
      DOUBLE PRECISION DPPF
C
      DOUBLE PRECISION QUAGLO
      DOUBLE PRECISION XPAR(3)
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 PI / 3.1415926535 /
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPPP'
      ISUBN2='C2  '
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPPP'
      ISUBN2='C2  '
      IERROR='NO'
      ICAPSW='OFF'
      ICAPTY='NULL'
C
      IF(ICASPL.EQ.'PACP' .OR. ICASPL.EQ.'P2CP')THEN
        IF(KSLOC.EQ.CPUMIN .AND.  KSSCAL.EQ.CPUMIN)THEN
          KSLOC=0.0
          KSSCAL=1.0
        ENDIF
      ENDIF
      AN1=0.0
C
      IFLAG=0
      IF(ICASPL.EQ.'GECP')IFLAG=1
      IF(ICASPL.EQ.'BICP')IFLAG=1
      IF(ICASPL.EQ.'POCP')IFLAG=1
      IF(ICASPL.EQ.'NBCP')IFLAG=1
      IF(ICASPL.EQ.'HYCP')IFLAG=1
      IF(ICASPL.EQ.'DLCP')IFLAG=1
      IF(ICASPL.EQ.'HECP')IFLAG=1
      IF(ICASPL.EQ.'YUCP')IFLAG=1
      IF(ICASPL.EQ.'WRCP')IFLAG=1
      IF(ICASPL.EQ.'BBCP')IFLAG=1
      IF(ICASPL.EQ.'PZCP')IFLAG=1
      IF(ICASPL.EQ.'BZCP')IFLAG=1
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PPC2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11)
   11   FORMAT('***** AT THE BEGINNING OF DPPPC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,12)ICASPL,IDATSW,N1,NPLOTV
   12   FORMAT('ICASPL,IDATSW,N1,NPLOTV = ',A4,2X,A4,2X,I8,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13)ALAMB1,ALAMB2,NU1,NU2
   13   FORMAT('ALAMB1,ALAMB2,NU1,NU2 = ',2E15.7,2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,14)GAMMA1,GAMMA2,P1,P2
   14   FORMAT('GAMMA1,GAMMA2,P1,P2 = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,15)MINMAX
   15   FORMAT('MINMAX = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(N1.GT.0)THEN
          DO25I=1,MIN(N1,200)
            WRITE(ICOUT,26)I,Y1(I),X1(I),X1UPP(I),XCENS(I),XREPL(I)
   26       FORMAT('I,Y1(I),X1(I),X1UPP(I),XCENS(I),XREPL(I) = ',
     1             I8,5E12.5)
            CALL DPWRST('XXX','BUG ')
   25     CONTINUE
        ENDIF
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N1.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)
   46   FORMAT('***** ERROR IN PPCC PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)
   47   FORMAT('      THE NUMBER OF OBSERVATIONS WAS LESS THAN OR ',
     1         'EQUAL TO 1.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IDATSW.EQ.'RAW')THEN
        HOLD=Y1(1)
        DO60I=1,N1
          IF(Y1(I).NE.HOLD)GOTO69
   60   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,61)
   61   FORMAT('***** ERROR IN PPCC PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,62)
   62   FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,63)HOLD
   63   FORMAT('      ARE IDENTICALLY EQUAL TO ',G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
   69   CONTINUE
      ELSEIF(IDATSW.EQ.'FREQ')THEN
        CALL DISTIN(X1,N1,IWRITE,XTEMP6,NDIST,IBUGG3,IERROR)
        IF(N1.NE.NDIST)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,71)
   71     FORMAT('***** ERROR IN PPCC PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,72)
   72     FORMAT('      THE CLASS VARIABLE ELEMENTS ARE NOT ALL ',
     1           'DISTINCT.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        DO73I=1,N1-1
          IF(X1(I).GE.X1(I+1))THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,71)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,74)I
   74       FORMAT('      ELEMENT ',I8,' OF THE BIN MID-POINTS ',
     1             'VARIABLE IS')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,75)I+1
   75       FORMAT('      LARGER THAN ELEMENT ',I8)
            WRITE(ICOUT,999)
            IERROR='YES'
            GOTO9000
          ENDIF
   73   CONTINUE
      ELSEIF(IDATSW.EQ.'FRE2')THEN
        CALL DISTIN(X1,N1,IWRITE,XTEMP6,NDIST,IBUGG3,IERROR)
        IF(N1.NE.NDIST)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,71)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,72)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        CALL DISTIN(X1UPP,N1,IWRITE,XTEMP6,NDIST,IBUGG3,IERROR)
        IF(N1.NE.NDIST)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,71)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,72)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        DO81I=1,N1
          IF(X1(I).GE.X1UPP(I))THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,86)
   86       FORMAT('FOR CLASS ',I8,', THE LOWER CLASS LIMIT IS ',
     1             'GREATER THAN THE UPPER CLASS LIMIT.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
   81   CONTINUE
        DO91I=1,N1-1
          IF(X1(I).GE.X1(I+1))THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,71)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,92)I
   92       FORMAT('      ELEMENT ',I8,' OF THE BIN LOWER CLASS ',
     1             'LIMITS VARIABLE IS')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,93)I+1
   93       FORMAT('      LARGER THAN ELEMENT ',I8)
            WRITE(ICOUT,999)
            IERROR='YES'
            GOTO9000
          ENDIF
   91   CONTINUE
        DO96I=1,N1-1
          IF(X1UPP(I).GE.X1UPP(I+1))THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,71)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,97)I
   97       FORMAT('      ELEMENT ',I8,' OF THE BIN UPPER CLASS ',
     1             'LIMITS VARIABLE IS')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,98)I+1
   98       FORMAT('      LARGER THAN ELEMENT ',I8)
            WRITE(ICOUT,999)
            IERROR='YES'
            GOTO9000
          ENDIF
   96   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 1B-                              **
C               **  IF SET PPCC DATA POINTS COMMAND WAS   **
C               **  ENTERED, THIN DATA SET BY COMPUTING   **
C               **  PERCENTILES OF THE DATA.  CURRENTLY   **
C               **  ONLY SUPPORTED FOR UNBINNED DATA.     **
C               ********************************************

      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PPC2')THEN
        WRITE(ICOUT,111)IPPCDP,IDATSW
  111   FORMAT('      IPPCDP, IDATSW = ',I8,1X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IPPCDP.GT.0 .AND. IDATSW.EQ.'RAW')THEN
        NPERC=MAX(20,IPPCDP)
        NPERC=MIN(NPERC,N1)
        CALL SORT(Y1,N1,Y2)
        ASTRT=0.0
        ASTOP=100.0
        AINC=(ASTOP - ASTRT)/REAL(NPERC+1)
        IWRITE='OFF'
        DO110I=1,NPERC
          P100=ASTRT + REAL(I)*AINC
          CALL PERCEN(P100,Y2,N1,IWRITE,X2,MAXOBV,
     1                XPERC,IBUGG3,IERROR)
          Y1(I)=XPERC
  110   CONTINUE
        N1=NPERC
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PPC2')THEN
          WRITE(ICOUT,113)IPPCDP,NPERC,N1
  113     FORMAT('      IPPCDP, NPER, N1 = ',3I8)
          CALL DPWRST('XXX','BUG ')
          DO117I=1,N1
            WRITE(ICOUT,118)I,Y1(I)
  118       FORMAT('      I, Y1(I) = ',I8,G15.7)
            CALL DPWRST('XXX','BUG ')
  117     CONTINUE
        ENDIF
      ENDIF
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  BRANCH TO THE APPROPRIATE DISTRIBUTIONAL FAMILY  **
C               **  AND DETERMINE THE SET OF PARAMETER VALUES        **
C               **  TO BE USED FOR THE PROBABILITY PLOTS             **
C               *******************************************************
C
  500 CONTINUE
C
      NHOR1=IPPCAP(1)
      NHOR2=IPPCAP(2)
C
      IF(ICASPL.EQ.'LACP')GOTO510
      IF(ICASPL.EQ.'TCP')GOTO520
      IF(ICASPL.EQ.'CSCP')GOTO530
      IF(ICASPL.EQ.'GACP')GOTO540
      IF(ICASPL.EQ.'WECP')GOTO550
      IF(ICASPL.EQ.'E2CP')GOTO560
      IF(ICASPL.EQ.'PACP')GOTO570
      IF(ICASPL.EQ.'GECP')GOTO580
      IF(ICASPL.EQ.'POCP')GOTO590
      IF(ICASPL.EQ.'IGCP')GOTO600
      IF(ICASPL.EQ.'WACP')GOTO610
      IF(ICASPL.EQ.'RICP')GOTO620
      IF(ICASPL.EQ.'FLCP')GOTO630
      IF(ICASPL.EQ.'EVCP')GOTO640
      IF(ICASPL.EQ.'GPCP')GOTO650
      IF(ICASPL.EQ.'LNCP')GOTO660
      IF(ICASPL.EQ.'PNCP')GOTO670
      IF(ICASPL.EQ.'PLCP')GOTO680
      IF(ICASPL.EQ.'PFCP')GOTO690
      IF(ICASPL.EQ.'CHCP')GOTO700
      IF(ICASPL.EQ.'VMCP')GOTO710
      IF(ICASPL.EQ.'LLCP')GOTO720
      IF(ICASPL.EQ.'LGCP')GOTO730
      IF(ICASPL.EQ.'DWCP')GOTO740
      IF(ICASPL.EQ.'GVCP')GOTO750
      IF(ICASPL.EQ.'P2CP')GOTO760
      IF(ICASPL.EQ.'GZCP')GOTO770
      IF(ICASPL.EQ.'WCCP')GOTO780
      IF(ICASPL.EQ.'GLCP')GOTO790
      IF(ICASPL.EQ.'DGCP')GOTO800
      IF(ICASPL.EQ.'BRCP')GOTO810
      IF(ICASPL.EQ.'RECP')GOTO820
      IF(ICASPL.EQ.'BICP')GOTO830
      IF(ICASPL.EQ.'NBCP')GOTO840
      IF(ICASPL.EQ.'DLCP')GOTO850
      IF(ICASPL.EQ.'GICP')GOTO860
      IF(ICASPL.EQ.'LDCP')GOTO870
      IF(ICASPL.EQ.'BECP')GOTO880
      IF(ICASPL.EQ.'GGCP')GOTO890
      IF(ICASPL.EQ.'GOCP')GOTO900
      IF(ICASPL.EQ.'PECP')GOTO910
      IF(ICASPL.EQ.'EWCP')GOTO920
      IF(ICASPL.EQ.'JBCP')GOTO930
      IF(ICASPL.EQ.'JUCP')GOTO940
      IF(ICASPL.EQ.'IWCP')GOTO950
      IF(ICASPL.EQ.'LXCP')GOTO960
      IF(ICASPL.EQ.'TRCP')GOTO970
      IF(ICASPL.EQ.'EECP')GOTO980
      IF(ICASPL.EQ.'ALCP')GOTO11510
      IF(ICASPL.EQ.'TSCP')GOTO11520
      IF(ICASPL.EQ.'ERCP')GOTO11530
      IF(ICASPL.EQ.'FTCP')GOTO11540
      IF(ICASPL.EQ.'FCP')GOTO11550
      IF(ICASPL.EQ.'SNCP')GOTO11560
      IF(ICASPL.EQ.'STCP')GOTO11570
      IF(ICASPL.EQ.'IBCP')GOTO11580
      IF(ICASPL.EQ.'GHCP')GOTO11590
      IF(ICASPL.EQ.'LZCP')GOTO11600
      IF(ICASPL.EQ.'NCCP')GOTO11610
      IF(ICASPL.EQ.'NTCP')GOTO11620
      IF(ICASPL.EQ.'FNCP')GOTO11630
      IF(ICASPL.EQ.'FCCP')GOTO11640
      IF(ICASPL.EQ.'TECP')GOTO11650
      IF(ICASPL.EQ.'BBCP')GOTO11660
      IF(ICASPL.EQ.'PZCP')GOTO11670
      IF(ICASPL.EQ.'YUCP')GOTO11680
      IF(ICASPL.EQ.'WRCP')GOTO11690
      IF(ICASPL.EQ.'HECP')GOTO11700
      IF(ICASPL.EQ.'SDCP')GOTO11710
      IF(ICASPL.EQ.'ADCP')GOTO11720
      IF(ICASPL.EQ.'MXCP')GOTO11730
      IF(ICASPL.EQ.'GMCP')GOTO11740
      IF(ICASPL.EQ.'GALP')GOTO11750
      IF(ICASPL.EQ.'MCCP')GOTO11760
      IF(ICASPL.EQ.'GMLP')GOTO11770
      IF(ICASPL.EQ.'G5CP')GOTO11780
      IF(ICASPL.EQ.'BNCP')GOTO11790
      IF(ICASPL.EQ.'G2CP')GOTO11800
      IF(ICASPL.EQ.'G3CP')GOTO11810
      IF(ICASPL.EQ.'G4CP')GOTO11820
      IF(ICASPL.EQ.'AXCP')GOTO11830
C
  510 CONTINUE
      NUMDIS=41
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO511IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALAMB1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALAMB2-ALAMB1)
  511 CONTINUE
      GOTO990
C
  520 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      ANU1=NU1
      ANU2=NU2
      DO521IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ANU1+((AIDIS-1.0)/(ANUMDI-1.0))*(ANU2-ANU1)
  521 CONTINUE
      GOTO990
C
  530 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      ANU1=NU1
      ANU2=NU2
      DO531IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ANU1+((AIDIS-1.0)/(ANUMDI-1.0))*(ANU2-ANU1)
  531 CONTINUE
      GOTO990
C
  540 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO541IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  541 CONTINUE
      GOTO990
C
  550 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO551IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  551 CONTINUE
      GOTO990
C
  560 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO561IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  561 CONTINUE
      GOTO990
C
  570 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO571IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  571 CONTINUE
      GOTO990
C
  580 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO581IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=P1+((AIDIS-1.0)/(ANUMDI-1.0))*(P2-P1)
  581 CONTINUE
      GOTO990
C
  590 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO591IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALAMB1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALAMB2-ALAMB1)
  591 CONTINUE
      GOTO990
C
  600 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO606IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=AMU1+((AIDI1-1.0)/(ANMDI1-1.0))*(AMU2-AMU1)
        DO608IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=GAMMA1+((AIDI2-1.0)/(ANMDI2-1.0))*(GAMMA2-GAMMA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  608   CONTINUE
  606 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  610 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO611IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  611 CONTINUE
      GOTO990
C
  620 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO626IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=AMU1+((AIDI1-1.0)/(ANMDI1-1.0))*(AMU2-AMU1)
        DO628IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=GAMMA1+((AIDI2-1.0)/(ANMDI2-1.0))*(GAMMA2-GAMMA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  628   CONTINUE
  626 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  630 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO631IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  631 CONTINUE
      GOTO990
C
  640 CONTINUE
      NUMD1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANUMD1=NUMD1
      NUMD2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANUMD2=NUMD2
      ICOUNT=0
      DO641IDIS=1,NUMD1
        AIDI1=IDIS1
        A1=GAMMA1+((AIDI1-1.0)/(ANMDI1-1.0))*(GAMMA2-GAMMA1)
        DO642IDIS2=1,NUMD2
          AIDI2=IDIS2
          A2=THETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(THETA2-THETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  642   CONTINUE
  641 CONTINUE
      NUMDIS=NUMD1+NUMD2
      GOTO990
C
  650 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO651IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  651 CONTINUE
      GOTO990
C
  660 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO661IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=SIGMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(SIGMA2-SIGMA1)
  661 CONTINUE
      GOTO990
C
  670 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO671IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=P1+((AIDIS-1.0)/(ANUMDI-1.0))*(P2-P1)
  671 CONTINUE
      GOTO990
C
  680 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO681IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=SD1+((AIDI1-1.0)/(ANMDI1-1.0))*(SD2-SD1)
        DO683IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=P1+((AIDI2-1.0)/(ANMDI2-1.0))*(P2-P1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  683   CONTINUE
  681 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  690 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO691IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=C1+((AIDIS-1.0)/(ANUMDI-1.0))*(C2-C1)
  691 CONTINUE
      GOTO990
C
  700 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO701IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ANU1+((AIDIS-1.0)/(ANUMDI-1.0))*(ANU2-ANU1)
  701 CONTINUE
      GOTO990
C
  710 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO711IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=B1+((AIDIS-1.0)/(ANUMDI-1.0))*(B2-B1)
  711 CONTINUE
      GOTO990
C
  720 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO721IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=DELTA1+((AIDIS-1.0)/(ANUMDI-1.0))*(DELTA2-DELTA1)
  721 CONTINUE
      GOTO990
C
  730 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO731IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  731 CONTINUE
      GOTO990
C
  740 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO741IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  741 CONTINUE
      GOTO990
C
  750 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO751IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  751 CONTINUE
      GOTO990
C
  760 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO761IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  761 CONTINUE
      GOTO990
C
  770 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO771IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  771 CONTINUE
      GOTO990
C
  780 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO781IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=P1+((AIDIS-1.0)/(ANUMDI-1.0))*(P2-P1)
  781 CONTINUE
      GOTO990
C
  790 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO791IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALPHA1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALPHA2-ALPHA1)
  791 CONTINUE
      GOTO990
C
  800 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO801IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  801 CONTINUE
      GOTO990
C
  810 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO811IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=BETA1+((AIDIS-1.0)/(ANUMDI-1.0))*(BETA2-BETA1)
  811 CONTINUE
      GOTO990
C
  820 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO821IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=B1+((AIDIS-1.0)/(ANUMDI-1.0))*(B2-B1)
  821 CONTINUE
      GOTO990
C
  830 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO831IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=P1+((AIDIS-1.0)/(ANUMDI-1.0))*(P2-P1)
  831 CONTINUE
      GOTO990
C
  840 CONTINUE
      IF(AK1.LT.AK2)THEN
        NUMDI1=25
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=37
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI2=NUMDI2
        ICOUNT=0
        DO841IDIS1=1,NUMDI1
          AIDI1=IDIS1
          A1=P1+((AIDI1-1.0)/(ANMDI1-1.0))*(P2-P1)
          DO843IDIS2=1,NUMDI2
            AIDI2=IDIS2
            A2=AK1+((AIDI2-1.0)/(ANMDI2-1.0))*(AK2-AK1)
            ICOUNT=ICOUNT+1
            DISPAR(ICOUNT)=A1
            DISPA2(ICOUNT)=A2
  843     CONTINUE
  841   CONTINUE
        NUMDIS=ICOUNT
      ELSE
        ICASPL='NZCP'
        NUMSHA=1
        NUMDI1=25
        IF(NHOR1.GT.0)NUMDIS=NHOR1
        ANMDI1=NUMDI1
        ICOUNT=0
        DO846IDIS1=1,NUMDI1
          AIDI1=IDIS1
          A1=P1+((AIDI1-1.0)/(ANMDI1-1.0))*(P2-P1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
  846   CONTINUE
        NUMDIS=ICOUNT
      ENDIF
      GOTO990
C
  850 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO851IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=THETA1+((AIDIS-1.0)/(ANUMDI-1.0))*(THETA2-THETA1)
  851 CONTINUE
      GOTO990
C
  860 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO861IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  861 CONTINUE
      GOTO990
C
  870 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO871IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALMB31+((AIDI1-1.0)/(ANMDI1-1.0))*(ALMB32-ALMB31)
        DO873IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=ALMB41+((AIDI2-1.0)/(ANMDI2-1.0))*(ALMB42-ALMB41)
          IF(IGLDDF.EQ.'RAMB')THEN
            IWRITE='OFF'
            CALL GLDCHK(ALAMB3,ALAMB4,ALOWER,AUPPER,IFLAG,
     1                  ISIGN,IWRITE)
            IF(IFLAG.EQ.0)THEN
              ICOUNT=ICOUNT+1
              DISPAR(ICOUNT)=A1
              DISPA2(ICOUNT)=A2
            ENDIF
          ELSE
            ICOUNT=ICOUNT+1
            DISPAR(ICOUNT)=A1
            DISPA2(ICOUNT)=A2
          ENDIF
  873   CONTINUE
  871 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  880 CONTINUE
      NUMDI1=25
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=25
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO881IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPHA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPHA2-ALPHA1)
        DO883IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=BETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(BETA2-BETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  883   CONTINUE
  881 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  890 CONTINUE
      NUMDI1=25
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=25
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI2=NUMDI2
      ICOUNT=0
      DO891IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=C1+((AIDI1-1.0)/(ANMDI1-1.0))*(C2-C1)
        DO893IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=ALPHA1+((AIDI2-1.0)/(ANMDI2-1.0))*(ALPHA2-ALPHA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  893   CONTINUE
  891 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  900 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI2=NUMDI2
      ICOUNT=0
      DO901IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=C1+((AIDI1-1.0)/(ANMDI1-1.0))*(C2-C1)
        DO903IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=B1+((AIDI2-1.0)/(ANMDI2-1.0))*(B2-B1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  903   CONTINUE
  901 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  910 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO911IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPHA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPHA2-ALPHA1)
        DO913IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=BETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(BETA2-BETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  913   CONTINUE
  911 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  920 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI2=NUMDI2
      ICOUNT=0
      DO921IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=GAMMA1+((AIDI1-1.0)/(ANMDI1-1.0))*(GAMMA2-GAMMA1)
        DO923IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=THETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(THETA2-THETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  923   CONTINUE
  921 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  930 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO931IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPH11+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPH12-ALPH11)
        DO933IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=ALPH21+((AIDI2-1.0)/(ANMDI2-1.0))*(ALPH22-ALPH21)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  933   CONTINUE
  931 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  940 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO941IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPH11+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPH12-ALPH11)
        DO943IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=ALPH21+((AIDI2-1.0)/(ANMDI2-1.0))*(ALPH22-ALPH21)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
  943   CONTINUE
  941 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  950 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO951IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  951 CONTINUE
      GOTO990
C
  960 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO961IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALPHA1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALPHA2-ALPHA1)
  961 CONTINUE
      GOTO990
C
  970 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO971IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=C1+((AIDIS-1.0)/(ANUMDI-1.0))*(C2-C1)
  971 CONTINUE
      GOTO990
C
  980 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO981IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=GAMMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(GAMMA2-GAMMA1)
  981 CONTINUE
      GOTO990
C
11510 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11511IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPHA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPHA2-ALPHA1)
        DO11513IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=BETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(BETA2-BETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11513   CONTINUE
11511 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11520 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11521IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=THETA1+((AIDI1-1.0)/(ANMDI1-1.0))*(THETA2-THETA1)
        DO11523IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=ANU1+((AIDI2-1.0)/(ANMDI2-1.0))*(ANU2-ANU1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11523   CONTINUE
11521 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11530 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO11531IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALPHA1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALPHA2-ALPHA1)
11531 CONTINUE
      GOTO990
C
11540 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      NU2=NU1 + NUMDIS - 1
      ANU1=REAL(NU1)
      ANU2=REAL(NU2)
      DO11541IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ANU1+((AIDIS-1.0)/(ANUMDI-1.0))*(ANU2-ANU1)
11541 CONTINUE
      GOTO990
C
11550 CONTINUE
      NUMDI1=NU12 - NU11 + 1
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      IF(NUMDI1.LT.10)NUMDI1=10
      ANMDI1=NUMDI1
      NUMDI2=NU22 - NU21 + 1
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      IF(NUMDI2.LT.10)NUMDI2=10
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11551IDIS1=1,NUMDI1
        NTEMP1=NU11 + IDIS1 - 1
        DO11553IDIS2=1,NUMDI2
          NTEMP2=NU21 + IDIS2 - 1
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=REAL(NTEMP1)
          DISPA2(ICOUNT)=REAL(NTEMP2)
11553   CONTINUE
11551 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11560 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO11561IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALAMB1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALAMB2-ALAMB1)
11561 CONTINUE
      GOTO990
C
11570 CONTINUE
      NUMDI1=NU2 - NU1 + 1
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      IF(NUMDI1.LT.10)NUMDI1=10
      ANMDI1=NUMDI1
      NUMDI2=25
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11571IDIS1=1,NUMDI1
        NTEMP1=NU1 + IDIS1 - 1
        DO11573IDIS2=1,NUMDI2
          AIDIS2=IDIS2
          A2=ALAMB1+((AIDIS2-1.0)/(ANMDI2-1.0))*(ALAMB2-ALAMB1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=REAL(NTEMP1)
          DISPA2(ICOUNT)=A2
11573   CONTINUE
11571 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11580 CONTINUE
      NUMDI1=25
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=25
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11581IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPHA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPHA2-ALPHA1)
        DO11583IDIS2=1,NUMDI2
          AIDIS2=IDIS2
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=BETA1+
     1                   ((AIDIS2-1.0)/(ANMDI2-1.0))*(BETA2-BETA1)
11583   CONTINUE
11581 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11590 CONTINUE
      NUMDI1=21
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=41
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11591IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=H1+((AIDI1-1.0)/(ANMDI1-1.0))*(H2-H1)
        DO11593IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=G1+((AIDI2-1.0)/(ANMDI2-1.0))*(G2-G1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11593   CONTINUE
11591 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11600 CONTINUE
      NUMDI1=25
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=25
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11601IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=SD1+((AIDI1-1.0)/(ANMDI1-1.0))*(SD2-SD1)
        DO11603IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=ALAMB1+((AIDI2-1.0)/(ANMDI2-1.0))*(ALAMB2-ALAMB1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11603   CONTINUE
11601 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11610 CONTINUE
C
      IF(NU1.EQ.NU2)THEN
        NUMSHA=1
        ICASPL='NXCP'
        NUMDIS=50
        IF(NHOR1.GT.0)NUMDIS=NHOR1
        ANUMDI=NUMDIS
        DO11616IDIS=1,NUMDIS
          AIDIS=IDIS
          DISPAR(IDIS)=ALAMB1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALAMB2-ALAMB1)
11616   CONTINUE
        GOTO990
      ENDIF
C
      NUMDI1=10
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      NTEMP=NU2 - NU1 + 1
      IF(NTEMP.LE.10)THEN
        NUMDI1=NU2 - NU1 + 1
        AINC=1.0
      ELSE
        AINC=REAL(NU2-NU1+1)/REAL(NUMDI1)
        IF(AINC.LT.1.0)AINC=1.0
      ENDIF
      ANMDI1=NUMDI1
      ANMDI1=NUMDI1
      NUMDI2=21
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ANU1=REAL(NU1)
      ANU2=REAL(NU2)
      ICOUNT=0
      DO11611IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ANU1+(AIDI1-1.0)*AINC
        IA1=INT(A1+0.5)
        A1=REAL(IA1)
        DO11613IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=ALAMB1+((AIDI2-1.0)/(ANMDI2-1.0))*(ALAMB2-ALAMB1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11613   CONTINUE
11611 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11620 CONTINUE
C
      IF(NU1.EQ.NU2)THEN
        NUMSHA=1
        ICASPL='NYCP'
        NUMDIS=50
        IF(NHOR1.GT.0)NUMDIS=NHOR1
        ANUMDI=NUMDIS
        DO11626IDIS=1,NUMDIS
          AIDIS=IDIS
          DISPAR(IDIS)=ALAMB1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALAMB2-ALAMB1)
11626   CONTINUE
        GOTO990
      ENDIF
C
      NUMDI1=10
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      NTEMP=NU2 - NU1 + 1
      IF(NTEMP.LE.10)THEN
        NUMDI1=NU2 - NU1 + 1
        AINC=1.0
      ELSE
        AINC=REAL(NU2-NU1+1)/REAL(NUMDI1)
        IF(AINC.LT.1.0)AINC=1.0
      ENDIF
      ANMDI1=NUMDI1
      NUMDI2=21
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ANU1=REAL(NU1)
      ANU2=REAL(NU2)
      ICOUNT=0
      DO11621IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ANU1+(AIDI1-1.0)*AINC
        IA1=INT(A1+0.5)
        A1=REAL(IA1)
        DO11623IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=ALAMB1+((AIDI2-1.0)/(ANMDI2-1.0))*(ALAMB2-ALAMB1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11623   CONTINUE
11621 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11630 CONTINUE
      NUMDI1=51
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=51
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11631IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=AMU1+((AIDI1-1.0)/(ANMDI1-1.0))*(AMU2-AMU1)
        DO11633IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=SD1+((AIDI2-1.0)/(ANMDI2-1.0))*(SD2-SD1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11633   CONTINUE
11631 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11640 CONTINUE
      NUMDI1=51
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=51
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11641IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=AMU1+((AIDI1-1.0)/(ANMDI1-1.0))*(AMU2-AMU1)
        DO11643IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=SD1+((AIDI2-1.0)/(ANMDI2-1.0))*(SD2-SD1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11643   CONTINUE
11641 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11650 CONTINUE
      IWRITE='OFF'
      IF(AMU1.EQ.AMU2)THEN
        NUMSHA=1
        ICASPL='TXCP'
        NUMDIS=50
        IF(NHOR1.GT.0)NUMDIS=NHOR1
        ANUMDI=NUMDIS
        DO11656IDIS=1,NUMDIS
          AIDIS=IDIS
          DISPAR(IDIS)=SD1+((AIDIS-1.0)/(ANUMDI-1.0))*(SD2-SD1)
11656   CONTINUE
        GOTO990
      ENDIF
C
    
      CALL MINIM(X1,N1,IWRITE,XMIN,IBUGG3,IERROR)
C
      IF(AMU2.GE.XMIN)THEN
        AMU2=XMIN-0.1
        IF(AMU1.GE.AMU2)THEN
          AMU1=AMU2-5.0
          IF(AMU1.LT.0.0)AMU1=0.0
        ENDIF
      ENDIF
C
      NUMDI1=21
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=51
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11651IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=AMU1+((AIDI1-1.0)/(ANMDI1-1.0))*(AMU2-AMU1)
        DO11653IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=SD1+((AIDI2-1.0)/(ANMDI2-1.0))*(SD2-SD1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11653   CONTINUE
11651 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11660 CONTINUE
      NUMDI1=51
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=51
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11661IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPHA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPHA2-ALPHA1)
        DO11663IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=BETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(BETA2-BETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11663   CONTINUE
11661 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11670 CONTINUE
      NUMDI1=51
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=51
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11671IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPHA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPHA2-ALPHA1)
        DO11673IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=BETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(BETA2-BETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11673   CONTINUE
11671 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11680 CONTINUE
      NUMDIS=25
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO11681IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=P1+((AIDIS-1.0)/(ANUMDI-1.0))*(P2-P1)
11681 CONTINUE
      GOTO990
C
11690 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11691IDIS1=1,NUMDI1
        AIDI1=IDIS1
        AA1=C1+((AIDI1-1.0)/(ANMDI1-1.0))*(C2-C1)
        DO11693IDIS2=1,NUMDI2
          AIDI2=IDIS2
          AA2=A1+((AIDI2-1.0)/(ANMDI2-1.0))*(A2-A1)
          IF(AA1.GT.AA2)THEN
            ICOUNT=ICOUNT+1
            DISPAR(ICOUNT)=AA1
            DISPA2(ICOUNT)=AA2
          ENDIF
11693   CONTINUE
11691 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11700 CONTINUE
      NUMDI1=51
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=51
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11701IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPHA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPHA2-ALPHA1)
        DO11703IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=BETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(BETA2-BETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11703   CONTINUE
11701 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11710 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO11711IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALAMB1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALAMB2-ALAMB1)
11711 CONTINUE
      GOTO990
C
11720 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      IF(IADEDF.EQ.'K')THEN
        DO11721IDIS=1,NUMDIS
        AIDIS=IDIS
        DISPAR(IDIS)=AK1+((AIDIS-1.0)/(ANUMDI-1.0))*(AK2-AK1)
11721   CONTINUE
      ELSE
        DO11723IDIS=1,NUMDIS
        AIDIS=IDIS
        DISPAR(IDIS)=AMU1+((AIDIS-1.0)/(ANUMDI-1.0))*(AMU2-AMU1)
11723   CONTINUE
      ENDIF
      GOTO990
C
11730 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO11731IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=SIGMA1+((AIDIS-1.0)/(ANUMDI-1.0))*(SIGMA2-SIGMA1)
11731 CONTINUE
      GOTO990
C
11740 CONTINUE
      NUMDI1=50
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=50
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11741IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ETA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ETA2-ETA1)
        DO11743IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=ZETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(ZETA2-ZETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11743   CONTINUE
11741 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11750 CONTINUE
      NUMDI1=20
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=20
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11751IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=TAU1+((AIDI1-1.0)/(ANMDI1-1.0))*(TAU2-TAU1)
        DO11753IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=AK1+((AIDI2-1.0)/(ANMDI2-1.0))*(AK2-AK1)
          IF(A2.LT.1.0 .AND. TAU.LT.0.7)GOTO11753
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11753   CONTINUE
11751 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11760 CONTINUE
      NUMDIS=30
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO11761IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALPHA1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALPHA2-ALPHA1)
11761 CONTINUE
      GOTO990
C
11770 CONTINUE
      NUMDI1=17
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=20
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11771IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1TEMP=A1+((AIDI1-1.0)/(ANMDI1-1.0))*(A2-A1)
        DO11773IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2TEMP=ALPHA1+((AIDI2-1.0)/(ANMDI2-1.0))*(ALPHA2-ALPHA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1TEMP
          DISPA2(ICOUNT)=A2TEMP
11773   CONTINUE
11771 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11780 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO11781IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALPHA1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALPHA2-ALPHA1)
11781 CONTINUE
      GOTO990
C
11790 CONTINUE
      NUMDI1=25
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=25
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11791IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPHA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPHA2-ALPHA1)
        DO11793IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=BETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(BETA2-BETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11793   CONTINUE
11791 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11800 CONTINUE
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO11801IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALPHA1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALPHA2-ALPHA1)
11801 CONTINUE
      GOTO990
C
11810 CONTINUE
      NUMDIS=30
      IF(NHOR1.GT.0)NUMDIS=NHOR1
      ANUMDI=NUMDIS
      DO11811IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALPHA1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALPHA2-ALPHA1)
11811 CONTINUE
      GOTO990
C
11820 CONTINUE
      NUMDI1=20
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=20
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11821IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=P1+((AIDI1-1.0)/(ANMDI1-1.0))*(P2-P1)
        DO11823IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=Q1+((AIDI2-1.0)/(ANMDI2-1.0))*(Q2-Q1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11823   CONTINUE
11821 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
11830 CONTINUE
      NUMDI1=25
      IF(NHOR1.GT.0)NUMDI1=NHOR1
      ANMDI1=NUMDI1
      NUMDI2=25
      IF(NHOR2.GT.0)NUMDI2=NHOR2
      ANMDI2=NUMDI2
      ICOUNT=0
      DO11831IDIS1=1,NUMDI1
        AIDI1=IDIS1
        A1=ALPHA1+((AIDI1-1.0)/(ANMDI1-1.0))*(ALPHA2-ALPHA1)
        DO11833IDIS2=1,NUMDI2
          AIDI2=IDIS2
          A2=BETA1+((AIDI2-1.0)/(ANMDI2-1.0))*(BETA2-BETA1)
          ICOUNT=ICOUNT+1
          DISPAR(ICOUNT)=A1
          DISPA2(ICOUNT)=A2
11833   CONTINUE
11831 CONTINUE
      NUMDIS=ICOUNT
      GOTO990
C
  990 CONTINUE
C
C               **************************************
C               **  STEP 4--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  AND DETERMINE PLOT COORDINATES  **
C               **************************************
C
      IF(IDATSW.EQ.'RAW')GOTO1100
      IF(IDATSW.EQ.'FREQ' .OR. IDATSW.EQ.'FRE2')GOTO2100
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPPPC2 AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      IDATSW SHOULD BE EITHER   RAW   OR   FREQ, BUT ',
     1       'NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)IDATSW
 1014 FORMAT('      IDATSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ****************************************
C               **  STEP 4.1--                        **
C               **  DETERMINE PLOT COORDINATES        **
C               **  FOR THE 1-VARIABLE CASE           **
C               **  (THAT IS, FOR THE RAW DATA CASE)  **
C               ****************************************
C
 1100 CONTINUE
C
      AMIN=CPUMIN
      AMAX=CPUMAX
C
CCCCC OCTOBER 2004.  FOR CENSORED CASE, CHECK THAT SECOND VARIABLE
CCCCC                CONTAINS TWO DISTINCT VALUES, SET TO 1 AND 0.
CCCCC APRIL 2005.    CENSORING VARIABLE NOW IN XCENS.
CCCCC APRIL 2005.    ADD SUPPORT FOR REPLICATION.
C
      IF(ICENSO.EQ.'ON')THEN
        CALL DISTIN(XCENS,N1,IWRITE,X2,NDIST,IBUGG3,IERROR)
        IF(NDIST.EQ.1)THEN
          DO11102I=1,N1
            XCENS(I)=1.0
11102     CONTINUE
        ELSEIF(NDIST.EQ.2)THEN
          IF(X2(1).EQ.1.0 .OR. X2(2).EQ.1.0)THEN
            DO11103I=1,N1
              IF(XCENS(I).NE.1.0)XCENS(I)=0.0
11103       CONTINUE
          ELSE
            ATEMP1=MIN(X2(1),X2(2))
            ATEMP2=MAX(X2(1),X2(2))
            DO11108I=1,N1
              IF(XCENS(I).EQ.ATEMP1)XCENS(I)=1.0
              IF(XCENS(I).EQ.ATEMP2)XCENS(I)=0.0
11108       CONTINUE
          ENDIF
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11104)
11104     FORMAT('***** ERROR IN PPCC PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11105)
11105     FORMAT('      FOR CENSORED DATA, THE CENSORING VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11106)
11106     FORMAT('      SHOULD CONTAIN AT MOST TWO DISTINCT VALUES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11107)NDIST
11107     FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        CALL SORTC(Y1,XCENS,N1,Y2,XCENS)
        CALL UNIME3(N1,D2,XCENS,IMETHD)
      ELSE
        CALL SORT(Y1,N1,Y2)
        CALL UNIMED(N1,D2)
      ENDIF
C
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'PPC2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11201)
11201   FORMAT('AFTER UNIMED ROUTINE--')
        CALL DPWRST('XXX','BUG ')
        DO11203II=1,N1
          WRITE(ICOUT,11204)
11204     FORMAT('I,Y1(I),D2(I)=',I8,2G15.7)
          CALL DPWRST('XXX','BUG ')
11203   CONTINUE
      ENDIF
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='PPC2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1            IREWI1,ISUBN0,IERRF1,IBUGG3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
CCCCC OCTOBER 2004: WRITE PPCC VALUE, LOCATION, SCALE, SHAPE 1,
CCCCC                SHAPE2 TO FILE DPST2F.DAT.
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='PPC2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1            IREWI2,ISUBN0,IERRF2,IBUGG3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='PPC2'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1            IREWI3,ISUBN0,IERRF3,IBUGG3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
C  START REPLICATION LOOP
C
      IF(IREPL.EQ.'OFF')THEN
        NREPL=1
      ELSE
        DO51010I=1,N1
          XTEMP6(I)=Y1(I)
51010   CONTINUE
        CALL DISTIN(XREPL,N1,IWRITE,XREPDS,NREPL,IBUGG3,IERROR)
        NREPL=NREPL+1
      ENDIF
C
      N1SAVE=N1
      ICNTPT=0
      DO52000IIREPL=1,NREPL
C
        N1=N1SAVE
        SHAPMX=CPUMIN
        PPCCMX=CPUMIN
C
        IF(IIREPL.GT.1)THEN
          REPTMP=XREPDS(IIREPL-1)
          NTEMP=0
          DO52100II=1,N1
            IF(XREPL(II).EQ.REPTMP)THEN
              NTEMP=NTEMP+1
              Y1(NTEMP)=XTEMP6(II)
              X1(NTEMP)=XCENS(II)
            ENDIF
52100     CONTINUE
          N1=NTEMP
          IF(ICENSO.EQ.'ON')THEN
            CALL SORTC(Y1,XCENS,N1,Y2,XCENS)
            CALL UNIME3(N1,D2,XCENS,IMETHD)
          ELSE
            CALL SORT(Y1,N1,Y2)
            CALL UNIMED(N1,D2)
          ENDIF
          IF(N1.LE.1)THEN
            WRITE(ICOUT,52104)
52104       FORMAT('***** WARNING IN PPCC PLOT--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,52105)
52105       FORMAT('      REPLICATION ',I8,' CONTAINS FEWER THAN ',
     1             'TWO ELEMENTS AND WILL BE SKIPPED.')
            GOTO52000
          ENDIF
        ELSE
          DO52210II=1,N1
            X1(II)=XCENS(II)
52210     CONTINUE
        ENDIF
C
        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'PPC2')THEN
          WRITE(ICOUT,52204)IREPL,N1
52204     FORMAT('IREPL,N1 = ',2I8)
          CALL DPWRST('XXX','BUG ')
          DO52206II=1,N1
            WRITE(ICOUT,52207)II,X1(II),Y2(II),D2(II)
52207       FORMAT('II,X1(II),Y2(II),D2(I)) = ',I8,3G15.7)
            CALL DPWRST('XXX','BUG ')
52206     CONTINUE
        ENDIF
C
C  COMPUTE SOME VALUES THAT ARE NEEDED BY A FEW DISTRIBUTIONS.
C
        XMIN=Y2(1)
        XMAX=Y2(N1)
        IF(MOD(N1,2).EQ.1)THEN
          XMED=Y2((N1/2)+1)
        ELSE
          XMED=(Y2(N1/2)+Y2((N1/2)+1))/2.0
        ENDIF
        DO1105IDIS=1,NUMDIS
C
          ICNT=0
C
          IF(ICASPL.EQ.'LACP')GOTO1110
          IF(ICASPL.EQ.'TCP')GOTO1120
          IF(ICASPL.EQ.'CSCP')GOTO1130
          IF(ICASPL.EQ.'GACP')GOTO1140
          IF(ICASPL.EQ.'WECP')GOTO1150
          IF(ICASPL.EQ.'E2CP')GOTO1160
          IF(ICASPL.EQ.'PACP')GOTO1170
          IF(ICASPL.EQ.'GECP')GOTO1180
          IF(ICASPL.EQ.'POCP')GOTO1190
          IF(ICASPL.EQ.'IGCP')GOTO1200
          IF(ICASPL.EQ.'WACP')GOTO1210
          IF(ICASPL.EQ.'RICP')GOTO1220
          IF(ICASPL.EQ.'FLCP')GOTO1230
          IF(ICASPL.EQ.'EVCP')GOTO1240
          IF(ICASPL.EQ.'GPCP')GOTO1250
          IF(ICASPL.EQ.'LNCP')GOTO1260
          IF(ICASPL.EQ.'PNCP')GOTO1270
          IF(ICASPL.EQ.'PLCP')GOTO1280
          IF(ICASPL.EQ.'PFCP')GOTO1290
          IF(ICASPL.EQ.'CHCP')GOTO1300
          IF(ICASPL.EQ.'VMCP')GOTO1310
          IF(ICASPL.EQ.'LLCP')GOTO1320
          IF(ICASPL.EQ.'LGCP')GOTO1330
          IF(ICASPL.EQ.'DWCP')GOTO1340
          IF(ICASPL.EQ.'GVCP')GOTO1350
          IF(ICASPL.EQ.'P2CP')GOTO1360
          IF(ICASPL.EQ.'GZCP')GOTO1370
          IF(ICASPL.EQ.'WCCP')GOTO1380
          IF(ICASPL.EQ.'GLCP')GOTO1390
          IF(ICASPL.EQ.'DGCP')GOTO1400
          IF(ICASPL.EQ.'BRCP')GOTO1410
          IF(ICASPL.EQ.'RECP')GOTO1420
          IF(ICASPL.EQ.'BICP')GOTO1430
          IF(ICASPL.EQ.'NBCP')GOTO1440
          IF(ICASPL.EQ.'NZCP')GOTO1440
          IF(ICASPL.EQ.'DLCP')GOTO1450
          IF(ICASPL.EQ.'GICP')GOTO1460
          IF(ICASPL.EQ.'LDCP')GOTO1470
          IF(ICASPL.EQ.'BECP')GOTO1480
          IF(ICASPL.EQ.'GGCP')GOTO1490
          IF(ICASPL.EQ.'GOCP')GOTO1500
          IF(ICASPL.EQ.'PECP')GOTO1510
          IF(ICASPL.EQ.'EWCP')GOTO1520
          IF(ICASPL.EQ.'JBCP')GOTO1530
          IF(ICASPL.EQ.'JUCP')GOTO1540
          IF(ICASPL.EQ.'IWCP')GOTO1550
          IF(ICASPL.EQ.'LXCP')GOTO1560
          IF(ICASPL.EQ.'TRCP')GOTO1570
          IF(ICASPL.EQ.'EECP')GOTO1580
          IF(ICASPL.EQ.'ALCP')GOTO1590
          IF(ICASPL.EQ.'TSCP')GOTO1600
          IF(ICASPL.EQ.'ERCP')GOTO1610
          IF(ICASPL.EQ.'FTCP')GOTO1620
          IF(ICASPL.EQ.'FCP')GOTO1630
          IF(ICASPL.EQ.'SNCP')GOTO1640
          IF(ICASPL.EQ.'STCP')GOTO1650
          IF(ICASPL.EQ.'IBCP')GOTO1660
          IF(ICASPL.EQ.'GHCP')GOTO1670
          IF(ICASPL.EQ.'LZCP')GOTO1680
          IF(ICASPL.EQ.'NCCP')GOTO1690
          IF(ICASPL.EQ.'NXCP')GOTO1695
          IF(ICASPL.EQ.'NTCP')GOTO1700
          IF(ICASPL.EQ.'NYCP')GOTO1705
          IF(ICASPL.EQ.'FNCP')GOTO1710
          IF(ICASPL.EQ.'FCCP')GOTO1720
          IF(ICASPL.EQ.'TECP')GOTO1730
          IF(ICASPL.EQ.'TXCP')GOTO1730
          IF(ICASPL.EQ.'BBCP')GOTO1740
          IF(ICASPL.EQ.'PZCP')GOTO1750
          IF(ICASPL.EQ.'YUCP')GOTO1760
          IF(ICASPL.EQ.'WRCP')GOTO1770
          IF(ICASPL.EQ.'HECP')GOTO1780
          IF(ICASPL.EQ.'SDCP')GOTO1790
          IF(ICASPL.EQ.'ADCP')GOTO12800
          IF(ICASPL.EQ.'MXCP')GOTO12810
          IF(ICASPL.EQ.'GMCP')GOTO12820
          IF(ICASPL.EQ.'GALP')GOTO12830
          IF(ICASPL.EQ.'MCCP')GOTO12840
          IF(ICASPL.EQ.'GMLP')GOTO12850
          IF(ICASPL.EQ.'G5CP')GOTO12860
          IF(ICASPL.EQ.'BNCP')GOTO12870
          IF(ICASPL.EQ.'G2CP')GOTO12880
          IF(ICASPL.EQ.'G3CP')GOTO12890
          IF(ICASPL.EQ.'G4CP')GOTO12900
          IF(ICASPL.EQ.'AXCP')GOTO12910
C
 1110     CONTINUE
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(ALAMBA.GT.0.0)THEN
              AMAX=ABS(1.0/ALAMBA)
              AMIN=-AMAX
            ELSE
              AMIN=CPUMIN
              AMAX=CPUMAX
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND. KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1111I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1111
            ICNT=ICNT+1
            CALL LAMPPF(D2(I),ALAMBA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1111     CONTINUE
          GOTO1800
C
 1120     CONTINUE
          NU=DISPAR(IDIS)+0.5
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1121I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1121
            ICNT=ICNT+1
            CALL TPPF(D2(I),NU,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1121     CONTINUE
          GOTO1800
C
 1130 CONTINUE
          NU=DISPAR(IDIS)+0.5
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1131I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1131
            ICNT=ICNT+1
            CALL CHSPPF(D2(I),NU,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1131     CONTINUE
          GOTO1800
C
 1140     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1141I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1141
            ICNT=ICNT+1
            CALL GAMPPF(D2(I),GAMMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1141     CONTINUE
          GOTO1800
C
 1150     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(MINMAX.EQ.1)THEN
              AMIN=0.0
              AMAX=CPUMAX
            ELSE
              AMIN=CPUMIN
              AMAX=0.0
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1151I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1151
            ICNT=ICNT+1
            CALL WEIPPF(D2(I),GAMMA,MINMAX,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1151     CONTINUE
          GOTO1800
C
 1160     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(MINMAX.EQ.1)THEN
              AMIN=CPUMIN
              AMAX=0.0
            ELSE
              AMIN=0.0
              AMAX=CPUMAX
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1161I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1161
            ICNT=ICNT+1
            CALL EV2PPF(D2(I),GAMMA,MINMAX,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1161     CONTINUE
          GOTO1800
C
 1170     CONTINUE
          A=A1
          IF(A.GT.XMIN)A=XMIN
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=A
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1171I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1171
            ICNT=ICNT+1
            CALL PARPPF(D2(I),GAMMA,A,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1171     CONTINUE
          GOTO1800
C
 1180     CONTINUE
          P=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1181I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1181
            ICNT=ICNT+1
            CALL GEOPPF(D2(I),P,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1181     CONTINUE
          GOTO1800
C
 1190     CONTINUE
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1191I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1191
            ICNT=ICNT+1
            CALL POIPPF(D2(I),ALAMBA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1191     CONTINUE
          GOTO1800
C
 1200     CONTINUE
          AMU=DISPAR(IDIS)
          GAMMA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1206I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1206
            ICNT=ICNT+1
            CALL IGPPF(D2(I),GAMMA,AMU,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1206     CONTINUE
          GOTO1800
C
 1210     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1211I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1211
            ICNT=ICNT+1
            CALL WALPPF(D2(I),GAMMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1211     CONTINUE
          GOTO1800
C
 1220     CONTINUE
          IF(NUMSHA.EQ.1)THEN
            GAMMA=DISPA2(IDIS)
            AMU=1.0 
C
            IF(ICASP2.EQ.'KS  ')THEN
              AMIN=0.0
              AMAX=CPUMAX
              IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
            ENDIF
C
            DO1221I=1,N1
              IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1221
              ICNT=ICNT+1
              CALL RIGPPF(D2(I),GAMMA,AMU,X2(ICNT))
              Y3(ICNT)=Y2(I)
 1221       CONTINUE
          ELSE
            GAMMA=DISPA2(IDIS)
            AMU=DISPAR(IDIS)
C
            IF(ICASP2.EQ.'KS  ')THEN
              AMIN=0.0
              AMAX=CPUMAX
              IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
            ENDIF
C
            DO1226I=1,N1
              IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1226
              ICNT=ICNT+1
              CALL RIGPPF(D2(I),GAMMA,AMU,X2(ICNT))
              Y3(ICNT)=Y2(I)
 1226       CONTINUE
          ENDIF
          GOTO1800
C
 1230     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1231I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1231
            ICNT=ICNT+1
            CALL FLPPF(D2(I),GAMMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1231     CONTINUE
          GOTO1800
C
 1240     CONTINUE
          IF(1.LE.IDIS.AND.IDIS.LE.NUMD1)THEN
             GAMMA=DISPAR(IDIS)
C
             IF(ICASP2.EQ.'KS  ')THEN
               AMIN=0.0
               AMAX=CPUMAX
               IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1243
             ENDIF
C
             DO1241I=1,N1
               IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1241
               ICNT=ICNT+1
               CALL EV2PPF(D2(I),GAMMA,MINMAX,X2(ICNT))
               Y3(ICNT)=Y2(I)
 1241        CONTINUE
             GOTO1800
          ENDIF
 1243     CONTINUE
          IF(NUMD1+1.LE.IDIS.AND.IDIS.LE.NUMDIS)THEN
             GAMMA=DISPAR(IDIS)
C
             IF(ICASP2.EQ.'KS  ')THEN
               AMIN=0.0
               AMAX=CPUMAX
               IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
             ENDIF
C
             DO1242I=1,N1
               IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1242
               ICNT=ICNT+1
               CALL WEIPPF(D2(I),GAMMA,MINMAX,X2(ICNT))
               Y3(ICNT)=Y2(I)
 1242        CONTINUE
             GOTO1800
          ENDIF
C
 1250     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(IGEPDF.EQ.'JOHN')THEN
              IF(GAMMA.LE.0.0)THEN
                AMIN=0.0
                AMAX=CPUMAX
              ELSE
                AMIN=0.0
                AMAX=(1.0/GAMMA)
              ENDIF
            ELSE
              IF(GAMMA.GE.0.0)THEN
                AMIN=0.0
                AMAX=CPUMAX
              ELSE
                AMIN=0.0
                AMAX=-(1.0/GAMMA)
              ENDIF
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1251I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1251
            ICNT=ICNT+1
            CALL GEPPPF(D2(I),GAMMA,MINMAX,IGEPDF,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1251     CONTINUE
          GOTO1800
C
CCCCC THE FOLLOWING SECTION WAS ADDED     APRIL 1995
 1260     CONTINUE
          SIGMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1261I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1261
            ICNT=ICNT+1
            CALL LGNPPF(D2(I),SIGMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1261     CONTINUE
          GOTO1800
C
CCCCC THE FOLLOWING SECTION WAS ADDED     APRIL 1995
 1270     CONTINUE
          P=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1271I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1271
            ICNT=ICNT+1
            CALL PNRPPF(D2(I),P,SD,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1271     CONTINUE
          GOTO1800
C
CCCCC THE FOLLOWING SECTION WAS ADDED     APRIL 1995
 1280     CONTINUE
          P=DISPAR(IDIS)
          SD=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1281I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1281
            ICNT=ICNT+1
            CALL PLNPPF(D2(I),P,SD,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1281     CONTINUE
          GOTO1800
C
 1290     CONTINUE
          C=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1291I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1291
            ICNT=ICNT+1
            CALL POWPPF(D2(I),C,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1291     CONTINUE
          GOTO1800
C
CCCCC THE FOLLOWING SECTION WAS ADDED     APRIL 1995
 1300     CONTINUE
          ANU=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1301I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1301
            ICNT=ICNT+1
            CALL CHPPF(D2(I),ANU,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1301     CONTINUE
          GOTO1800
C
 1310     CONTINUE
          B=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=-PI
            AMAX=PI
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1311I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1311
            ICNT=ICNT+1
            CALL VONPPF(D2(I),B,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1311     CONTINUE
          GOTO1800
C
 1320     CONTINUE
          DELTA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1321I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1321
            ICNT=ICNT+1
            CALL LLGPPF(D2(I),DELTA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1321     CONTINUE
          GOTO1800
C
CCCCC THE FOLLOWING SECTION WAS ADDED     OCTOBER 1995
 1330     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1331I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1331
            ICNT=ICNT+1
            CALL LGAPPF(D2(I),GAMMA,ILGADF,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1331     CONTINUE
          GOTO1800
C
 1340     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1341I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1341
            ICNT=ICNT+1
            CALL DWEPPF(D2(I),GAMMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1341     CONTINUE
          GOTO1800
C
 1350     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
              IF(GAMMA.GT.0.0)THEN
                AMIN=CPUMIN
                AMAX=(1.0/GAMMA) - 0.1E-6
              ELSE
                AMIN=(1.0/GAMMA) + 0.1E-6
                AMAX=CPUMAX
              ENDIF
            ELSE
              IF(GAMMA.GT.0.0)THEN
                AMIN=(-1.0/GAMMA) + 0.1E-6
                AMAX=CPUMAX
              ELSE
                AMIN=CPUMIN
                AMAX=(-1.0/GAMMA) - 0.1E-6
              ENDIF
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1351I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1351
            ICNT=ICNT+1
            CALL GEVPPF(D2(I),GAMMA,MINMAX,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1351     CONTINUE
          GOTO1800
C
 1360     CONTINUE
          A=A1
          IF(A.LE.0.0)A=1.0
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1361I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1361
            ICNT=ICNT+1
            CALL PA2PPF(D2(I),GAMMA,A,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1361     CONTINUE
          GOTO1800
C
 1370     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0/GAMMA
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1371I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1371
            ICNT=ICNT+1
            CALL HFLPPF(D2(I),GAMMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1371     CONTINUE
          GOTO1800
C
 1380     CONTINUE
          P=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=2.0*PI
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1381I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1381
            ICNT=ICNT+1
            CALL WCAPPF(D2(I),P,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1381     CONTINUE
          GOTO1800
C
 1390     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1391I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1391
            ICNT=ICNT+1
            CALL GLOPPF(D2(I),ALPHA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1391     CONTINUE
          GOTO1800
C
CCCCC THE FOLLOWING SECTION WAS ADDED     JANUARY 1996
 1400     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1401I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1401
            ICNT=ICNT+1
            CALL DGAPPF(D2(I),GAMMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1401     CONTINUE
          GOTO1800
C
 1410     CONTINUE
          BETA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1411I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1411
            ICNT=ICNT+1
            CALL BRAPPF(D2(I),BETA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1411     CONTINUE
          GOTO1800
C
 1420     CONTINUE
          B=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=1.0/B
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1421I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1421
            ICNT=ICNT+1
            CALL RECPPF(D2(I),B,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1421     CONTINUE
          GOTO1800
C
 1430     CONTINUE
          P=DISPAR(IDIS)
          NPAR=NBINOM
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1431I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1431
            ICNT=ICNT+1
            CALL BINPPF(D2(I),P,NBINOM,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1431     CONTINUE
          GOTO1800
C
 1440     CONTINUE
          P=DISPAR(IDIS)
          IF(ICASPL.EQ.'NZCP')THEN
            AK=AK1
          ELSE
            AK=DISPA2(IDIS)
          ENDIF
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1441I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1441
            ICNT=ICNT+1
            CALL NBPPF(D2(I),P,AK,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1441     CONTINUE
          GOTO1800
C
 1450     CONTINUE
          THETA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1451I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1451
            ICNT=ICNT+1
            CALL DLGPPF(D2(I),THETA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1451     CONTINUE
          GOTO1800
C
 1460     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1461I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1461
            ICNT=ICNT+1
            CALL IGAPPF(D2(I),GAMMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1461     CONTINUE
          GOTO1800
C
 1470     CONTINUE
          IWRITE='OFF'
          ALAM3=DISPAR(IDIS)
          ALAM4=DISPA2(IDIS)
      
CCCCC     IF(IGLDDF.EQ.'RAMB')THEN
CCCCC       ZSCALE=1.0
CCCCC       IWRITE='OFF'
CCCCC       CALL GLDCHK(ALAM3,ALAM4,ALOWER,AUPPER,IFLAG,
CCCCC1                  ISIGN,IWRITE)
CCCCC       IF(ISIGN.LT.0)ZSCALE=-1.0
CCCCC     ENDIF
C
          IF(ICASP2.EQ.'KS  ')THEN
CCCCC       WRITE(ICOUT,1478)ALAM3,ALAM4
C1478       FORMAT('ALAM3,ALAM4=',2G15.7)
CCCCC       CALL DPWRST('XXX','BUG ')
            IWRITE='ERRO'
            IF(ALAM3.LE.0.0 .AND. ALAM4.LE.0.0)THEN
              AMIN=CPUMIN
              AMAX=CPUMAX
            ELSEIF(ALAM3.LE.0.0)THEN
              AMIN=CPUMIN
              CALL GLDPPF(1.0D0,DBLE(ALAM3),DBLE(ALAM4),DPPF,
     1                    IGLDDF,IWRITE)
              AMAX=REAL(DPPF)
            ELSEIF(ALAM4.LE.0.0)THEN
              AMAX=CPUMAX
CCCCC         CALL GLDPPF(0.0D0,DBLE(ALAM3),DBLE(ALAM4),DPPF,
CCCCC1                    IGLDDF,IWRITE)
CCCCC         AMIN=REAL(DPPF)
              AMIN=1.0/ALAM4
            ELSE
              CALL GLDPPF(0.0D0,DBLE(ALAM3),DBLE(ALAM4),DPPF,
     1                    IGLDDF,IWRITE)
              AMIN=REAL(DPPF)
              CALL GLDPPF(1.0D0,DBLE(ALAM3),DBLE(ALAM4),DPPF,
     1                    IGLDDF,IWRITE)
              AMAX=REAL(DPPF)
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1471I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1471
            ICNT=ICNT+1
            CALL GLDPPF(DBLE(D2(I)),DBLE(ALAM3),DBLE(ALAM4),
     1                  DPPF,IGLDDF,IWRITE)
            IF(IGLDDF.EQ.'RAMB')THEN
CCCCC         X2(I)=ZSCALE*REAL(DPPF)
              X2(I)=REAL(DPPF)
            ELSE
              X2(I)=REAL(DPPF)
            ENDIF
            Y3(ICNT)=Y2(I)
 1471     CONTINUE
          GOTO1800
C
 1480     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1481I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1481
            ICNT=ICNT+1
            CALL BETPPF(D2(I),ALPHA,BETA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1481     CONTINUE
          GOTO1800
C
 1490     CONTINUE
          C=DISPAR(IDIS)
          ALPHA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1491I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1491
            ICNT=ICNT+1
            CALL GGDPPF(D2(I),ALPHA,C,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1491     CONTINUE
          GOTO1800
C
 1500     CONTINUE
          C=DISPAR(IDIS)
          B=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1501I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1501
            ICNT=ICNT+1
            CALL GOMPPF(D2(I),C,B,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1501     CONTINUE
          GOTO1800
C
 1510     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1511I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1511
            ICNT=ICNT+1
            CALL PEXPPF(D2(I),ALPHA,BETA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1511     CONTINUE
          GOTO1800
C
 1520     CONTINUE
          GAMMA=DISPAR(IDIS)
          THETA=DISPA2(IDIS)
          IARG1=1
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1521I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1521
            ICNT=ICNT+1
            CALL EWEPPF(D2(I),GAMMA,THETA,IARG1,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1521     CONTINUE
          GOTO1800
C
 1530     CONTINUE
          ALPHA1=DISPAR(IDIS)
          ALPHA2=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1531I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1531
            ICNT=ICNT+1
            CALL JSBPPF(D2(I),ALPHA1,ALPHA2,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1531     CONTINUE
          GOTO1800
C
 1540     CONTINUE
          ALPHA1=DISPAR(IDIS)
          ALPHA2=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1541I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1541
            ICNT=ICNT+1
            CALL JSUPPF(D2(I),ALPHA1,ALPHA2,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1541     CONTINUE
          GOTO1800
C
 1550     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          AMIN=0.0
          AMAX=CPUMAX
          DO1551I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1551
            ICNT=ICNT+1
            CALL IWEPPF(D2(I),GAMMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1551     CONTINUE
          GOTO1800
C
 1560     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1561I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1561
            ICNT=ICNT+1
            CALL LDEPPF(D2(I),ALPHA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1561     CONTINUE
          GOTO1800
C
 1570     CONTINUE
          ZLOWLM=-1.0
          ZUPPLM=1.0
          C=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=-1.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1571I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1571
            ICNT=ICNT+1
            CALL TRIPPF(D2(I),C,ZLOWLM,ZUPPLM,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1571     CONTINUE
          GOTO1800
C
 1580     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1581I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1581
            ICNT=ICNT+1
            CALL GEEPPF(D2(I),GAMMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1581     CONTINUE
          GOTO1800
C
 1590     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1591I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1591
            ICNT=ICNT+1
            CALL ALPPPF(D2(I),ALPHA,BETA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1591     CONTINUE
          GOTO1800
C
 1600     CONTINUE
          THETA=DISPAR(IDIS)
          ANU=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1601I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1601
            ICNT=ICNT+1
            CALL TSPPPF(D2(I),THETA,ANU,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1601     CONTINUE
          GOTO1800
C
CCCCC THE FOLLOWING SECTION WAS ADDED  MAY 2003
 1610     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1611I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1611
            ICNT=ICNT+1
            D2IN=D2(I)
            CALL ERRPPF(D2IN,ALPHA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1611     CONTINUE
          GOTO1800
C
 1620     CONTINUE
          NU=INT(DISPAR(IDIS) + 0.5)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1621I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1621
            ICNT=ICNT+1
            CALL FTPPF(D2(I),NU,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1621     CONTINUE
          GOTO1800
C
 1630     CONTINUE
          NU1=INT(DISPAR(IDIS)+0.5)
          NU2=INT(DISPA2(IDIS)+0.5)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1631I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1631
            ICNT=ICNT+1
            CALL FPPF(D2(I),NU1,NU2,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1631     CONTINUE
          GOTO1800
C
 1640     CONTINUE
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1641I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1641
            ICNT=ICNT+1
            CALL SNPPF(D2(I),ALAMBA,ISKNDF,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1641     CONTINUE
          GOTO1800
C
 1650     CONTINUE
          NU=INT(DISPAR(IDIS)+0.5)
          ALAMBA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1651I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1651
            ICNT=ICNT+1
            CALL STPPF(D2(I),NU,ALAMBA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1651     CONTINUE
          GOTO1800
C
 1660     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1661I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1661
            ICNT=ICNT+1
            CALL IBPPF(D2(I),ALPHA,BETA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1661     CONTINUE
          GOTO1800
C
 1670     CONTINUE
          H=DISPAR(IDIS)
          G=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DP=-1.0D0
          DO1671I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1671
            ICNT=ICNT+1
            CALL GHPPF(D2(I),G,H,X2(ICNT),DBLE(D2(I)),DPPF)
            Y3(ICNT)=Y2(I)
 1671     CONTINUE
          GOTO1800
C
 1680     CONTINUE
          SD=DISPAR(IDIS)
          ALAMBA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1681I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1681
            ICNT=ICNT+1
            CALL LSNPPF(D2(I),ALAMBA,SD,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1681     CONTINUE
          GOTO1800
C
 1690     CONTINUE
          ANU=DISPAR(IDIS)
          ALAMBA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1691I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1691
            ICNT=ICNT+1
            CALL NCCPPF(D2(I),ANU,ALAMBA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1691     CONTINUE
          GOTO1800
C
 1695     CONTINUE
          ANU=REAL(NU1)
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1696I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1696
            ICNT=ICNT+1
            CALL NCCPPF(D2(I),ANU,ALAMBA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1696     CONTINUE
          GOTO1800
C
 1700     CONTINUE
          ANU=DISPAR(IDIS)
          ALAMBA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1701I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1701
            ICNT=ICNT+1
            CALL NCTPPF(D2(I),ANU,ALAMBA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1701     CONTINUE
          GOTO1800
C
 1705     CONTINUE
          ANU=REAL(NU1)
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1706I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1706
            ICNT=ICNT+1
            CALL NCTPPF(D2(I),ANU,ALAMBA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1706     CONTINUE
          GOTO1800
C
 1710     CONTINUE
          AM=DISPAR(IDIS)
          SD=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1711I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1711
            ICNT=ICNT+1
            CALL FNRPPF(D2(I),AM,SD,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1711     CONTINUE
          GOTO1800
C
 1720     CONTINUE
          AM=DISPAR(IDIS)
          SD=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1721I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1721
            ICNT=ICNT+1
            CALL FCAPPF(D2(I),AM,SD,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1721     CONTINUE
          GOTO1800
C
 1730     CONTINUE
          IF(ICASPL.EQ.'TECP')THEN
            AMU=DISPAR(IDIS)
            SD=DISPA2(IDIS)
          ELSE
            AMU=AMU1
            SD=DISPAR(IDIS)
          ENDIF
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=AMU
            AMAX=X0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1731I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1731
            ICNT=ICNT+1
            CALL TNEPPF(D2(I),X0,AMU,SD,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1731     CONTINUE
          GOTO1800
C
 1740     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1741I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1741
            ICNT=ICNT+1
            CALL BBNPPF(D2(I),ALPHA,BETA,NU,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1741     CONTINUE
          GOTO1800
C
 1750     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1751I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1751
            ICNT=ICNT+1
            CALL POLPPF(D2(I),ALPHA,BETA,NU,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1751     CONTINUE
          GOTO1800
C
 1760     CONTINUE
          P=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1761I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1761
            ICNT=ICNT+1
            CALL YULPPF(D2(I),P,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1761     CONTINUE
          GOTO1800
C
 1770     CONTINUE
          C=DISPAR(IDIS)
          A=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1771I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1771
            ICNT=ICNT+1
            CALL WARPPF(D2(I),C,A,X2(I),'NOTR')
            Y3(ICNT)=Y2(I)
 1771     CONTINUE
          GOTO1800
C
 1780     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO1800
          ENDIF
C
          DO1781I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1781
            ICNT=ICNT+1
            CALL HERPPF(D2(I),ALPHA,BETA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1781     CONTINUE
          GOTO1800
C
 1790     CONTINUE
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO1791I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO1791
            ICNT=ICNT+1
            CALL SDEPPF(D2(I),ALAMBA,X2(ICNT))
            Y3(ICNT)=Y2(I)
 1791     CONTINUE
          GOTO1800
C
12800     CONTINUE
          IF(IADEDF.EQ.'K')THEN
            AK=DISPAR(IDIS)
            AJUNK=AK
          ELSE
            AMU=DISPAR(IDIS)
            AJUNK=AMU
          ENDIF
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12801I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12801
            ICNT=ICNT+1
            CALL ADEPPF(D2(I),AJUNK,IADEDF,X2(ICNT))
            Y3(ICNT)=Y2(I)
12801     CONTINUE
          GOTO1800
C
12810     CONTINUE
          SIGMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12811I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12811
            ICNT=ICNT+1
            CALL MAXPPF(D2(I),SIGMA,X2(ICNT))
            Y3(ICNT)=Y2(I)
12811     CONTINUE
          GOTO1800
C
12820     CONTINUE
          ETA=DISPAR(IDIS)
          ZETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12821I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12821
            ICNT=ICNT+1
            CALL MA2PPF(D2(I),ZETA,ETA,X2(ICNT))
            Y3(ICNT)=Y2(I)
12821     CONTINUE
          GOTO1800
C
12830     CONTINUE
          AK=DISPAR(IDIS)
          TAU=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12831I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12831
            ICNT=ICNT+1
            CALL GALPPF(DBLE(D2(I)),DBLE(AK),DBLE(TAU),IADEDF,DPPF)
            X2(ICNT)=DPPF
            Y3(ICNT)=Y2(I)
12831     CONTINUE
          GOTO1800
C
12840     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12841I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12841
            ICNT=ICNT+1
            CALL MCLPPF(DBLE(D2(I)),DBLE(ALPHA),DPPF)
            X2(ICNT)=DPPF
            Y3(ICNT)=Y2(I)
12841     CONTINUE
          GOTO1800
C
12850     CONTINUE
          A=DISPAR(IDIS)
          ALPHA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12851I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12851
            ICNT=ICNT+1
            CALL GMCPPF(DBLE(D2(I)),DBLE(ALPHA),DBLE(A),DPPF)
            X2(ICNT)=DPPF
            Y3(ICNT)=Y2(I)
12851     CONTINUE
          GOTO1800
C
12860     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(ALPHA.GT.0.0)THEN
              AMIN=CPUMIN
              AMAX=1.0/ALPHA
            ELSEIF(ALPHA.LT.0.0)THEN
              AMIN=1.0/ALPHA
              AMAX=CPUMAX
            ELSE
              AMIN=CPUMIN
              AMAX=CPUMAX
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          XPAR(1)=0.0D0
          XPAR(2)=1.0D0
          XPAR(3)=DBLE(ALPHA)
          DO12861I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12861
            ICNT=ICNT+1
            DPPF=QUAGLO(DBLE(D2(I)),XPAR)
            X2(ICNT)=REAL(DPPF)
            Y3(ICNT)=Y2(I)
12861     CONTINUE
          GOTO1800
C
12870     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12871I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12871
            ICNT=ICNT+1
            CALL BNOPPF(DBLE(D2(I)),DBLE(ALPHA),DBLE(BETA),DPPF)
            X2(ICNT)=REAL(DPPF)
            Y3(ICNT)=Y2(I)
12871     CONTINUE
          GOTO1800
C
12880     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12881I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12881
            ICNT=ICNT+1
            CALL GL2PPF(DBLE(D2(I)),DBLE(ALPHA),DPPF)
            X2(ICNT)=DPPF
            Y3(ICNT)=Y2(I)
12881     CONTINUE
          GOTO1800
C
12890     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12891I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12891
            ICNT=ICNT+1
            CALL GL3PPF(DBLE(D2(I)),DBLE(ALPHA),DPPF)
            X2(ICNT)=DPPF
            Y3(ICNT)=Y2(I)
12891     CONTINUE
          GOTO1800
C
12900     CONTINUE
          P=DISPAR(IDIS)
          Q=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12901I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12901
            ICNT=ICNT+1
            CALL GL4PPF(DBLE(D2(I)),DBLE(P),DBLE(Q),DPPF)
            X2(ICNT)=REAL(DPPF)
            Y3(ICNT)=Y2(I)
12901     CONTINUE
          GOTO1800
C
12910     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1800
          ENDIF
C
          DO12911I=1,N1
            IF(ICENSO.EQ.'ON' .AND. X1(I).EQ.0.0)GOTO12911
            ICNT=ICNT+1
            CALL ALDPPF(DBLE(D2(I)),DBLE(ALPHA),DBLE(BETA),DPPF)
            X2(ICNT)=REAL(DPPF)
            Y3(ICNT)=Y2(I)
12911     CONTINUE
          GOTO1800
C
 1800   CONTINUE
C
CCCCC MAY 2004: SUPPORT BIWEIGHT MIDCORRELATION, PERCENTAGE BEND
CCCCC           CORRELATION, AND WINSORIZED CORRELATION AS ALTERNATIVES
CCCCC           TO THE STANDARD CORRELATION FOR THIS PLOT.
CCCCC MAY 2004: SUPPORT A "MINIMUM KOLM-SMIR" OPTION.  CALL LINFI2
CCCCC           TO OBTAIN ESTIMATES OF LOCATION AND SCALE, THE CALL
CCCCC           DP1KS2 TO OBTAIN VALUE OF K-S STATISTIC.
C
        IWRITE='OFF'
        NTEMP=ICNT
C
        IF(ICASP2.EQ.'KS  ')THEN
C
CCCCC     DETERMINE LOCATION AND SCALE PARAMETERS.
CCCCC      1) USER SPECIFIED KSLOC AND KSSCALE
CCCCC      2) FIT A LINE TO THE PROBABILITY PLOT AND USE INTERCEPT
CCCCC         AND SLOPE
CCCCC      3) FOR BOUNDED DISTRIBUTIONS, CHECK THAT XMIN AND XMAX
CCCCC         WILL BE IN RANGE.  IF NOT, SET LOCATION TO MINIMUM
CCCCC         AND SCALE TO MAXIMUM - MINIMUM
C
          EPS=0.000001
          ICASP3=ICASPL
          IF(ICASP3.EQ.'GMLP')THEN
            ICASP3='GMCP'
          ELSEIF(ICASP3(3:4).EQ.'CP')THEN
            ICASP3(3:4)='PP'
          ELSEIF(ICASP3(2:3).EQ.'CP')THEN
            ICASP3(2:3)='PP'
          ENDIF
          IF((KSLOC.EQ.CPUMIN .OR. KSSCAL.EQ.CPUMIN) .AND.
     1       IFLAG.EQ.0)THEN
C
C  HANDLE BETA SEPARATELY
C

            IF(ICASPL.EQ.'BECP')THEN
              IF(XMIN.GE.0.0 .AND. XMIN.LE.1.0 .AND.
     1           XMAX.GE.0.0 .AND. XMAX.LE.1.0)THEN
                A0TEMP=0.0
                A1TEMP=1.0
              ELSE
                A0TEMP=XMIN-EPS
                A1TEMP=XMAX+EPS
              ENDIF
C
C  HANDLE TUKEY-LAMBDA SEPARATELY
C
            ELSEIF(ICASPL.EQ.'LACP' .AND. ALAMBA.GT.0.0)THEN
              CALL LINFI2(Y3,X2,NTEMP,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
              IF((XMIN-A0TEMP)/A1TEMP.LT.AMIN .OR.
     1            (XMAX-A0TEMP)/A1TEMP.GT.AMAX)THEN
                A0TEMP=XMED
                ATEMP1=ALAMBA*ABS(XMAX-A0TEMP) + 0.1
                ATEMP2=ALAMBA*ABS(XMIN-A0TEMP) + 0.1
                A1TEMP=MAX(ATEMP1,ATEMP2)
              ENDIF
C
C  HANDLE VON-MISES, WRAPPED CAUCHY SEPARATELY
C
            ELSEIF(ICASPL.EQ.'VMCP' .OR. ICASPL.EQ.'WCCP')THEN
              CALL LINFI2(Y3,X2,NTEMP,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
              IF((XMIN-A0TEMP)/A1TEMP.LT.AMIN .OR.
     1            (XMAX-A0TEMP)/A1TEMP.GT.AMAX)THEN
                A0TEMP=XMED
                ATEMP1=(XMAX-A0TEMP)/AMAX
              ENDIF
C
C  HANDLE CASE WHERE DOMAIN BOUNDED BOTH ABOVE AND BELOW.  SOLVE
C
C     (XMIN-A0)/A1 = AMIN
C     (XMAX-A0)/A1 = AMAX
C
C  NOTE: OF AMIN = -AMAX (E.G., VON MISES), THEN GET DIVISION BY
C        ZERO.  IN THIS CASE, SET A0 TO DATA MINIMUM MINUS
C        EPS, THEN SET A1 = (XMAX-A0)/AMAX
C
            ELSEIF(AMIN.GT.CPUMIN .AND. AMAX.LT.CPUMAX)THEN
              CALL LINFI2(Y3,X2,NTEMP,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
              IF((XMIN-A0TEMP)/A1TEMP.LT.AMIN .OR.
     1           (XMAX-A0TEMP)/A1TEMP.GT.AMAX)THEN
                CMIN=AMIN
                CMAX=AMAX
                CONST=CMIN/CMAX
                IF(CONST.NE.-1.0)THEN
                  A0TEMP=(XMIN-CONST*XMAX)/(1.0+CONST) - EPS
                  A1TEMP=(XMAX-A0TEMP)/CMAX + EPS
                ELSE
                  A0TEMP=XMIN - EPS
                  A1TEMP=(XMAX - A0TEMP)/AMAX
                ENDIF
              ENDIF
C
C  HANDLE CASE WHERE DOMAIN BOUNDED ON MINIMUM ONLY
C 
            ELSEIF(AMIN.GT.CPUMIN .AND. AMAX.EQ.CPUMAX)THEN
              CALL LINFI2(Y3,X2,NTEMP,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
              IF((XMIN-A0TEMP)/A1TEMP.LT.AMIN)THEN
                A0TEMP=XMIN-EPS
              ENDIF
C
C  HANDLE CASE WHERE DOMAIN BOUNDED ON MAXIMUM ONLY
C
            ELSEIF(AMIN.EQ.CPUMIN .AND. AMAX.LT.CPUMAX)THEN
              CALL LINFI2(Y3,X2,NTEMP,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
              CTEMP=(XMAX-A0TEMP)/A1TEMP
              IF(CTEMP.GE.AMAX)THEN
                A0TEMP=(XMAX-EPS) - A1TEMP*AMAX
              ENDIF
C
C  HANDLE UNBOUNDED CASE
C
            ELSE
              CALL LINFI2(Y3,X2,NTEMP,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
            ENDIF
C
          ELSE
            NTEMP=N1
            A0TEMP=KSLOC
            A1TEMP=KSSCAL
          ENDIF
C
          XTEMP3(IDIS)=A0TEMP
          XTEMP4(IDIS)=A1TEMP
C
          IF(IFLAG.EQ.0)THEN
            CALL DP1KS2(Y2,NTEMP,ICASP3,
     1                  X1,ICENSO,
     1                  ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,
     1                  NPAR,P,K,MINMAX,
     1                  ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,
     1                  MPAR,B,SD,THETA,
     1                  DELTA,A,AM,X0,
     1                  U1,SD1,U2,SD2,DZ,
     1                  ALAMB3,ALAMB4,ALPHA1,ALPHA2,
     1                  ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,
     1                  AMU,XI,CHI,G,H,AK,SIGMA,
     1                  ETA,ZETA,TAU,Q,
     1                  A0TEMP,A1TEMP,
     1                  STATVA,CDF1,CDF2,CDF3,
     1                  ICAPSW,ICAPTY,
     1                  IWRITE,IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1                  ILGADF,ISKNDF,IGLDDF,
     1                  XTEMP1,XTEMP2,NXTEMP,IBUGG3,IERROR)
          ELSE
            IRHSTG='AREA'
            CLWID=CPUMIN
            XSTART=CPUMIN
            XSTOP=CPUMAX
            CALL DPCHS2(Y3,X1,XTEMP5,NTEMP,ICASP3,IDATSW,IRHSTG,
     1                  ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,NPAR,
     1                  P,K,MINMAX,
     1                  ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,MPAR,
     1                  B,SD,THETA,
     1                  DELTA,A,AM,X0,
     1                  U1,SD1,U2,SD2,DZ,ANU3,
     1                  ALAMB3,ALAMB4,ALPHA1,ALPHA2,
     1                  ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,
     1                  AMU,XI,CHI,G,H,AK,SIGMA,
     1                  ETA,ZETA,TAU,Q,
     1                  CLWID,XSTART,XSTOP,
     1                  XTEMP9,IHSTCW,MAXOBV,
     1                  A0TEMP,A1TEMP,
     1                  STATVA,STATCD,STATNU,CDF1,CDF2,CDF3,
     1                  ICAPSW,ICAPTY,IWRITE,
     1                  IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1                  ILGADF,ISKNDF,IGLDDF,
     1                  XTEMP1,XTEMP2,XTEMP7,XTEMP8,NXTEMP,
     1                  IBUGG3,IERROR)
          ENDIF
          CORRV(IDIS)=STATVA
          IF(CORRV(IDIS).LT.PPCCMX .OR. PPCCMX.EQ.CPUMIN)THEN
            A0SAVE=XTEMP3(IDIS)
            A1SAVE=XTEMP4(IDIS)
            PPCCMX=CORRV(IDIS)
            SHAPMX=DISPAR(IDIS)
          ENDIF
        ELSE
          CALL CORR(Y3,X2,NTEMP,IWRITE,CC,IBUGG3,IERROR)
          CORRV(IDIS)=CC
          CALL LINFI2(Y3,X2,NTEMP,
     1                A0TEMP,A1TEMP,
     1                ISUBRO,IBUGG3,IERROR)
C
          IF(CORRV(IDIS).GT.PPCCMX)THEN
            A0SAVE=A0TEMP
            A1SAVE=A1TEMP
            PPCCMX=CORRV(IDIS)
            SHAPMX=DISPAR(IDIS)
          ENDIF
C
          IF(IPPCCC.EQ.'WINS')THEN
            IHP='P1  '
            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
              PROP1=10.0
            ELSE
              PROP1=VALUE(ILOCP)
            ENDIF
            IF(PROP1.LE.0.0 .OR. PROP1.GE.25.0)PROP1=10.0
C
            IHP='P2  '
            IHP2='    '
            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
              PROP2=10.0
            ELSE
              PROP2=VALUE(ILOCP)
            ENDIF
            IF(PROP2.LE.0.0 .OR. PROP2.GE.25.0)PROP2=10.0
C
            CALL WINSOR(Y3,NTEMP,PROP1,PROP2,IWRITE,XTEMP1,
     1                  MAXOBV,XTEMP2,
     1                  IBUGG3,IERROR)
            DO12072I=1,N1
              Y1(I)=XTEMP2(I)
12072       CONTINUE
            CALL WINSOR(X2,NTEMP,PROP1,PROP2,IWRITE,XTEMP1,
     1                  MAXOBV,XTEMP2,
     1                  IBUGG3,IERROR)
            DO12074I=1,NTEMP
              X2(I)=XTEMP2(I)
12074       CONTINUE
            CALL CORR(Y3,X2,NTEMP,IWRITE,CC,IBUGG3,IERROR)
            CORRZ(IDIS)=CC
          ELSEIF(IPPCCC.EQ.'PERB')THEN
            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=0.1
            ELSE
              BETA=VALUE(ILOCP)
            ENDIF
            IF(BETA.LE.0.0 .OR. BETA.GE.0.25)BETA=0.1
C
            CALL PBNCOR(Y3,X2,NTEMP,IWRITE,XTEMP1,XTEMP2,MAXOBV,
     1                  CC,BETA,
     1                  IBUGG3,IERROR)
            CORRZ(IDIS)=CC
          ELSEIF(IPPCCC.EQ.'BIWE')THEN
            CALL BIWMDV(Y3,NTEMP,IWRITE,XTEMP1,XTEMP2,MAXOBV,VAR1,
     1                  IBUGG3,IERROR)
            CALL BIWMDV(X2,NTEMP,IWRITE,XTEMP1,XTEMP2,MAXOBV,VAR2,
     1                  IBUGG3,IERROR)
            CALL BIWMCV(Y3,X2,NTEMP,IWRITE,XTEMP1,XTEMP2,MAXOBV,COV,
     1                  IBUGG3,IERROR)
            CC=0.0
            IF(COV.GT.0.0)CC=COV/SQRT(VAR1*VAR2)
            CORRZ(IDIS)=CC
          ENDIF
        ENDIF
C
CCCCC OCTOBER 2004: WRITE PPCC VALUE, LOCATION, SHAPE, AND
CCCCC               SHAPE PARAMETERS TO DPST2F.DAT.
C
        IF(NUMSHA.LE.1)THEN
          IF(IREPL.EQ.'ON')THEN
            WRITE(IOUNI2,'(I5,2X,4E15.7)')IIREPL-1,CORRV(IDIS),
     1                                    A0TEMP,A1TEMP,DISPAR(IDIS)
          ELSE
            WRITE(IOUNI2,'(4E15.7)')CORRV(IDIS),A0TEMP,A1TEMP,
     1                              DISPAR(IDIS)
          ENDIF
        ELSE
          WRITE(IOUNI2,'(5E15.7)')CORRV(IDIS),A0TEMP,A1TEMP,
     1                            DISPAR(IDIS),(IDIS)
        ENDIF
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PPC2')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1831)NUMDIS,IDIS,DISPAR(IDIS),DISPA2(IDIS)
 1831     FORMAT('NUMDIS,IDIS,DISPAR(IDIS),DISPA2(IDIS) = ',2I8,2E15.7)
          CALL DPWRST('XXX','BUG ')
          DO1832I=1,N1
            WRITE(ICOUT,1833)I,Y1(I),X1(I),Y2(I),X2(I),D2(I)
 1833       FORMAT('I,Y1(I),X1(I),Y2(I),X2(I),D2(I) = ',I8,5E15.7)
            CALL DPWRST('XXX','BUG ')
 1832     CONTINUE
          WRITE(ICOUT,1834)ICASPL,IDATSW
 1834     FORMAT('ICASPL,IDATSW = ',A4,2X,A4)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1835)NUMDIS,IDIS,DISPAR(IDIS),CORRV(IDIS)
 1835     FORMAT('NUMDIS,IDIS,DISPAR(IDIS),CORRV(IDIS) = ',2I8,2E15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
 1108   CONTINUE
 1105   CONTINUE
C
CCCCC   THREE BASIC CASES:
CCCCC
CCCCC   1) ONE SHAPE PARAMETER
CCCCC   2) TWO SHAPE PARAMETERS - GENERATE MULTI-TRACE PLOT
CCCCC   3) TWO SHAPE PARAMETERS - GENERATE A 3D-PLOT
C
CCCCC   FOR EACH OF THESE, THERE ARE SEVERAL SUB-CASES TO CONSIDER:
CCCCC
CCCCC   1) K-S PLOT PRINTS LOCATION AND SCALE ESTIMATES USED (FOR
CCCCC      CONTINUOUS DISTRIBUTIONS ONLY)
CCCCC   2) PPCC PLOT MAY PRINT AN ALTERNATE ESTIMATE OF CORRELATION
CCCCC      AS A SECOND TRACE
CCCCC   3) EXTREME VALUE PLOT WILL PRINT SEPARATE TRACES FOR MIN AND
CCCCC      MAX CASES
C
        AHOLD=CPUMIN
        ATAG=0.0
C
CCCCC   CASE 1: ONE SHAPE PARAMETER
C
        IF(NUMSHA.EQ.1)THEN
          NLAST=NUMDIS
          IF(ICASPL.EQ.'EVCP')NLAST=NUMD1
          DO1930IDIS=1,NLAST
            ICNTPT=ICNTPT+1
            X2TEMP(ICNTPT)=DISPAR(IDIS)
            IF(ICASPL.NE.'EVCP' .OR. IPPCCC.EQ.'LINE')THEN
              Y2TEMP(ICNTPT)=CORRV(IDIS)
              D2TEMP(ICNTPT)=REAL(IIREPL)
            ELSE
              Y2TEMP(ICNTPT)=CORRZ(IDIS)
              D2TEMP(ICNTPT)=REAL(IIREPL-1)+1.0
            ENDIF
            IF(IFLAG.EQ.0 .AND. ICASP2.EQ.'KS  ')THEN
              WRITE(IOUNI1,'(5E15.7,I8)')Y2TEMP(ICNTPT),
     1                                XTEMP3(IDIS),XTEMP4(IDIS),
     1                                X2TEMP(ICNTPT),
     1                                D2TEMP(ICNTPT),IIREPL-1
            ELSE
              WRITE(IOUNI1,'(3E15.7,I8)')Y2TEMP(ICNTPT),
     1                                   X2TEMP(ICNTPT),
     1                                   D2TEMP(ICNTPT),IIREPL-1
            ENDIF
 1930     CONTINUE
          N2=ICNTPT
          NPLOTV=2
C
          IF(ICASPL.EQ.'EVCP')THEN
            NUMD1P=NUMD1+1
            DO1932IDIS=NUMD1P,NUMDIS
              ICNTPT=ICNTPT+1
              Y2TEMP(ICNTPT)=CORRV(IDIS)
              IF(IPPCCC.NE.'LINE')Y2TEMP(ICNTPT)=CORRZ(IDIS)
              X2TEMP(ICNTPT)=DISPAR(IDIS)
              D2TEMP(ICNTPT)=REAL(IIREPL)*2.0
 1932       CONTINUE
            N2=ICNTPT
            NPLOTV=3
          ELSEIF(IPPCCC.NE.'LINE' .AND. ICASP2.EQ.'PPCC')THEN
            NUMD1P=NUMD1+1
            DO1934IDIS=1,NUMDIS
              ICNTPT=ICNTPT+1
              Y2TEMP(ICNTPT)=CORRZ(IDIS)
              X2TEMP(ICNTPT)=DISPAR(IDIS)
              D2TEMP(ICNTPT)=REAL(IIREPL)*2.0
 1934       CONTINUE
            N2=ICNTPT
            NPLOTV=3
          ENDIF
C
CCCCC CASE 2: TWO SHAPE PARAMETERS, MULTI-TRACE PLOT
C
        ELSEIF(NUMSHA.EQ.2 .AND. IPPCFO.EQ.'TRAC')THEN
          DO1940IDIS=1,NUMDIS
            ICNTPT=ICNTPT+1
            IF(DISPAR(IDIS).NE.AHOLD)THEN
              ATAG=ATAG+1.0
              AHOLD=DISPAR(IDIS)
            ENDIF
            IF(ICASP2.EQ.'PPCC' .AND. IPPCCC.NE.'LINE')THEN
              Y2TEMP(ICNTPT)=CORRZ(IDIS)
            ELSE
              Y2TEMP(ICNTPT)=CORRV(IDIS)
            ENDIF
            IF(IPPCAO.EQ.'DEFA')THEN
              X2TEMP(ICNTPT)=DISPA2(IDIS)
              X3D2(ICNTPT)=DISPAR(IDIS)
            ELSE
              X3D2(ICNTPT)=DISPA2(IDIS)
              X2TEMP(ICNTPT)=DISPAR(IDIS)
            ENDIF
            D2TEMP(ICNTPT)=ATAG
            IF(IFLAG.EQ.0 .AND. ICASP2.EQ.'KS  ')THEN
              WRITE(IOUNI1,'(6E15.7)')Y2TEMP(ICNTPT),
     1                                XTEMP3(IDIS),XTEMP4(IDIS),
     1                                X2TEMP(ICNTPT),X3D2(ICNTPT),
     1                                D2TEMP(ICNTPT)
            ELSE
              WRITE(IOUNI1,'(4E15.7)')Y2TEMP(ICNTPT),
     1                                X2TEMP(ICNTPT),X3D2(ICNTPT),
     1                                D2TEMP(ICNTPT)
            ENDIF
 1940     CONTINUE
          N2=ICNTPT
          NPLOTV=3
C
CCCCC CASE 3: TWO SHAPE PARAMETERS, 3D-PLOT
C
        ELSEIF(NUMSHA.EQ.2 .AND. IPPCFO.EQ.'3D  ')THEN
          IWRITE='OFF'
          CALL DISTIN(DISPA2,NUMDIS,IWRITE,DISPA3,NTEMP,IBUGG3,IERROR)
          IF(IERROR.EQ.'YES'.OR.IERROR.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1941)
 1941       FORMAT('****** ERROR FROM DPPPC2 DURING CALL TO DISTIN')
            CALL DPWRST('XXX','BUG ')
            GOTO9000
          ENDIF
C
          DO1960IDIS=1,NUMDIS
            ICNTPT=ICNTPT+1
            IF(DISPAR(IDIS).NE.AHOLD)THEN
              ATAG=ATAG+1.0
              AHOLD=DISPAR(IDIS)
            ENDIF
            IF(ICASP2.EQ.'PPCC' .AND. IPPCCC.NE.'LINE')THEN
              Y2TEMP(ICNTPT)=CORRZ(IDIS)
            ELSE
              Y2TEMP(ICNTPT)=CORRV(IDIS)
            ENDIF
            IF(IPPCAO.EQ.'DEFA')THEN
              X2TEMP(ICNTPT)=DISPAR(IDIS)
              X3D2(ICNTPT)=DISPA2(IDIS)
            ELSE
              X3D2(ICNTPT)=DISPAR(IDIS)
              X2TEMP(ICNTPT)=DISPA2(IDIS)
            ENDIF
            D2TEMP(ICNTPT)=ATAG
            IF(IFLAG.EQ.0 .AND. ICASP2.EQ.'KS  ')THEN
              WRITE(IOUNI1,'(6E15.7)')Y2TEMP(ICNTPT),
     1                                XTEMP3(IDIS),XTEMP4(IDIS),
     1                                X2TEMP(ICNTPT),X3D2(ICNTPT),
     1                                D2TEMP(ICNTPT)
            ELSE
              WRITE(IOUNI1,'(4E15.7)')Y2TEMP(ICNTPT),
     1                                X2TEMP(ICNTPT),X3D2(ICNTPT),
     1                                D2TEMP(ICNTPT)
            ENDIF
 1960     CONTINUE
C
          DO1970J=1,NTEMP
            AHOLD=DISPA3(J)
            ATAG=ATAG+1.0
            DO1975IDIS=1,NUMDIS
              IF(DISPA2(IDIS).EQ.AHOLD)THEN
                ICNTPT=ICNTPT+1
                N2=N2+1
                IF(ICASP2.EQ.'PPCC' .AND. IPPCCC.NE.'LINE')THEN
                  Y2TEMP(ICNTPT)=CORRZ(IDIS)
                ELSE
                  Y2TEMP(ICNTPT)=CORRV(IDIS)
                ENDIF
                IF(IPPCAO.EQ.'DEFA')THEN
                  X2TEMP(ICNTPT)=DISPAR(IDIS)
                  X3D2(ICNTPT)=DISPA2(IDIS)
                ELSE
                  X3D2(ICNTPT)=DISPAR(IDIS)
                  X2TEMP(ICNTPT)=DISPA2(IDIS)
                ENDIF
                D2TEMP(ICNTPT)=ATAG
              ENDIF
 1975       CONTINUE
 1970     CONTINUE
C
          NPLOTV=3
          N2=ICNTPT
        ENDIF
C
        IF(IIREPL.EQ.1)THEN
          CALL DPWCPP(Y1,X1,N1,ICASPL,IDATSW,
     1                CORRV,DISPAR,NUMDIS,
     1                IBUGG3,ISUBRO,IFOUND,IERROR)
        ENDIF
C
        WRITE(IOUNI3,'(I8,4E15.7)')IIREPL-1,PPCCMX,SHAPMX,
     1                             A0SAVE,A1SAVE
C
52000 CONTINUE
C
      DO52910II=1,ICNTPT
        X2(II)=X2TEMP(II)
        Y2(II)=Y2TEMP(II)
        D2(II)=D2TEMP(II)
52910 CONTINUE
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1            IENDF1,IREWI1,ISUBN0,IERRF1,IBUGG3,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,IBUGG3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1            IENDF3,IREWI3,ISUBN0,IERRF3,IBUGG3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      GOTO9000
C
C               ********************************************
C               **  STEP 4.2--                            **
C               **  DETERMINE PLOT COORDINATES            **
C               **  FOR THE 2-VARIABLE CASE               **
C               **  (THAT IS, FOR THE GROUPED DATA CASE)  **
C               ********************************************
C
 2100 CONTINUE
C
      ICNT=0
C
CCCCC APRIL 2005.    ADD SUPPORT FOR REPLICATION.
CCCCC                NOTE: FOR GROUPED CASE, DO NOT SUPPORT A
CCCCC                      "COMBINED" FULL SAMPLE OPTION AS WE
CCCCC                      DO FOR UNGROUPED DATA.
CCCCC APRIL 2005.    ADD SUPPORT FOR UNEQUAL SIZE BINS
CCCCC                (X1 = LOWER LIMITS, X1UPP = UPPER LIMITS)
C
C
C     REMOVE ZERO-FREQUENCY CELLS
C
      DO2009I=1,N1 
        IF(Y1(I).GT.0.0)THEN
          ICNT=ICNT+1
          Y2(ICNT)=Y1(I)
          D2(ICNT)=X1(I)
          X1UTMP(ICNT)=X1UPP(I)
          XTEMP6(ICNT)=XREPL(I)
        ENDIF
 2009 CONTINUE
      N1=ICNT
      DO2019I=1,N1 
        Y1(I)=REAL(INT(Y2(I)+0.5))
        X1(I)=D2(I)
        X1UPP(I)=X1UTMP(I)
        XREPL(I)=XTEMP6(I)
 2019 CONTINUE
C
      IF(MINSIZ.LT.1)MINSIZ=1
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='PPC2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1            IREWI1,ISUBN0,IERRF1,IBUGG3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
CCCCC OCTOBER 2004.  WRITE PPCC VALUE, LOCATION, SCALE, AND SHAPE
CCCCC                PARAMETERS TO FILE DPST1F.DAT.
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='PPC2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1            IREWI2,ISUBN0,IERRF2,IBUGG3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='PPC2'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1            IREWI3,ISUBN0,IERRF3,IBUGG3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
C  START REPLICATION LOOP
C
      IF(IREPL.EQ.'OFF')THEN
        NREPL=1
      ELSE
        DO71010I=1,N1
          XTEMP6(I)=Y1(I)
          XCENS(I)=X1(I)
          X1UTMP(I)=X1UPP(I)
71010   CONTINUE
        NREPL=NREPL+1
      ENDIF
C
      N1SAVE=N1
      ICNTPT=0
      DO72000IIREPL=1,NREPL
C
        N1=N1SAVE
        SHAPMX=CPUMIN
        PPCCMX=CPUMIN
C
        IF(NREPL.GT.1)THEN
          REPTMP=XREPDS(IIREPL-1)
          NTEMP=0
          DO72100II=1,N1
            IF(XREPL(II).EQ.REPTMP)THEN
              NTEMP=NTEMP+1
              Y1(NTEMP)=XTEMP6(II)
              X1(NTEMP)=XCENS(II)
              Y3(NTEMP)=Y1(NTEMP)
              XLOW(NTEMP)=X1(NTEMP)
              IF(IDATSW.EQ.'FREQ')THEN
                XHIGH(NTEMP)=X1(NTEMP)
              ELSE
                X1UPP(NTEMP)=X1UTMP(II)
                XHIGH(NTEMP)=X1UPP(NTEMP)
                X1(NTEMP)=(XLOW(NTEMP) + XHIGH(NTEMP))/2.0
              ENDIF
            ENDIF
72100     CONTINUE
          N1=NTEMP
          IF(N1.LE.1)THEN
            WRITE(ICOUT,72104)
72104       FORMAT('***** WARNING IN PPCC PLOT--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,72105)
72105       FORMAT('      REPLICATION ',I8,' CONTAINS FEWER THAN ',
     1             'TWO ELEMENTS AND WILL BE SKIPPED.')
            GOTO72000
          ENDIF
        ELSE
          DO72108I=1,N1
            Y3(I)=Y1(I)
            IF(IDATSW.EQ.'FREQ')THEN
              XLOW(I)=X1(I)
              XHIGH(I)=X1(I)
            ELSE
              XLOW(I)=X1(I)
              XHIGH(I)=X1UPP(I)
              X1(I)=(XLOW(I) + XHIGH(I))/2.0
            ENDIF
72108     CONTINUE
        ENDIF
C
        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'PPC2')THEN
          WRITE(ICOUT,72111)IIREPL,N1
72111     FORMAT('IIREPL,N1,NCLASS = ',3I8)
          CALL DPWRST('XXX','BUG ')
          DO72113II=1,N1
            WRITE(ICOUT,72112)II,X1(II),XLOW(II),XHIGH(II),Y1(II)
72112       FORMAT('II,X1(II),XLOW(II),XHIGH(II),Y1(II) = ',
     1             I8,4G15.7)
            CALL DPWRST('XXX','BUG ')
72113     CONTINUE
        ENDIF
C
CCCCC   CALL DPCOMB(Y1,X1,N1,MINSIZ,
CCCCC1              Y3,XLOW,XHIGH,N3,'OFF ',IERROR)
        N3=N1
C
        CALL SORTC(X1,Y1,N1,Y2,D2)
C
        SUM=0.0
        DO2001I=1,N1
          SUM=SUM+Y1(I)
 2001   CONTINUE
        NTOT=SUM+0.5
        IF(IDATSW.EQ.'FREQ')THEN
          XDEL=Y2(2)-Y2(1)
          XMIN=Y2(1) - (XDEL/2.0)
        ELSE
          XMIN=Y2(1)
        ENDIF
C
        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'PPC2')THEN
          WRITE(ICOUT,72204)IIREPL,N1
72204     FORMAT('IIREPL,N1 = ',2I8)
          CALL DPWRST('XXX','BUG ')
          DO72206II=1,N1
            WRITE(ICOUT,72207)II,X1(II),Y1(II),Y2(II),D2(II)
72207       FORMAT('II,X1(II),Y1(II),Y2(II),D2(I)) = ',I8,4G15.7)
            CALL DPWRST('XXX','BUG ')
72206     CONTINUE
        ENDIF
C
        DO2105IDIS=1,NUMDIS
C
          IF(ICASPL.EQ.'LACP')GOTO2110
          IF(ICASPL.EQ.'TCP')GOTO2120
          IF(ICASPL.EQ.'CSCP')GOTO2130
          IF(ICASPL.EQ.'GACP')GOTO2140
          IF(ICASPL.EQ.'WECP')GOTO2150
          IF(ICASPL.EQ.'E2CP')GOTO2160
          IF(ICASPL.EQ.'PACP')GOTO2170
          IF(ICASPL.EQ.'GECP')GOTO2180
          IF(ICASPL.EQ.'POCP')GOTO2190
          IF(ICASPL.EQ.'IGCP')GOTO2200
          IF(ICASPL.EQ.'WACP')GOTO2210
          IF(ICASPL.EQ.'RICP')GOTO2220
          IF(ICASPL.EQ.'FLCP')GOTO2230
          IF(ICASPL.EQ.'GPCP')GOTO2250
          IF(ICASPL.EQ.'LNCP')GOTO2260
          IF(ICASPL.EQ.'PNCP')GOTO2270
          IF(ICASPL.EQ.'PLCP')GOTO2280
          IF(ICASPL.EQ.'PFCP')GOTO2290
          IF(ICASPL.EQ.'CHCP')GOTO2300
          IF(ICASPL.EQ.'VMCP')GOTO2310
          IF(ICASPL.EQ.'LLCP')GOTO2320
          IF(ICASPL.EQ.'LGCP')GOTO2330
          IF(ICASPL.EQ.'DWCP')GOTO2340
          IF(ICASPL.EQ.'GVCP')GOTO2350
          IF(ICASPL.EQ.'P2CP')GOTO2360
          IF(ICASPL.EQ.'GZCP')GOTO2370
          IF(ICASPL.EQ.'WCCP')GOTO2380
          IF(ICASPL.EQ.'GLCP')GOTO2390
          IF(ICASPL.EQ.'DGCP')GOTO2400
          IF(ICASPL.EQ.'BRCP')GOTO2410
          IF(ICASPL.EQ.'RECP')GOTO2420
          IF(ICASPL.EQ.'BICP')GOTO2430
          IF(ICASPL.EQ.'NBCP')GOTO2440
          IF(ICASPL.EQ.'DLCP')GOTO2450
          IF(ICASPL.EQ.'GICP')GOTO2460
          IF(ICASPL.EQ.'IWCP')GOTO2470
          IF(ICASPL.EQ.'LXCP')GOTO2480
          IF(ICASPL.EQ.'TRCP')GOTO2490
          IF(ICASPL.EQ.'EECP')GOTO2500
          IF(ICASPL.EQ.'ERCP')GOTO2510
          IF(ICASPL.EQ.'FTCP')GOTO2520
          IF(ICASPL.EQ.'FCP')GOTO2530
          IF(ICASPL.EQ.'SNCP')GOTO2540
          IF(ICASPL.EQ.'SDCP')GOTO2550
          IF(ICASPL.EQ.'ADCP')GOTO2560
          IF(ICASPL.EQ.'MXCP')GOTO2570
          IF(ICASPL.EQ.'MCCP')GOTO2580
          IF(ICASPL.EQ.'NZCP')GOTO2590
          IF(ICASPL.EQ.'LDCP')GOTO2600
          IF(ICASPL.EQ.'BECP')GOTO2610
          IF(ICASPL.EQ.'GGCP')GOTO2620
          IF(ICASPL.EQ.'GOCP')GOTO2630
          IF(ICASPL.EQ.'PECP')GOTO2640
          IF(ICASPL.EQ.'EWCP')GOTO2650
          IF(ICASPL.EQ.'JBCP')GOTO2660
          IF(ICASPL.EQ.'JUCP')GOTO2670
          IF(ICASPL.EQ.'ALCP')GOTO2680
          IF(ICASPL.EQ.'TSCP')GOTO2690
          IF(ICASPL.EQ.'STCP')GOTO2700
          IF(ICASPL.EQ.'IBCP')GOTO2710
          IF(ICASPL.EQ.'GHCP')GOTO2720
          IF(ICASPL.EQ.'LZCP')GOTO2730
          IF(ICASPL.EQ.'NCCP')GOTO2740
          IF(ICASPL.EQ.'NXCP')GOTO2750
          IF(ICASPL.EQ.'NTCP')GOTO2760
          IF(ICASPL.EQ.'NYCP')GOTO2770
          IF(ICASPL.EQ.'FNCP')GOTO2780
          IF(ICASPL.EQ.'FCCP')GOTO2790
          IF(ICASPL.EQ.'TECP')GOTO22800
          IF(ICASPL.EQ.'TXCP')GOTO22810
          IF(ICASPL.EQ.'BBCP')GOTO22820
          IF(ICASPL.EQ.'PZCP')GOTO22830
          IF(ICASPL.EQ.'YUCP')GOTO22840
          IF(ICASPL.EQ.'WRCP')GOTO22850
          IF(ICASPL.EQ.'HECP')GOTO22860
          IF(ICASPL.EQ.'GMCP')GOTO22870
          IF(ICASPL.EQ.'GACP')GOTO22880
          IF(ICASPL.EQ.'GMLP')GOTO22890
          IF(ICASPL.EQ.'G5CP')GOTO22900
          IF(ICASPL.EQ.'BNCP')GOTO22910
          IF(ICASPL.EQ.'G2CP')GOTO22920
          IF(ICASPL.EQ.'G3CP')GOTO22930
          IF(ICASPL.EQ.'G4CP')GOTO22940
          IF(ICASPL.EQ.'AXCP')GOTO22950
C
 2110     CONTINUE
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(ALAMBA.GT.0.0)THEN
              AMAX=ABS(1.0/ALAMBA)
              AMIN=-AMAX
            ELSE
              AMIN=CPUMIN
              AMAX=CPUMAX
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND. KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2111I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2111
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2112K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL LAMPPF(UNIOSM,ALAMBA,DISOSM)
              SUM=SUM+DISOSM
 2112       CONTINUE
            X2(I)=SUM/ANI
 2111     CONTINUE
          GOTO2800
C
 2120     CONTINUE
          NU=DISPAR(IDIS)+0.5
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2121I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2121
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2122K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL TPPF(UNIOSM,NU,DISOSM)
              SUM=SUM+DISOSM
 2122       CONTINUE
            X2(I)=SUM/ANI
 2121     CONTINUE
          GOTO2800
C
 2130     CONTINUE
          NU=DISPAR(IDIS)+0.5
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2131I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2131
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2132K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL CHSPPF(UNIOSM,NU,DISOSM)
              SUM=SUM+DISOSM
 2132       CONTINUE
            X2(I)=SUM/ANI
 2131     CONTINUE
          GOTO2800
C
 2140     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2141I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2141
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2142K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GAMPPF(UNIOSM,GAMMA,DISOSM)
              SUM=SUM+DISOSM
 2142       CONTINUE
            X2(I)=SUM/ANI
 2141     CONTINUE
          GOTO2800
C
 2150     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(MINMAX.EQ.1)THEN
              AMIN=0.0
              AMAX=CPUMAX
            ELSE
              AMIN=CPUMIN
              AMAX=0.0
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2151I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2151
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2152K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL WEIPPF(UNIOSM,GAMMA,MINMAX,DISOSM)
              SUM=SUM+DISOSM
 2152       CONTINUE
            X2(I)=SUM/ANI
 2151     CONTINUE
          GOTO2800
C
 2160     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(MINMAX.EQ.1)THEN
              AMIN=CPUMIN
              AMAX=0.0
            ELSE
              AMIN=0.0
              AMAX=CPUMAX
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2161I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2161
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2162K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL EV2PPF(UNIOSM,GAMMA,MINMAX,DISOSM)
              SUM=SUM+DISOSM
 2162       CONTINUE
            X2(I)=SUM/ANI
 2161     CONTINUE
          GOTO2800
C
 2170     CONTINUE
          A=A1
          IF(A.GT.XMIN)A=XMIN
          GAMMA=DISPAR(IDIS)
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=A
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2171I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2171
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2172K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL PARPPF(UNIOSM,GAMMA,A,DISOSM)
              SUM=SUM+DISOSM
 2172       CONTINUE
            X2(I)=SUM/ANI
 2171     CONTINUE
          GOTO2800
C
 2180     CONTINUE
          P=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO2181I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2181
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2182K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GEOPPF(UNIOSM,P,DISOSM)
              SUM=SUM+DISOSM
 2182       CONTINUE
            X2(I)=SUM/ANI
 2181     CONTINUE
          GOTO2800
C
 2190     CONTINUE
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO2191I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2191
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2192K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL POIPPF(UNIOSM,ALAMBA,DISOSM)
              SUM=SUM+DISOSM
 2192       CONTINUE
            X2(I)=SUM/ANI
 2191     CONTINUE
          GOTO2800
C
 2200     CONTINUE
          GAMMA=DISPAR(IDIS)
          AMU=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2201I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2201
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2202K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL IGPPF(UNIOSM,GAMMA,AMU,DISOSM)
              SUM=SUM+DISOSM
 2202       CONTINUE
            X2(I)=SUM/ANI
 2201     CONTINUE
          GOTO2800
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 2210     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2211I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2211
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2212K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL WALPPF(UNIOSM,GAMMA,DISOSM)
              SUM=SUM+DISOSM
 2212       CONTINUE
            X2(I)=SUM/ANI
 2211     CONTINUE
          GOTO2800
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 2220     CONTINUE
          GAMMA=DISPAR(IDIS)
          AMU=DISPA2(IDIS)
          AMUTMP=1.0
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2221I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2221
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2222K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL RIGPPF(UNIOSM,GAMMA,AMUTMP,DISOSM)
              SUM=SUM+DISOSM
 2222       CONTINUE
            X2(I)=SUM/ANI
 2221     CONTINUE
          GOTO2800
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 2230     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2231I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2231
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2232K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL FLPPF(UNIOSM,GAMMA,DISOSM)
              SUM=SUM+DISOSM
 2232       CONTINUE
            X2(I)=SUM/ANI
 2231     CONTINUE
          GOTO2800
C
 2250     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(GAMMA.GE.0.0)THEN
              AMIN=0.0
              AMAX=CPUMAX
            ELSE
              AMIN=0.0
              AMAX=-(1.0/GAMMA)
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2251I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2251
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2252K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GEPPPF(UNIOSM,GAMMA,MINMAX,IGEPDF,DISOSM)
              SUM=SUM+DISOSM
 2252       CONTINUE
            X2(I)=SUM/ANI
 2251     CONTINUE
          GOTO2800
C
 2260     CONTINUE
          SIGMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2261I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2261
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2262K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL LGNPPF(UNIOSM,SIGMA,DISOSM)
              SUM=SUM+DISOSM
 2262       CONTINUE
            X2(I)=SUM/ANI
 2261     CONTINUE
          GOTO2800
C
 2270     CONTINUE
          P=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2271I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2271
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2272K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL PNRPPF(UNIOSM,P,SD,DISOSM)
              SUM=SUM+DISOSM
 2272       CONTINUE
            X2(I)=SUM/ANI
 2271     CONTINUE
          GOTO2800
C
 2280     CONTINUE
          P=DISPAR(IDIS)
          SD=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2281I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2281
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2282K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL PLNPPF(UNIOSM,P,SD,DISOSM)
              SUM=SUM+DISOSM
 2282       CONTINUE
            X2(I)=SUM/ANI
 2281     CONTINUE
          GOTO2800
C
 2290     CONTINUE
          C=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2291I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2291
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2292K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL POWPPF(UNIOSM,C,DISOSM)
              SUM=SUM+DISOSM
 2292       CONTINUE
            X2(I)=SUM/ANI
 2291     CONTINUE
          GOTO2800
C
 2300     CONTINUE
          ANU=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2301I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2301
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2302K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL CHPPF(UNIOSM,ANU,DISOSM)
              SUM=SUM+DISOSM
 2302       CONTINUE
            X2(I)=SUM/ANI
 2301     CONTINUE
          GOTO2800
C
 2310     CONTINUE
          B=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=-PI
            AMAX=PI
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2311I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2311
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2312K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL VONPPF(UNIOSM,B,DISOSM)
              SUM=SUM+DISOSM
 2312       CONTINUE
            X2(I)=SUM/ANI
 2311     CONTINUE
          GOTO2800
C
 2320     CONTINUE
          DELTA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2321I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2321
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2322K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL LLGPPF(UNIOSM,DELTA,DISOSM)
              SUM=SUM+DISOSM
 2322       CONTINUE
            X2(I)=SUM/ANI
 2321     CONTINUE
          GOTO2800
C
 2330     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2331I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2331
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2332K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL LGAPPF(UNIOSM,GAMMA,ILGADF,DISOSM)
              SUM=SUM+DISOSM
 2332       CONTINUE
            X2(I)=SUM/ANI
 2331     CONTINUE
          GOTO2800
C
 2340     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2341I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2341
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2342K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL DWEPPF(UNIOSM,GAMMA,DISOSM)
              SUM=SUM+DISOSM
 2342       CONTINUE
            X2(I)=SUM/ANI
 2341     CONTINUE
          GOTO2800
C
 2350     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
              IF(GAMMA.GT.0.0)THEN
                AMIN=CPUMIN
                AMAX=(1.0/GAMMA) - 0.1E-6
              ELSE
                AMIN=(1.0/GAMMA) + 0.1E-6
                AMAX=CPUMAX
              ENDIF
            ELSE
              IF(GAMMA.GT.0.0)THEN
                AMIN=(-1.0/GAMMA) + 0.1E-6
                AMAX=CPUMAX
              ELSE
                AMIN=CPUMIN
                AMAX=(-1.0/GAMMA) - 0.1E-6
              ENDIF
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2351I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2351
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2352K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GEVPPF(UNIOSM,GAMMA,MINMAX,DISOSM)
              SUM=SUM+DISOSM
 2352       CONTINUE
            X2(I)=SUM/ANI
 2351     CONTINUE
          GOTO2800
C
 2360     CONTINUE
          IF(A.LE.0.0)A=1.0
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2361I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2361
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2362K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL PA2PPF(UNIOSM,GAMMA,A,DISOSM)
              SUM=SUM+DISOSM
 2362       CONTINUE
            X2(I)=SUM/ANI
 2361     CONTINUE
          GOTO2800
C
 2370     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0/GAMMA
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2371I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2371
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2372K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL HFLPPF(UNIOSM,GAMMA,DISOSM)
              SUM=SUM+DISOSM
 2372       CONTINUE
            X2(I)=SUM/ANI
 2371     CONTINUE
          GOTO2800
C
 2380     CONTINUE
          P=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=2.0*PI
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2381I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2381
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2382K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL WCAPPF(UNIOSM,P,DISOSM)
              SUM=SUM+DISOSM
 2382       CONTINUE
            X2(I)=SUM/ANI
 2381     CONTINUE
          GOTO2800
C
 2390     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2391I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2391
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2392K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GLOPPF(UNIOSM,ALPHA,DISOSM)
              SUM=SUM+DISOSM
 2392       CONTINUE
            X2(I)=SUM/ANI
 2391     CONTINUE
          GOTO2800
C
 2400     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2401I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2401
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2402K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL DGAPPF(UNIOSM,GAMMA,DISOSM)
              SUM=SUM+DISOSM
 2402       CONTINUE
            X2(I)=SUM/ANI
 2401     CONTINUE
          GOTO2800
C
 2410     CONTINUE
          BETA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2411I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2411
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2412K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL BRAPPF(UNIOSM,BETA,DISOSM)
              SUM=SUM+DISOSM
 2412       CONTINUE
            X2(I)=SUM/ANI
 2411     CONTINUE
          GOTO2800
C
 2420     CONTINUE
          B=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=1.0/B
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2421I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2421
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2422K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL RECPPF(UNIOSM,B,DISOSM)
              SUM=SUM+DISOSM
 2422       CONTINUE
            X2(I)=SUM/ANI
 2421     CONTINUE
          GOTO2800
C
 2430     CONTINUE
          P=DISPAR(IDIS)
          NPAR=NBINOM
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO2431I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2431
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2432K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL BINPPF(UNIOSM,P,NBINOM,DISOSM)
              SUM=SUM+DISOSM
 2432       CONTINUE
            X2(I)=SUM/ANI
 2431     CONTINUE
          GOTO2800
C
 2440     CONTINUE
          P=DISPAR(IDIS)
          AK=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO2441I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2441
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2442K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL NBPPF(UNIOSM,P,AK,DISOSM)
              SUM=SUM+DISOSM
 2442       CONTINUE
            X2(I)=SUM/ANI
 2441     CONTINUE
          GOTO2800
C
 2450     CONTINUE
          THETA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO2451I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2451
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2452K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL DLGPPF(UNIOSM,THETA,DISOSM)
              SUM=SUM+DISOSM
 2452       CONTINUE
            X2(I)=SUM/ANI
 2451     CONTINUE
          GOTO2800
C
 2460     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2461I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2461
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2462K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL IGAPPF(UNIOSM,GAMMA,DISOSM)
              SUM=SUM+DISOSM
 2462       CONTINUE
            X2(I)=SUM/ANI
 2461     CONTINUE
          GOTO2800
C
 2470     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2471I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2471
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2472K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL IWEPPF(UNIOSM,GAMMA,DISOSM)
              SUM=SUM+DISOSM
 2472       CONTINUE
            X2(I)=SUM/ANI
 2471     CONTINUE
          GOTO2800
C
 2480     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2481I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2481
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2482K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL LDEPPF(UNIOSM,ALPHA,DISOSM)
              SUM=SUM+DISOSM
 2482       CONTINUE
            X2(I)=SUM/ANI
 2481     CONTINUE
          GOTO2800
C
 2490     CONTINUE
          ZLOWLM=-1.0
          ZUPPLM=1.0
          C=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=-1.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2491I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2491
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2492K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL TRIPPF(UNIOSM,C,ZLOWLM,ZUPPLM,DISOSM)
              SUM=SUM+DISOSM
 2492       CONTINUE
            X2(I)=SUM/ANI
 2491     CONTINUE
          GOTO2800
C
 2500     CONTINUE
          GAMMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2501I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2501
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2502K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GEEPPF(UNIOSM,GAMMA,DISOSM)
              SUM=SUM+DISOSM
 2502       CONTINUE
            X2(I)=SUM/ANI
 2501     CONTINUE
          GOTO2800
C
 2510     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2511I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2511
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2512K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL ERRPPF(UNIOSM,ALPHA,DISOSM)
              SUM=SUM+DISOSM
 2512       CONTINUE
            X2(I)=SUM/ANI
 2511     CONTINUE
          GOTO2800
C
 2520     CONTINUE
          NU=INT(DISPAR(IDIS)+0.5)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2521I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2521
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2522K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL FTPPF(UNIOSM,NU,DISOSM)
              SUM=SUM+DISOSM
 2522       CONTINUE
            X2(I)=SUM/ANI
 2521     CONTINUE
          GOTO2800
C
 2530     CONTINUE
          NU1=INT(DISPAR(IDIS)+0.5)
          NU2=INT(DISPA2(IDIS)+0.5)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2531I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2531
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2532K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL FPPF(UNIOSM,NU1,NU2,DISOSM)
              SUM=SUM+DISOSM
 2532       CONTINUE
            X2(I)=SUM/ANI
 2531     CONTINUE
          GOTO2800
C
 2540     CONTINUE
          ALAMB=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2541I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2541
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2542K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL SNPPF(UNIOSM,ALAMB,ISKNDF,DISOSM)
              SUM=SUM+DISOSM
 2542       CONTINUE
            X2(I)=SUM/ANI
 2541     CONTINUE
          GOTO2800
C
 2550     CONTINUE
          ALAMB=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2551I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2551
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2552K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL SDEPPF(UNIOSM,ALAMB,DISOSM)
              SUM=SUM+DISOSM
 2552       CONTINUE
            X2(I)=SUM/ANI
 2551     CONTINUE
          GOTO2800
C
 2560     CONTINUE
          IF(IADEDF.EQ.'K')THEN
            AK=DISPAR(IDIS)
            ATEMP=AK
          ELSE
            AMU=DISPAR(IDIS)
            ATEMP=AMU
          ENDIF
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2561I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2561
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2562K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL ADEPPF(UNIOSM,ATEMP,IADEDF,DISOSM)
              SUM=SUM+DISOSM
 2562       CONTINUE
            X2(I)=SUM/ANI
 2561     CONTINUE
          GOTO2800
C
 2570     CONTINUE
          SIGMA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2571I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2571
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2572K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL MAXPPF(UNIOSM,SIGMA,DISOSM)
              SUM=SUM+DISOSM
 2572       CONTINUE
            X2(I)=SUM/ANI
 2571     CONTINUE
          GOTO2800
C
 2580     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2581I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2581
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2582K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL MCLPPF(DBLE(UNIOSM),DBLE(ALPHA),DPPF)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
 2582       CONTINUE
            X2(I)=SUM/ANI
 2581     CONTINUE
          GOTO2800
C
 2590     CONTINUE
          P=DISPAR(IDIS)
          AK=AK1
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO2591I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2591
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2592K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL NBPPF(UNIOSM,P,AK,DISOSM)
              SUM=SUM+DISOSM
 2592       CONTINUE
            X2(I)=SUM/ANI
 2591     CONTINUE
          GOTO2800
C
 2600     CONTINUE
          ALAM3=DISPAR(IDIS)
          ALAM4=DISPA2(IDIS)
CCCCC     IF(IGLDDF.EQ.'RAMB')THEN
CCCCC       ZSCALE=1.0
CCCCC       IWRITE='OFF'
CCCCC       CALL GLDCHK(ALAM3,ALAM4,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC       IF(ISIGN.LT.0)ZSCALE=-1.0
CCCCC     ENDIF
C
          IF(ICASP2.EQ.'KS  ')THEN
            IWRITE='ERRO'
            IF(ALAM3.EQ.0.0 .AND. ALAM4.EQ.0.0)THEN
              AMIN=CPUMIN
              AMAX=CPUMAX
            ELSEIF(ALAM3.EQ.0.0)THEN
              AMIN=CPUMIN
              CALL GLDPPF(1.0D0,DBLE(ALAM3),DBLE(ALAM4),DPPF,
     1                    IGLDDF,IWRITE)
              AMAX=REAL(DPPF)
            ELSEIF(ALAM4.EQ.0.0)THEN
              AMAX=CPUMAX
              CALL GLDPPF(0.0D0,DBLE(ALAM3),DBLE(ALAM4),DPPF,
     1                    IGLDDF,IWRITE)
              AMIN=REAL(DPPF)
            ELSE
              CALL GLDPPF(0.0D0,DBLE(ALAM3),DBLE(ALAM4),DPPF,
     1                    IGLDDF,IWRITE)
              AMIN=REAL(DPPF)
              CALL GLDPPF(1.0D0,DBLE(ALAM3),DBLE(ALAM4),DPPF,
     1                    IGLDDF,IWRITE)
              AMAX=REAL(DPPF)
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2601I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2601
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2602K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GLDPPF(DBLE(UNIOSM),DBLE(ALAM3),DBLE(ALAM4),
     1                    DPPF,IGLDDF,IWRITE)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
 2602       CONTINUE
            X2(I)=SUM/ANI
 2601     CONTINUE
          GOTO2800
C
 2610     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2611I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2611
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2612K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL BETPPF(UNIOSM,ALPHA,BETA,DISOSM)
              SUM=SUM+DISOSM
 2612       CONTINUE
            X2(I)=SUM/ANI
 2611     CONTINUE
          GOTO2800
C
 2620     CONTINUE
          C=DISPAR(IDIS)
          ALPHA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2621I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2621
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2622K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GGDPPF(UNIOSM,ALPHA,C,DISOSM)
              SUM=SUM+DISOSM
 2622       CONTINUE
            X2(I)=SUM/ANI
 2621     CONTINUE
          GOTO2800
C
 2630     CONTINUE
          C=DISPAR(IDIS)
          B=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2631I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2631
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2632K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GOMPPF(UNIOSM,C,B,DISOSM)
              SUM=SUM+DISOSM
 2632       CONTINUE
            X2(I)=SUM/ANI
 2631     CONTINUE
          GOTO2800
C
 2640     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2641I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2641
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2642K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL PEXPPF(UNIOSM,ALPHA,BETA,DISOSM)
              SUM=SUM+DISOSM
 2642       CONTINUE
            X2(I)=SUM/ANI
 2641     CONTINUE
          GOTO2800
C
 2650     CONTINUE
          GAMMA=DISPAR(IDIS)
          THETA=DISPA2(IDIS)
          IARG1=1
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2651I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2651
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2652K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL EWEPPF(UNIOSM,GAMMA,THETA,IARG1,DISOSM)
              SUM=SUM+DISOSM
 2652       CONTINUE
            X2(I)=SUM/ANI
 2651     CONTINUE
          GOTO2800
C
 2660     CONTINUE
          ALPHA1=DISPAR(IDIS)
          ALPHA2=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2661I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2661
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2662K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL JSBPPF(UNIOSM,ALPHA1,ALPHA2,DISOSM)
              SUM=SUM+DISOSM
 2662       CONTINUE
            X2(I)=SUM/ANI
 2661     CONTINUE
          GOTO2800
C
 2670     CONTINUE
          ALPHA1=DISPAR(IDIS)
          ALPHA2=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2671I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2671
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2672K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL JSUPPF(UNIOSM,ALPHA1,ALPHA2,DISOSM)
              SUM=SUM+DISOSM
 2672       CONTINUE
            X2(I)=SUM/ANI
 2671     CONTINUE
          GOTO2800
C
 2680     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2681I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2681
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2682K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL ALPPPF(UNIOSM,ALPHA,BETA,DISOSM)
              SUM=SUM+DISOSM
 2682       CONTINUE
            X2(I)=SUM/ANI
 2681     CONTINUE
          GOTO2800
C
 2690     CONTINUE
          THETA=DISPAR(IDIS)
          ANU=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2691I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2691
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2692K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL TSPPPF(UNIOSM,THETA,ANU,DISOSM)
              SUM=SUM+DISOSM
 2692       CONTINUE
            X2(I)=SUM/ANI
 2691     CONTINUE
          GOTO2800
C
 2700     CONTINUE
          NU=INT(DISPAR(IDIS)+0.5)
          ALAMBA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2701I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2701
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2702K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL STPPF(UNIOSM,NU,ALAMBA,DISOSM)
              SUM=SUM+DISOSM
 2702       CONTINUE
            X2(I)=SUM/ANI
 2701     CONTINUE
          GOTO2800
C
 2710     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2711I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2711
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2712K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL IBPPF(UNIOSM,ALPHA,BETA,DISOSM)
              SUM=SUM+DISOSM
 2712       CONTINUE
            X2(I)=SUM/ANI
 2711     CONTINUE
          GOTO2800
C
 2720     CONTINUE
          H=DISPAR(IDIS)
          G=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2721I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2721
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2722K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GHPPF(UNIOSM,G,H,DISOSM,DBLE(UNIOSM),DPPF)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
 2722       CONTINUE
            X2(I)=SUM/ANI
 2721     CONTINUE
          GOTO2800
C
 2730     CONTINUE
          SD=DISPAR(IDIS)
          ALAMBA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2731I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2731
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2732K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL LSNPPF(UNIOSM,ALAMBA,SD,DISOSM)
              SUM=SUM+DISOSM
 2732       CONTINUE
            X2(I)=SUM/ANI
 2731     CONTINUE
          GOTO2800
C
 2740     CONTINUE
          ANU=DISPAR(IDIS)
          ALAMBA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2741I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2741
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2742K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL NCCPPF(UNIOSM,ANU,ALAMBA,DISOSM)
              SUM=SUM+DISOSM
 2742       CONTINUE
            X2(I)=SUM/ANI
 2741     CONTINUE
          GOTO2800
C
 2750     CONTINUE
          ANU=REAL(NU1)
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2751I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2751
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2752K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL NCCPPF(UNIOSM,ANU,ALAMBA,DISOSM)
              SUM=SUM+DISOSM
 2752       CONTINUE
            X2(I)=SUM/ANI
 2751     CONTINUE
          GOTO2800
C
 2760     CONTINUE
          ANU=DISPAR(IDIS)
          ALAMBA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2761I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2761
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2762K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL NCTPPF(UNIOSM,ANU,ALAMBA,DISOSM)
              SUM=SUM+DISOSM
 2762       CONTINUE
            X2(I)=SUM/ANI
 2761     CONTINUE
          GOTO2800
C
 2770     CONTINUE
          ANU=REAL(NU1)
          ALAMBA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2771I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2771
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2772K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL NCTPPF(UNIOSM,ANU,ALAMBA,DISOSM)
              SUM=SUM+DISOSM
 2772       CONTINUE
            X2(I)=SUM/ANI
 2771     CONTINUE
          GOTO2800
C
 2780     CONTINUE
          AM=DISPAR(IDIS)
          SD=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2781I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2781
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2782K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL FNRPPF(UNIOSM,AM,SD,DISOSM)
              SUM=SUM+DISOSM
 2782       CONTINUE
            X2(I)=SUM/ANI
 2781     CONTINUE
          GOTO2800
C
 2790     CONTINUE
          AM=DISPAR(IDIS)
          SD=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO2791I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO2791
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO2792K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL FCAPPF(UNIOSM,AM,SD,DISOSM)
              SUM=SUM+DISOSM
 2792       CONTINUE
            X2(I)=SUM/ANI
 2791     CONTINUE
          GOTO2800
C
22800     CONTINUE
          AMU=DISPAR(IDIS)
          SD=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=AMU
            AMAX=X0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22801I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22801
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22802K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL TNEPPF(UNIOSM,X0,AMU,SD,DISOSM)
              SUM=SUM+DISOSM
22802       CONTINUE
            X2(I)=SUM/ANI
22801     CONTINUE
          GOTO2800
C
22810     CONTINUE
          AMU=AMU1
          SD=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=AMU
            AMAX=X0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22811I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22811
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22812K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL TNEPPF(UNIOSM,X0,AMU,SD,DISOSM)
              SUM=SUM+DISOSM
22812       CONTINUE
            X2(I)=SUM/ANI
22811     CONTINUE
          GOTO2800
C
22820     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO22821I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22821
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22822K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL BBNPPF(UNIOSM,ALPHA,BETA,NU,DISOSM)
              SUM=SUM+DISOSM
22822       CONTINUE
            X2(I)=SUM/ANI
22821     CONTINUE
          GOTO2800
C
22830     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO22831I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22831
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22832K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL POLPPF(UNIOSM,ALPHA,BETA,NU,DISOSM)
              SUM=SUM+DISOSM
22832       CONTINUE
            X2(I)=SUM/ANI
22831     CONTINUE
          GOTO2800
C
22840     CONTINUE
          P=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO22841I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22841
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22842K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL YULPPF(UNIOSM,P,DISOSM)
              SUM=SUM+DISOSM
22842       CONTINUE
            X2(I)=SUM/ANI
22841     CONTINUE
          GOTO2800
C
22850     CONTINUE
          C=DISPAR(IDIS)
          A=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO22851I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22851
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22852K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL WARPPF(UNIOSM,C,A,DISOSM,'NOTR')
              SUM=SUM+DISOSM
22852       CONTINUE
            X2(I)=SUM/ANI
22851     CONTINUE
          GOTO2800
C
22860     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(IFLAG.EQ.1)GOTO2800
          ENDIF
C
          I2=0
          DO22861I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22861
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22862K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL HERPPF(UNIOSM,ALPHA,BETA,DISOSM)
              SUM=SUM+DISOSM
22862       CONTINUE
            X2(I)=SUM/ANI
22861     CONTINUE
          GOTO2800
C
22870     CONTINUE
          ETA=DISPAR(IDIS)
          ZETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22871I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22871
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22872K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL MA2PPF(UNIOSM,ZETA,ETA,DISOSM)
              SUM=SUM+DISOSM
22872       CONTINUE
            X2(I)=SUM/ANI
22871     CONTINUE
          GOTO2800
C
22880     CONTINUE
          AK=DISPAR(IDIS)
          TAU=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22881I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22881
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22882K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GALPPF(DBLE(UNIOSM),DBLE(AK),DBLE(TAU),IADEDF,DPPF)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
22882       CONTINUE
            X2(I)=SUM/ANI
22881     CONTINUE
          GOTO2800
C
22890     CONTINUE
          A=DISPAR(IDIS)
          ALPHA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22891I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22891
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22892K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GMCPPF(DBLE(UNIOSM),DBLE(ALPHA),DBLE(A),DPPF)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
22892       CONTINUE
            X2(I)=SUM/ANI
22891     CONTINUE
          GOTO2800
C
22900     CONTINUE
          ALPHA=DISPAR(IDIS)
          XPAR(1)=0.0D0
          XPAR(2)=1.0D0
          XPAR(3)=DBLE(ALPHA)
C
          IF(ICASP2.EQ.'KS  ')THEN
            IF(ALPHA.GT.0.0)THEN
              AMIN=CPUMIN
              AMAX=1.0/ALPHA
            ELSEIF(ALPHA.LT.0.0)THEN
              AMIN=1.0/ALPHA
              AMAX=CPUMAX
            ELSE
              AMIN=CPUMIN
              AMAX=CPUMAX
            ENDIF
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22901I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22901
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22902K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              DPPF=QUAGLO(DBLE(UNIOSM),XPAR)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
22902       CONTINUE
            X2(I)=SUM/ANI
22901     CONTINUE
          GOTO2800
C
22910     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22911I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22911
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22912K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL BNOPPF(DBLE(UNIOSM),DBLE(ALPHA),DBLE(BETA),DPPF)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
22912       CONTINUE
            X2(I)=SUM/ANI
22911     CONTINUE
          GOTO2800
C
22920     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22921I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22921
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22922K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GL2PPF(DBLE(UNIOSM),DBLE(ALPHA),DPPF)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
22922       CONTINUE
            X2(I)=SUM/ANI
22921     CONTINUE
          GOTO2800
C
22930     CONTINUE
          ALPHA=DISPAR(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22931I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22931
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22932K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GL3PPF(DBLE(UNIOSM),DBLE(ALPHA),DPPF)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
22932       CONTINUE
            X2(I)=SUM/ANI
22931     CONTINUE
          GOTO2800
C
22940     CONTINUE
          P=DISPAR(IDIS)
          Q=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22941I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22941
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22942K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL GL4PPF(DBLE(UNIOSM),DBLE(P),DBLE(Q),DPPF)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
22942       CONTINUE
            X2(I)=SUM/ANI
22941     CONTINUE
          GOTO2800
C
22950     CONTINUE
          ALPHA=DISPAR(IDIS)
          BETA=DISPA2(IDIS)
C
          IF(ICASP2.EQ.'KS  ')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO2800
          ENDIF
C
          I2=0
          DO22951I=1,N1
            NI=D2(I)
            IF(NI.LE.0)GOTO22951
            ANI=NI
            I1=I2+1
            I2=I1+NI-1
            SUM=0.0
            DO22952K=I1,I2
              CALL UNIME2(NTOT,K,UNIOSM)
              CALL ALDPPF(DBLE(UNIOSM),DBLE(ALPHA),DBLE(BETA),DPPF)
              DISOSM=REAL(DPPF)
              SUM=SUM+DISOSM
22952       CONTINUE
            X2(I)=SUM/ANI
22951     CONTINUE
          GOTO2800
C
 2800   CONTINUE
C
CCCCC MAY 2004: SUPPORT BIWEIGHT MIDCORRELATION, PERCENTAGE BEND
CCCCC           CORRELATION, AND WINSORIZED CORRELATION AS ALTERNATIVES
CCCCC           TO THE STANDARD CORRELATION FOR THIS PLOT.
      IWRITE='OFF'
C
CCCCC MAY 2004: SUPPORT A "MINIMUM KOLM-SMIR" OPTION.  CALL LINFI2
CCCCC           TO OBTAIN ESTIMATES OF LOCATION AND SCALE, THE CALL
CCCCC           DP1KS2 TO OBTAIN VALUE OF K-S STATISTIC.
C
        IF(ICASP2.EQ.'KS  ')THEN
C
          ICASP3=ICASPL
          IF(ICASP3.EQ.'GMLP')THEN
            ICASP3='GMCP'
          ELSEIF(ICASP3(3:4).EQ.'CP')THEN
            ICASP3(3:4)='PP'
          ELSEIF(ICASP3(2:3).EQ.'CP')THEN
            ICASP3(2:3)='PP'
          ENDIF
          IF(KSLOC.EQ.CPUMIN .AND. KSSCAL.EQ.CPUMIN .AND.
     1       IFLAG.EQ.0)THEN
C
C  HANDLE BETA SEPARATELY
C

            IF(ICASPL.EQ.'BECP')THEN
              IF(XMIN.GE.0.0 .AND. XMIN.LE.1.0 .AND.
     1           XMAX.GE.0.0 .AND. XMAX.LE.1.0)THEN
                A0TEMP=0.0
                A1TEMP=1.0
              ELSE
                A0TEMP=XMIN-EPS
                A1TEMP=XMAX+EPS
              ENDIF
C
C  HANDLE TUKEY-LAMBDA SEPARATELY
C
            ELSEIF(ICASPL.EQ.'LACP' .AND. ALAMBA.GT.0.0)THEN
              CALL LINFI2(Y2,X2,N1,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
              IF((XMIN-A0TEMP)/A1TEMP.LT.AMIN .OR.
     1           (XMAX-A0TEMP)/A1TEMP.GT.AMAX)THEN
                A0TEMP=XMED
                ATEMP1=ALAMBA*ABS(XMAX-A0TEMP) + 0.1
                ATEMP2=ALAMBA*ABS(XMIN-A0TEMP) + 0.1
                A1TEMP=MAX(ATEMP1,ATEMP2)
              ENDIF
C
C  HANDLE CASE WHERE DOMAIN BOUNDED BOTH ABOVE AND BELOW.  SOLVE
C
C     (XMIN-A0TEMP)/A1TEMP = AMIN
C     (XMAX-A0TEMP)/A1TEMP = AMAX
C
            ELSEIF(AMIN.GT.CPUMIN .AND. AMAX.LT.CPUMAX)THEN
              CALL LINFI2(Y2,X2,N1,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
             IF((XMIN-A0TEMP)/A1TEMP.LT.AMIN .OR.
     1           (XMAX-A0TEMP)/A1TEMP.GT.AMAX)THEN
                CMIN=AMIN
                CMAX=AMAX
                CONST=CMIN/CMAX
                A0TEMP=(XMIN-CONST*XMAX)/(1.0+CONST) - EPS
                A1TEMP=(XMAX-A0TEMP)/CMAX + EPS
              ENDIF
C
C  HANDLE CASE WHERE DOMAIN BOUNDED ON MINIMUM ONLY
C 
            ELSEIF(AMIN.GT.CPUMIN .AND. AMAX.EQ.CPUMAX)THEN
              CALL LINFI2(Y2,X2,N1,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
              IF(XMIN-A0TEMP.LT.AMIN)A0TEMP=XMIN-EPS
C
C  HANDLE CASE WHERE DOMAIN BOUNDED ON MAXIMUM ONLY
C
            ELSEIF(AMIN.EQ.CPUMIN .AND. AMAX.LT.CPUMAX)THEN
              CALL LINFI2(Y2,X2,N1,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
              CTEMP=(XMAX-A0TEMP)/A1TEMP
              IF(CTEMP.GE.AMAX)THEN
                A0TEMP=(XMAX-EPS) - A1TEMP*AMAX
              ENDIF
C
C  HANDLE UNBOUNDED CASE
C
            ELSE
              CALL LINFI2(Y2,X2,N1,
     1                    A0TEMP,A1TEMP,
     1                    ISUBRO,IBUGG3,IERROR)
            ENDIF
C
          ELSE
            A0TEMP=KSLOC
            A1TEMP=KSSCAL
          ENDIF
C
          XTEMP3(IDIS)=A0TEMP
          XTEMP4(IDIS)=A1TEMP
C
CCCCC OCTOBER 2004.  FOR BINNED DATA, USE CHI-SQUARE TEST INSTEAD
CCCCC OF K-S TEST SINCE CHI-SQUARE IS SPECIFICALLY FOR BINNED
CCCCC DATA.  CALL DPCOMB TO COMBINE FREQUENCIES WITH LESS THAN
CCCCC 5 OBSERVATIONS.
C
CCCCC     IF(IFLAG.EQ.0)THEN
CCCCC       CALL DP1KS2(X1,N1,ICASP3,
CCCCC1                  ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,
CCCCC1                  NPAR,P,K,MINMAX,
CCCCC1                  ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,
CCCCC1                  MPAR,B,SD,THETA,
CCCCC1                  DELTA,A,AM,X0,
CCCCC1                  U1,SD1,U2,SD2,DZ,
CCCCC1                  ALAMB3,ALAMB4,ALPHA1,ALPHA2,
CCCCC1                  ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,
CCCCC1                  AMU,XI,CHI,G,H,AK,SIGMA,
CCCCC1                  ETA,ZETA,TAU,Q,
CCCCC1                  A0TEMP,A1TEMP,
CCCCC1                  STATVA,CDF1,CDF2,CDF3,
CCCCC1                  ICAPSW,ICAPTY,
CCCCC1                  IWRITE,IADEDF,IGEPDF,IMAKDF,IBEIDF,
CCCCC1                  ILGADF,ISKNDF,IGLDDF,
CCCCC1                  XTEMP1,XTEMP2,NXTEMP,IBUGG3,IERROR)
CCCCC     ELSE
            IRHSTG='AREA'
            CLWID=CPUMIN
            XSTART=CPUMIN
            XSTOP=CPUMAX
            IF(IDATSW.EQ.'FREQ')THEN
              IDATS2='FREQ'
            ELSE
              IDATS2='CLAS'
            ENDIF
C
            CALL DPCHS2(Y3,XLOW,XHIGH,N3,ICASP3,IDATS2,IRHSTG,
     1                  ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,
     1                  NPAR,P,K,MINMAX,
     1                  ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,
     1                  MPAR,B,SD,THETA,
     1                  DELTA,A,AM,X0,
     1                  U1,SD1,U2,SD2,DZ,ANU3,
     1                  ALAMB3,ALAMB4,ALPHA1,ALPHA2,
     1                  ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,
     1                  AMU,XI,CHI,G,H,AK,SIGMA,
     1                  ETA,ZETA,TAU,Q,
     1                  CLWID,XSTART,XSTOP,
     1                  XTEMP9,IHSTCW,MAXOBV,
     1                  A0TEMP,A1TEMP,
     1                  STATVA,STATCD,STATNU,CDF1,CDF2,CDF3,
     1                  ICAPSW,ICAPTY,IWRITE,
     1                  IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1                  ILGADF,ISKNDF,IGLDDF,
     1                  XTEMP1,XTEMP2,XTEMP7,XTEMP8,NXTEMP,
     1                  IBUGG3,IERROR)
CCCCC     ENDIF
          CORRV(IDIS)=STATVA
          IF(CORRV(IDIS).LT.PPCCMX .OR. PPCCMX.EQ.CPUMIN)THEN
            A0SAVE=XTEMP3(IDIS)
            A1SAVE=XTEMP4(IDIS)
            PPCCMX=CORRV(IDIS)
            SHAPMX=DISPAR(IDIS)
          ENDIF
        ELSE
          CALL CORR(Y2,X2,N1,IWRITE,CC,IBUGG3,IERROR)
          CORRV(IDIS)=CC
          CALL LINFI2(Y2,X2,N1,
     1                A0TEMP,A1TEMP,
     1                ISUBRO,IBUGG3,IERROR)
C
          IF(CORRV(IDIS).GT.PPCCMX)THEN
            A0SAVE=A0TEMP
            A1SAVE=A1TEMP
            PPCCMX=CORRV(IDIS)
            SHAPMX=DISPAR(IDIS)
          ENDIF
C
          IF(IPPCCC.EQ.'WINS')THEN
            IHP='P1  '
            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
              PROP1=10.0
            ELSE
              PROP1=VALUE(ILOCP)
            ENDIF
            IF(PROP1.LE.0.0 .OR. PROP1.GE.25.0)PROP1=10.0
C
            IHP='P2  '
            IHP2='    '
            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
              PROP2=10.0
            ELSE
              PROP2=VALUE(ILOCP)
            ENDIF
            IF(PROP2.LE.0.0 .OR. PROP2.GE.25.0)PROP2=10.0
C
            CALL WINSOR(Y2,N1,PROP1,PROP2,IWRITE,XTEMP1,MAXOBV,XTEMP2,
     1                  IBUGG3,IERROR)
            DO13072I=1,N1
              Y1(I)=XTEMP2(I)
13072       CONTINUE
            CALL WINSOR(X2,N1,PROP1,PROP2,IWRITE,XTEMP1,MAXOBV,XTEMP2,
     1                  IBUGG3,IERROR)
            DO13074I=1,N1
              X2(I)=XTEMP2(I)
13074       CONTINUE
            CALL CORR(Y2,X2,N1,IWRITE,CC,IBUGG3,IERROR)
            CORRZ(IDIS)=CC
          ELSEIF(IPPCCC.EQ.'PERB')THEN
            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=0.1
            ELSE
              BETA=VALUE(ILOCP)
            ENDIF
            IF(BETA.LE.0.0 .OR. BETA.GE.0.25)BETA=0.1
C
            CALL PBNCOR(Y2,X2,N1,IWRITE,XTEMP1,XTEMP2,MAXOBV,
     1                  CC,BETA,
     1                  IBUGG3,IERROR)
            CORRZ(IDIS)=CC
          ELSEIF(IPPCCC.EQ.'BIWE')THEN
            CALL BIWMDV(Y2,N1,IWRITE,XTEMP1,XTEMP2,MAXOBV,VAR1,
     1                  IBUGG3,IERROR)
            CALL BIWMDV(X2,N1,IWRITE,XTEMP1,XTEMP2,MAXOBV,VAR2,
     1                  IBUGG3,IERROR)
            CALL BIWMCV(Y2,X2,N1,IWRITE,XTEMP1,XTEMP2,MAXOBV,COV,
     1                  IBUGG3,IERROR)
            CC=0.0
            IF(COV.GT.0.0)CC=COV/SQRT(VAR1*VAR2)
            CORRZ(IDIS)=CC
          ENDIF
        ENDIF
C
CCCCC OCTOBER 2004: WRITE PPCC VALUE, LOCATION, SHAPE, AND
CCCCC               SHAPE PARAMETERS TO DPST2F.DAT.
C
        IF(NUMSHA.LE.1)THEN
          WRITE(IOUNI2,'(I8,4E15.7)')IIREPL-1,CORRV(IDIS),
     1                               A0TEMP,A1TEMP,DISPAR(IDIS)
        ELSE
          WRITE(IOUNI2,'(I8,5E15.7)')IIREPL-1,CORRV(IDIS),A0TEMP,
     1                               A1TEMP,DISPAR(IDIS),DISPA2(IDIS)
        ENDIF
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PPC2')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2831)NUMDIS,IDIS,DISPAR(IDIS)
 2831     FORMAT('NUMDIS,IDIS,DISPAR(IDIS) = ',2I8,E15.7)
          CALL DPWRST('XXX','BUG ')
          DO2832I=1,N1
            WRITE(ICOUT,2833)I,Y1(I),X1(I),Y2(I),X2(I),D2(I)
 2833       FORMAT('I,Y1(I),X1(I),Y2(I),X2(I),D2(I) = ',I8,5G15.7)
            CALL DPWRST('XXX','BUG ')
 2832     CONTINUE
          WRITE(ICOUT,2834)ICASPL,IDATSW
 2834     FORMAT('ICASPL,IDATSW = ',A4,2X,A4)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2835)NUMDIS,IDIS,DISPAR(IDIS),CORRV(IDIS)
 2835     FORMAT('NUMDIS,IDIS,DISPAR(IDIS),CORRV(IDIS) = ',2I8,2E15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
 2105   CONTINUE
C
 2900   CONTINUE
C
CCCCC THREE BASIC CASES:
C
C       1) ONE SHAPE PARAMETER
C       2) TWO SHAPE PARAMETERS - GENERATE MULTI-TRACE PLOT
C       3) TWO SHAPE PARAMETERS - GENERATE A 3D-PLOT
C
C       FOR EACH OF THESE, THERE ARE SEVERAL SUB-CASES TO CONSIDER:
C
C       1) K-S PLOT PRINTS LOCATION AND SCALE ESTIMATES USED (FOR
C          CONTINUOUS DISTRIBUTIONS ONLY)
C       2) PPCC PLOT MAY PRINT AN ALTERNATE ESTIMATE OF CORRELATION
C          AS A SECOND TRACE
C       3) EXTREME VALUE PLOT WILL PRINT SEPARATE TRACES FOR MIN AND
C          MAX CASES
C
        AHOLD=CPUMIN
        ATAG=0.0
C
CCCCC   CASE 1: ONE SHAPE PARAMETER
C
        IF(NUMSHA.EQ.1)THEN
          NLAST=NUMDIS
          IF(ICASPL.EQ.'EVCP')NLAST=NUMD1
          DO2930IDIS=1,NLAST
            ICNTPT=ICNTPT+1
            IF(ICASPL.NE.'EVCP' .OR. IPPCCC.EQ.'LINE')THEN
              Y2TEMP(ICNTPT)=CORRV(IDIS)
            ELSE
              Y2TEMP(ICNTPT)=CORRZ(IDIS)
            ENDIF
            X2TEMP(ICNTPT)=DISPAR(IDIS)
            D2TEMP(ICNTPT)=REAL(IIREPL)
            IF(IFLAG.EQ.0 .AND. ICASP2.EQ.'KS  ')THEN
              WRITE(IOUNI1,'(5E15.7,I8)')Y2TEMP(ICNTPT),
     1                                   XTEMP3(IDIS),XTEMP4(IDIS),
     1                                   X2TEMP(ICNTPT),
     1                                   D2TEMP(ICNTPT),IIREPL-1
            ELSE
              WRITE(IOUNI1,'(3E15.7,I8)')Y2TEMP(ICNTPT),
     1                                   X2TEMP(ICNTPT),
     1                                   D2TEMP(ICNTPT),IIREPL-1
            ENDIF
 2930     CONTINUE
          N2=ICNTPT
          NPLOTV=2
C
          IF(ICASPL.EQ.'EVCP')THEN
            NUMD1P=NUMD1+1
            DO2932IDIS=NUMD1P,NUMDIS
              ICNTPT=ICNTPT+1
              Y2TEMP(ICNTPT)=CORRV(IDIS)
              IF(IPPCCC.NE.'LINE')Y2TEMP(ICNTPT)=CORRZ(IDIS)
              X2TEMP(ICNTPT)=DISPAR(IDIS)
              D2TEMP(ICNTPT)=REAL(IIREPL)*2.0
 2932       CONTINUE
            N2=ICNTPT
            NPLOTV=3
          ELSEIF(IPPCCC.NE.'LINE' .AND. ICASP2.EQ.'PPCC')THEN
            NUMD1P=NUMD1+1
            DO2934IDIS=1,NUMDIS
              ICNTPT=ICNTPT+1
              Y2TEMP(ICNTPT)=CORRZ(IDIS)
              X2TEMP(ICNTPT)=DISPAR(IDIS)
              D2TEMP(ICNTPT)=REAL(IIREPL)*2.0
 2934       CONTINUE
            N2=ICNTPT
            NPLOTV=3
          ENDIF
C
CCCCC CASE 2: TWO SHAPE PARAMETERS, MULTI-TRACE PLOT
C
        ELSEIF(NUMSHA.EQ.2 .AND. IPPCFO.EQ.'TRAC')THEN
          DO2940IDIS=1,NUMDIS
            IF(DISPAR(IDIS).NE.AHOLD)THEN
              ATAG=ATAG+1.0
              AHOLD=DISPAR(IDIS)
            ENDIF
            ICNTPT=ICNTPT+1
            IF(ICASP2.EQ.'PPCC' .AND. IPPCCC.NE.'LINE')THEN
              Y2TEMP(ICNTPT)=CORRZ(IDIS)
            ELSE
              Y2TEMP(ICNTPT)=CORRV(IDIS)
            ENDIF
            IF(IPPCAO.EQ.'DEFA')THEN
              X2TEMP(ICNTPT)=DISPA2(IDIS)
              X3D2(ICNTPT)=DISPAR(IDIS)
            ELSE
              X3D2(ICNTPT)=DISPA2(IDIS)
              X2TEMP(ICNTPT)=DISPAR(IDIS)
            ENDIF
            D2TEMP(ICNTPT)=ATAG
            IF(IFLAG.EQ.0 .AND. ICASP2.EQ.'KS  ')THEN
              WRITE(IOUNI1,'(6E15.7)')Y2TEMP(ICNTPT),
     1                                XTEMP3(IDIS),XTEMP4(IDIS),
     1                                X2TEMP(ICNTPT),X3D2(ICNTPT),
     1                                D2TEMP(ICNTPT)
            ELSE
              WRITE(IOUNI1,'(4E15.7)')Y2TEMP(ICNTPT),
     1                                X2TEMP(ICNTPT),X3D2(ICNTPT),
     1                                D2TEMP(ICNTPT)
            ENDIF
 2940     CONTINUE
          N2=ICNTPT
          NPLOTV=3
C
CCCCC CASE 3: TWO SHAPE PARAMETERS, 3D-PLOT
C
        ELSEIF(NUMSHA.EQ.2 .AND. IPPCFO.EQ.'3D  ')THEN
          IWRITE='OFF'
          CALL DISTIN(DISPA2,NUMDIS,IWRITE,DISPA3,NTEMP,IBUGG3,IERROR)
          IF(IERROR.EQ.'YES'.OR.IERROR.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2941)
 2941       FORMAT('****** ERROR FROM PPCC PLOT DURING CALL TO DISTIN')
            CALL DPWRST('XXX','BUG ')
            GOTO9000
          ENDIF
C
          DO2960IDIS=1,NUMDIS
            IF(DISPAR(IDIS).NE.AHOLD)THEN
              ATAG=ATAG+1.0
              AHOLD=DISPAR(IDIS)
            ENDIF
            ICNTPT=ICNTPT+1
            IF(ICASP2.EQ.'PPCC' .AND. IPPCCC.NE.'LINE')THEN
              Y2TEMP(ICNTPT)=CORRZ(IDIS)
            ELSE
              Y2TEMP(ICNTPT)=CORRV(IDIS)
            ENDIF
            IF(IPPCAO.EQ.'DEFA')THEN
              X2TEMP(ICNTPT)=DISPAR(IDIS)
              X3D2(ICNTPT)=DISPA2(IDIS)
            ELSE
              X3D2(ICNTPT)=DISPAR(IDIS)
              X2TEMP(ICNTPT)=DISPA2(IDIS)
            ENDIF
            D2TEMP(ICNTPT)=ATAG
            IF(IFLAG.EQ.0 .AND. ICASP2.EQ.'KS  ')THEN
              WRITE(IOUNI1,'(6E15.7)')Y2TEMP(ICNTPT),
     1                                XTEMP3(IDIS),XTEMP4(IDIS),
     1                                X2TEMP(ICNTPT),X3D2(ICNTPT),
     1                                D2TEMP(ICNTPT)
            ELSE
              WRITE(IOUNI1,'(4E15.7)')Y2TEMP(ICNTPT),
     1                                X2TEMP(ICNTPT),X3D2(ICNTPT),
     1                                D2TEMP(ICNTPT)
            ENDIF
 2960     CONTINUE
C
          DO2970J=1,NTEMP
            AHOLD=DISPA3(J)
            ATAG=ATAG+1.0
            DO2975IDIS=1,NUMDIS
              IF(DISPA2(IDIS).EQ.AHOLD)THEN
                ICNTPT=ICNTPT+1
                IF(ICASP2.EQ.'PPCC' .AND. IPPCCC.NE.'LINE')THEN
                  Y2TEMP(ICNTPT)=CORRZ(IDIS)
                ELSE
                  Y2TEMP(ICNTPT)=CORRV(IDIS)
                ENDIF
                IF(IPPCAO.EQ.'DEFA')THEN
                  X2TEMP(ICNTPT)=DISPAR(IDIS)
                  X3D2(ICNTPT)=DISPA2(IDIS)
                ELSE
                  X3D2(ICNTPT)=DISPAR(IDIS)
                  X2TEMP(ICNTPT)=DISPA2(IDIS)
                ENDIF
                D2TEMP(ICNTPT)=ATAG
              ENDIF
 2975       CONTINUE
 2970     CONTINUE
C
          N2=ICNTPT
          NPLOTV=3
        ENDIF
C
        WRITE(IOUNI3,'(I8,3E15.7)')IIREPL-1,SHAPMX,A0SAVE,A1SAVE
C
72000 CONTINUE
C
      DO72910II=1,ICNTPT
        X2(II)=X2TEMP(II)
        Y2(II)=Y2TEMP(II)
        D2(II)=D2TEMP(II)
72910 CONTINUE
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1            IENDF1,IREWI1,ISUBN0,IERRF1,IBUGG3,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,IBUGG3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1            IENDF3,IREWI3,ISUBN0,IERRF3,IBUGG3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PPC2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPPC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IDATSW,N2,IERROR
 9012 FORMAT('ICASPL,IDATSW,N2,IERROR = ',A4,2X,A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NTOT
 9014 FORMAT('NTOT = ',I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MAY 1993
      WRITE(ICOUT,9015)MINMAX
 9015 FORMAT('MINMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 3 LINES WERE ADDED    DECEMBER 1993
      DO9020I=1,N2
      WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I)
 9021 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPPD(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PHASE PLANE DIAGRAM
C              (USED IN TIME SERIES MODELING).
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--89/8
C     ORIGINAL VERSION--JULY      1989.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHVA21
      CHARACTER*4 IHVA22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(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
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPPP'
      ISUBN2='D   '
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 PHASE PLANE DIAGRAM CASE   **
C               *************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPPD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'PHAS'.AND.IHARG(1).EQ.'PLAN'.AND.
     1IHARG(2).EQ.'DIAG')GOTO112
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'PHAS'.AND.IHARG(1).EQ.'PLAN'.AND.
     1IHARG(2).EQ.'PLOT')GOTO112
C
      IFOUND='NO'
      GOTO9000
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               *******************************************************
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
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)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPPPD--')
      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 PHASE PLANE DIAGRAM ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 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               **  (EITHER 1 OR 2)                          **
C               **  ALSO, FOR THE 2-VARIABLE CASE,           **
C               **  CHECK THE VALIDITY                       **
C               **  OF THE SECOND VARIABLE.                  **
C               **  DOES THE NAME EXIST IN THE TABLE?        **
C               **  DOES THE NUMBER OF ELEMENTS              **
C               **  IN THE SECOND VARIABLE                   **
C               **  AGREE WITH THE NUMBER OF ELEMENTS        **
C               **  IN THE FIRST VARIABLE?                   **
C               ***********************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO509
      GOTO550
C
  509 CONTINUE
      ICASPL='    '
      IF(NUMV2.EQ.1)ICASPL='PPD1'
      IF(NUMV2.EQ.2)ICASPL='PPD2'
      IF(NUMV2.LE.1)GOTO590
      IHVA21=IHARG(2)
      IHVA22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVA21,IHVA22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLV2=IVALUE(ILOCV)
      NVAR2=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,511)IHVA21,IHVA22,ICOLV2,NVAR2
  511 FORMAT('IHVA21,IHVA22,ICOLV2,NVAR2 = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NVAR2.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPPPD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A 2-VARIABLE PHASE PLANE DIAGRAM, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)
  553 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)
  556 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)NUMV2
  557 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPPPD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A 2-VARIABLE PHASE PLANE DIAGRAM, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,573)
  573 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,574)
  574 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,575)
  575 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,576)
  576 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,577)IHLEFT,IHLEF2,NLEFT
  577 FORMAT('      THE FIRST  VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)IHVA21,IHVA22,NVAR2
  578 FORMAT('      THE SECOND VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,580)(IANS(I),I=1,IWIDTH)
  580 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               **********************************************
C               **  STEP 7--                                **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE FIRST  VARIABLE; **
C               **  ALSO, FOR A 2-VARIABLE PHASE PLANE DIAGRAM,        **
C               **  FORM THE VARIABLE Y2(.)                 **
C               **  WHICH WILL CONTAIN THE SECOND VARIABLE. **
C               **  FORM THESE VARIABLES BY                 **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO610
      IF(ICASQ.EQ.'SUBS')GOTO620
      IF(ICASQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      IF(NQ.GE.MINN2)GOTO660
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,651)
  651 FORMAT('***** ERROR IN DPPPD--')
      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 A 1- OR 2-VARIABLE ',
     1'PHASE PLANE DIAGRAM ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,655)
  655 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,656)MINN2
  656 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,657)
  657 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,658)
  658 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,659)(IANS(I),I=1,IWIDTH)
  659 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  660 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO670I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO670
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
CCCCC IF(MAXV2.LE.1)GOTO670    JUNE 9, 1987
      IF(NUMV2.LE.1)GOTO670
C
      IJ=MAXN*(ICOLV2-1)+I
      IF(ICOLV2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLV2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLV2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLV2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLV2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLV2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLV2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
  670 CONTINUE
      NS=J
C
C               ****************************************************************
C               **  STEP 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 BOTH ONES FOR BOTH CASES                      *
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 DPPPD2(Y1,Y2,NS,ICASPL,
     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 DPPPD--')
      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 DPPPD2(Y1,Y2,N,ICASPL,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C                   1) A 1-VARIABLE PHASE PLANE DIAGRAM
C                   2) A 2-VARIABLE PHASE PLANE DIAGRAM
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --JANUARY   1989.  DIVISION BY 0 TRAP
C     UPDATED         --APRIL     1992.  ICASPLN TO ICASPL
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='DPPP'
      ISUBN2='D2  '
C
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('***** AT THE BEGINNING OF DPPPD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL
   71 FORMAT('N,ICASPL = ',I8,2X,A4)
      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
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPPPD2--')
      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 DPPPD2--')
      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
C               **************************************
C               **  STEP 3--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  AND DETERMINE PLOT COORDINATES  **
C               **************************************
C
      IF(ICASPL.EQ.'PPD1')GOTO1100
      IF(ICASPL.EQ.'PPD2')GOTO1200
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPPPD2 ',
     1'AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      ICASPL SHOULD BE EITHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      PPD1  OR   PPD2, BUT IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)ICASPL
 1014 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *****************************************
C               **  STEP 4.1--                         **
C               **  FORM THE 1-VARIABLE PHASE PLANE DIAGRAM  **
C               *****************************************
C
 1100 CONTINUE
      IMIN=1
      IMAX=N-1
      J=0
      DO1110I=IMIN,IMAX
      J=J+1
      IP1=I+1
      Y(J)=Y1(IP1)-Y1(I)
      X(J)=Y1(I)
      D(J)=1.0
 1110 CONTINUE
      NPLOTP=J
      NPLOTV=2
      GOTO9000
C
C               *****************************************
C               **  STEP 4.2--                         **
C               **  FORM THE 2-VARIABLE PHASE PLANE DIAGRAM  **
C               *****************************************
C
 1200 CONTINUE
      IMIN=1
      IMAX=N-1
      J=0
      DO1210I=IMIN,IMAX
      J=J+1
      IP1=I+1
      ANUM=Y1(IP1)-Y1(I)
      ADEN=Y2(IP1)-Y2(I)
C
      IF(ADEN.EQ.0.0)GOTO1230
      GOTO1239
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1231)
 1231 FORMAT('***** ERROR IN DPPPD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1232)
 1232 FORMAT('      A DIVISION BY ZERO WAS ATTEMPTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1233)
 1233 FORMAT('      BECAUSE THE INPUT DATA HAD 2 REPEATED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1234)
 1234 FORMAT('      X VALUES AND THEREFORE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1235)
 1235 FORMAT('      YIELDED A 0 IN THE COMPUTATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1236)
 1236 FORMAT('      OF DELY / DELX   .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1237)Y2(I)
 1237 FORMAT('      THE REPEAT WAS AT X = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1239 CONTINUE
C
      Y(J)=ANUM/ADEN
      X(J)=Y1(I)
      D(J)=1.0
 1210 CONTINUE
      NPLOTP=J
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPPD2--')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,9012)ICASPLN,NPLOTP,IERROR
C9012 FORMAT('ICASPLN,NPLOTP,IERROR = ',A4,2I8,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,NPLOTP,IERROR
 9012 FORMAT('ICASPL,NPLOTP,IERROR = ',A4,2I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPRCL(XTEMP1,XTEMP2,MAXNXT,ICASAN,ANOPL1,ANOPL2,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE (SYMMETRIC) CONFIDENCE LIMITS FOR THE
C              PROPORTION OF SUCCESSES FOR PROBABILITY VALUE
C              P = .90, .95, .99, .999, AND .9999.
C              ALSO HANDLE THE DIFFERENCE OF TWO PROPORTIONS.
C              NOTE: 1 = SUCCESS, 0 = FAILURE
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
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPCO'
      ISUBN2='NF  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXV2=1
      IF(ICASAN.EQ.'DPRO')MAXV2=2
      MINN2=2
      NUMVAR=(-999)
C
      IFOUND='YES'
C
      NLEFT=0
      N2=0
C
      ICASEQ='UNKN'
C
C               ***************************************************
C               **  TREAT THE PROPORTION CONFIDENCE LIMITS 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 DPPRCL--')
      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)ICASAN
   56 FORMAT('ICASAN = ',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(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      NUMVAR=1
C
C               ******************************************************
C               **  STEP 4--                                        **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
C               **  (NLEFT) 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 DPPRCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FROM WHICH CONFIDENCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WERE TO HAVE BEEN CALCULATED)')
      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 3A--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS MUST BE A VARIABLE          **
C               ****************************************
C
      ISTEPN='3A'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASAN.NE.'DPRO')GOTO440
      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)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
      NUMVAR=2
C
C               ********************************************************
C               **  STEP 3B--                                         **
C               **  IF ARGUMENT 2 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2)  **
C               **  FOR ARGUMENT 2 IS 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='3B'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N2.GE.MINN2)GOTO419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,401)
  401 FORMAT('***** ERROR IN DPPRCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,402)
  402 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,403)
  403 FORMAT('      A DIFFERENCE OF PROPORTIONS CONFIDENCE INTERVAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,404)
  404 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,405)MINN2
  405 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,406)
  406 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,407)IH21,IH22
  407 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,408)N2
  408 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,409)
  409 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,410)(IANS(I),I=1,MAX(IWIDTH,80))
  410 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  419 CONTINUE
C
C               ********************************************************
C               **  STEP 3C--                                         **
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='3B'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(N2.NE.NLEFT)GOTO439
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,421)
CC421 FORMAT('***** ERROR IN DPPRCL--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,422)
CC422 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,423)
CC423 FORMAT('      A DIFFERENCE OF PROPORTIONS CONFIDENCE INTERVAL')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,424)
CC424 FORMAT('      WAS TO HAVE BEEN CARRIED OUT MUST HAVE THE')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,425)MINN2
CC425 FORMAT('      SAME NUMNER OF OBSERVATIONS FOR BOTH VARIABLES.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,426)
CC426 FORMAT('      SUCH WAS NOT THE CASE HERE')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,427)IHLEFT,IHLEF2,NLEFT
CC427 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,427)IH21,IH22,N2
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,429)
CC429 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IF(IWIDTH.GE.1)WRITE(ICOUT,430)(IANS(I),I=1,MAX(IWIDTH,80))
CC430 FORMAT(80A1)
CCCCC IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
  439 CONTINUE
C
  440 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
      DO450J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO460
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO460
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO470
  450 CONTINUE
      GOTO490
  460 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  470 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,MAX(NLEFT,N2)
      ISUB(I)=1
  515 CONTINUE
      NQ=MAX(NLEFT,N2)
      GOTO550
C
  520 CONTINUE
      NIOLD=MAX(NLEFT,N2)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=MAX(NLEFT,N2)
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPPRCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FROM WHICH PROPORTION CONFIDENCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      ARE TO BE CALCULATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,MAX(IWIDTH,80))
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
  570 CONTINUE
      NS=J
C
      IF(NUMVAR.GE.2)THEN
C
        J=0
        IMAX=N2
        IF(NQ.LT.N2)IMAX=NQ
        DO580I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO580
        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
  580   CONTINUE
        NS2=J
      ENDIF
C
C               ******************************************************
C               **  STEP 8--                                        **
C               **  PREPARE FOR ENTRANCE INTO DPPRC2--              **
C               ******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************
C               **  STEP 9--                   **
C               **  FORM THE CONFIDENCE LIMITS **
C               *********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPPRCL, AS WE ARE ABOUT TO CALL DPPRC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,N2,MAXN,NS
 1212 FORMAT('NLEFT,N2,MAXN,NS = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I),X(I)
 1216 FORMAT('I,Y(I),X(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 1290 CONTINUE
C
      CALL DPPRC2(Y,NS,X,NS2,XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1ANOPL1,ANOPL2,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 DPPRCL--')
      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 DPPRC2(Y,N,X,N2,XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1ANOPL1,ANOPL2,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE GENERATES CONFIDENCE LIMITS
C              FOR THE PROPORTIONS
C              FOR THE DATA IN THE INPUT VECTOR Y.
C              ALSO HANDLES THE DIFFERENCE OF TWO PROPORTIONS CASE.
C     NOTE--ASSUMPTION--MODEL IS   RESPONSE = CONSTANT + ERROR.
C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                OF OBSERVATIONS FOR BOTH CASES
C                       X      = THE SINGLE PRECISION VECTOR
C                                OF OBSERVATIONS FOR THE DIFFERENCE
C                                OF PROPORTIONS CASE
C                       N      = THE INTEGER NUMBER OF
C                                OBSERVATIONS IN THE VECTOR Y.
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
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
CCCCC CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION CONF(10)
      DIMENSION T(10)
CCCCC DIMENSION TSDM(10)
      DIMENSION ALOWER(10)
      DIMENSION AUPPER(10)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPPR'
      ISUBN2='C2  '
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 DPPRC2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)N,IBUGA3
   52 FORMAT('N,IBUGA3 = ',I8,2X,A4)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I),X(I)
   57 FORMAT('I,Y(I),X(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)GOTO110
      GOTO119
  110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPPRC2--THE NUMBER OF OBSERVATIONS ',
     1'IN THE RESPONSE VARIABLE IS LESS THAN 2.')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,112)N
  112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
C               ***************************************************
C               **  STEP 3--                                     **
C               **  COMPUTE THE NUMBER OF SUCCESSES.             **
C               ***************************************************
C
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      YMIN=ANOPL1
      IF(ANOPL1.GT.ANOPL2)YMIN=ANOPL2
      YMAX=ANOPL2
      IF(ANOPL1.GT.ANOPL2)YMAX=ANOPL1
C
      AN=REAL(N)
      NR1=0
      DO2120J=1,N
      IF(YMIN.LE.Y(J).AND.Y(J).LE.YMAX)NR1=NR1+1
 2120 CONTINUE
      ANR1=NR1
C
      PR1=ANR1/AN
      IF(ICASAN.EQ.'PROP'.AND.PR1.LE.0.0 .OR. PR1.GE.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,201)
  201 FORMAT('***** ERROR FROM DPPRC2--PROPORTION OF SUCCESSES IS ',
     1'EITHER 0 OR 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,203)
  203   FORMAT('      (EITHER ALL SUCCESSES OR ALL FAILURES).')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(ICASAN.EQ.'DPRO')THEN
        AN2=REAL(N2)
        NR2=0
        DO2130J=1,N2
        IF(YMIN.LE.X(J).AND.X(J).LE.YMAX)NR2=NR2+1
 2130   CONTINUE
        ANR2=NR2
C
        PR2=ANR2/AN2
      ENDIF
C
C               ***************************************
C               **  STEP 4--                         **
C               **  COMPUTE CONFIDENCE LIMITS        **
C               **  FOR VARIOUS PROBABILITY VALUES.  **
C               ***************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CONF(1)=50.0
      CONF(2)=75.0
      CONF(3)=90.0
      CONF(4)=95.0
      CONF(5)=99.0
      CONF(6)=99.9
      CONF(7)=99.99
      CONF(8)=99.999
C
      IF(ICASAN.EQ.'PROP')THEN
        DO1400I=1,8
          PCONF=1.0-(CONF(I)/100.0)
          PCONF=PCONF/2.0
          CDF=1.0-PCONF
          CALL BINPPF(CDF,PR1,N,T(I))
          AUPPER(I)=T(I)/REAL(N)
          CDF=PCONF
          CALL BINPPF(CDF,PR1,N,T(I))
          ALOWER(I)=T(I)/REAL(N)
 1400   CONTINUE
      ELSEIF(ICASAN.EQ.'DPRO')THEN
        PDIFF=PR1-PR2
        PSE=SQRT(PR1*(1.0-PR1)/REAL(N) + PR2*(1.0-PR2)/REAL(N2))
        DO1500I=1,8
          PCONF=1.0-(CONF(I)/100.0)
          PCONF=PCONF/2.0
          CDF=1.0-PCONF
          CALL NORPPF(CDF,T(I))
          AUPPER(I)=PDIFF+PSE*T(I)
          ALOWER(I)=PDIFF-PSE*T(I)
 1500   CONTINUE
      ENDIF
C
C               ****************************
C               **  STEP 7--              **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO890
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      IF(ICASAN.EQ.'PROP')THEN
        WRITE(ICOUT,811)
  811 FORMAT(
     1'                   CONFIDENCE LIMITS FOR A PROPORTION')
      ELSE
        WRITE(ICOUT,911)
  911 FORMAT(
     1'          CONFIDENCE LIMITS FOR DIFFERENCE OF PROPORTIONS')
      ENDIF
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,812)
  812 FORMAT(
     1'                           (2-SIDED)')
      CALL DPWRST('XXX','WRIT')
 
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      IF(ICASAN.EQ.'PROP')THEN
        WRITE(ICOUT,821)N
  821 FORMAT(
     1'          NUMBER OF OBSERVATIONS     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,822)NR1
  822 FORMAT(
     1'          NUMBER OF SUCCESSES        = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,823)PR1
  823 FORMAT(
     1'          PORPORTION OF SUCCESS      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,920)N
  920 FORMAT(
     1'          NUMBER OF OBSERVATIONS FOR SAMPLE 1  = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,922)NR1
  922 FORMAT(
     1'          NUMBER OF SUCCESSES FOR SAMPLE 1     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,923)PR1
  923 FORMAT(
     1'          PORPORTION OF SUCCESS FOR SAMPLE 1   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,930)N2
  930 FORMAT(
     1'          NUMBER OF OBSERVATIONS FOR SAMPLE 2  = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,932)NR2
  932 FORMAT(
     1'          NUMBER OF SUCCESSES FOR SAMPLE 2     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,933)PR2
  933 FORMAT(
     1'          PORPORTION OF SUCCESS FOR SAMPLE 2   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,943)PDIFF
  943 FORMAT(
     1'          DIFFERENCE BETWEEN PROPORTIONS      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        IF(N.LE.30 .OR. N2.LE.30)THEN
        WRITE(ICOUT,946)
  946 FORMAT(
     1'          WARNING: IF EITHER OF THE SAMPLE SIZES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,948)
  948 FORMAT(
     1'          IS LESS THAN 30, THE NORMAL APPROXIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,949)
  949 FORMAT(
     1'          MAY NOT BE ACCURATE.')
        CALL DPWRST('XXX','WRIT')
        ENDIF
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,832)
  832 FORMAT(
     1'   CONFIDENCE   LOWER         UPPER     ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,833)
  833 FORMAT(
     1'   VALUE (%)    LIMIT         LIMIT     ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,834)
  834 FORMAT(
     1'------------------------------------')
      CALL DPWRST('XXX','WRIT')
      DO840I=1,8
      WRITE(ICOUT,841)CONF(I),ALOWER(I),AUPPER(I)
  841 FORMAT(
     1'   ',F8.3,2X,G12.6,2X,G12.6)
      CALL DPWRST('XXX','WRIT')
  840 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
  890 CONTINUE
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 DPPRC2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),X(I)
 9017 FORMAT('I,Y(I),X(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPRE2(Y,X1,X2,X3,X4,X5,NUMVAR,IVARN3,IVARN4,W,N,
     1MODEL,NUMCHA,PARAM3,IPARN3,IPARN4,NUMPAR,ICON3,IANGLU,IPARO3,
     1PARLI3,V,MAXITS,FITSD,FITPOW,CPUEPS,
     1ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,
     1IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IREP,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
CCCCC THE FOLLOWING LINE WAS AUGMENTED     NOVEMBER 1995
CCCCC1DUM1,DUM2,
     1DUM1,DUM2,IANS,IWIDTH,
     1IBUGA3,IBUGCO,IBUGEV,IERROR)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988.      ADD LOFCDF
C     UPDATED         --MAY       1990.      MOVE SOME DIMENSIONING TO DPPREF
C     UPDATED         --NOVEMBER  1995. IANS, IWIDTH => INPUT ARGS
C     UPDATED         --NOVEMBER  1995. ALL ITERATIONS => DPST1F.DAT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IVARN3
      CHARACTER*4 IVARN4
      CHARACTER*4 IPARN3
      CHARACTER*4 IPARN4
      CHARACTER*4 IANGLU
      CHARACTER*4 IPARO3
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW2HOL
      CHARACTER*4 IW22HO
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IREP
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASLS
      CHARACTER*4 IHPN
      CHARACTER*4 IHPN2
      CHARACTER*4 IHPNV
      CHARACTER*4 IHPNV2
      CHARACTER*4 IPARN5
      CHARACTER*4 IPARN6
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IH3
      CHARACTER*4 IH4
      CHARACTER*4 IH5
      CHARACTER*4 IH6
      CHARACTER*4 IH7
      CHARACTER*4 IH8
      CHARACTER*4 IH9
      CHARACTER*4 IH10
      CHARACTER*4 MODEL
      CHARACTER*4 IFOUNF
      CHARACTER*4 IANS
C
CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1995
      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
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBRO
C
CCCCC THE FOLLOWING LINE WAS ADDED     NOVEMBER 1995
      CHARACTER*4 ISMALL
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
CCCCC JUNE 1990.  FOLLOWING INCLUDE FILE NO LONGER NEEDED.
CCCCC       INCLUDE 'DPCOPA.INC'
C
CCCCC THE FOLLOWING INCLUDE STATEMENT WAS ADDED NOVEMBER 1995
      INCLUDE 'DPCOF2.INC'
C
      DIMENSION IHPNV(200)
      DIMENSION IHPNV2(200)
      DIMENSION ASTARV(200)
      DIMENSION AINCV(200)
      DIMENSION ASTOPV(200)
      DIMENSION NUMINV(200)
C
      DIMENSION WORST(200)
      DIMENSION BEST(200)
C
      DIMENSION Y(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
      DIMENSION X3(*)
      DIMENSION X4(*)
      DIMENSION X5(*)
C
      DIMENSION PRED2(*)
      DIMENSION RES2(*)
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION W(*)
C
      DIMENSION V(*)
C
      DIMENSION MODEL(*)
C
      DIMENSION IVARN3(*)
      DIMENSION IVARN4(*)
      DIMENSION PARAM3(*)
      DIMENSION IPARN3(*)
      DIMENSION IPARN4(*)
      DIMENSION ICON3(*)
      DIMENSION IPARO3(*)
      DIMENSION PARLI3(*)
C
      DIMENSION ITYPEH(*)
      DIMENSION IW2HOL(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IPARN5(100)
      DIMENSION IPARN6(100)
      DIMENSION PARAM5(100)
C
CCCCC FOLLOWING TWO ARRAYS NOW DIMENSIONED IN DPPREF (JUNE, 1990)
CCCCC DIMENSION DUM1(MAXOBV)
CCCCC DIMENSION DUM2(MAXOBV)
      DIMENSION DUM1(*)
      DIMENSION DUM2(*)
C
CCCCC THE FOLLOWING LINE WAS ADDED    NOVEMBER 1995
      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='DPPR'
      ISUBN2='E2  '
C
      IERROR='NO'
C
      IPASS=2
C
      IRESDF=0
      IMIN=0
      KMAX=0
      J12=0
      J22=0
      J32=0
      J42=0
      J52=0
      J62=0
      J72=0
      J82=0
      J92=0
      J102=0
      IPAR2=0
      IPAR3=0
      IPAR4=0
      IPAR5=0
      IPAR6=0
      IPAR7=0
      IPAR8=0
      IPAR9=0
      IPAR10=0
C
      IH2='UNKN'
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 DPPRE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NUMVAR,NUMPAR,NUMCHA
   52 FORMAT('N,NUMVAR,NUMPAR,NUMCHA = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA3,IBUGCO,IBUGEV
   53 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y(I),X1(I),W(I)
   56 FORMAT('I,Y(I),X1(I),W(I) = ',I5,3F20.10)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      DO61J=1,NUMVAR
      WRITE(ICOUT,62)J,IVARN3(J),IVARN4(J)
   62 FORMAT('I,IVARN3(I),IVARN4(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
      DO66J=1,NUMPAR
      WRITE(ICOUT,67)J,IPARN3(J),IPARN4(J),PARAM3(J),ICON3(J)
   67 FORMAT('I,IPARN3(I),IPARN4(I),PARAM3(I),ICON3(I) = ',
     1I8,2X,A4,A4,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
   66 CONTINUE
      WRITE(ICOUT,71)(MODEL(J),J=1,NUMCHA)
   71 FORMAT('FUNCTIONAL EXPRESSION--',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)FITPOW
   72 FORMAT('FITPOW = ',E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
CCCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1995
C               **************************************************
C               **  STEP 15--                                   **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
 1500 CONTINUE
      ISTEPN='15'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRE2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='PRE2'
      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
C               **************************************************
C               **  STEP 1--                                    **
C               **  DETERMINE THE PARAMETER NAMES IN THE MODEL  **
C               **  AND THE NUMBER NUMPAR OF PARAMETERS.        **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPASS=2
C
      DO1100I=1,100
      IPARN5(I)='JUNK'
      IPARN6(I)='JUNK'
      PARAM5(I)=-999.0
 1100 CONTINUE
      IF(NUMPAR.LE.0)GOTO1000
      DO1150I=1,NUMPAR
      IPARN5(I)=IPARN3(I)
      IPARN6(I)=IPARN4(I)
      PARAM5(I)=PARAM3(I)
 1150 CONTINUE
 1000 CONTINUE
C
      IF(NUMVAR.LE.0)GOTO1200
      DO1300I=1,NUMVAR
      IPARN5(NUMPAR+I)=IVARN3(I)
      IPARN6(NUMPAR+I)=IVARN4(I)
 1300 CONTINUE
 1200 CONTINUE
C
      NUMPV=NUMPAR+NUMVAR
C
C               ***************************************************************
C               **  STEP 2--                                                 **
C               **  DEFINE VARIOUS CONSTANTS.                                **
C               **  DEFINE EPS = MACHINE EPSILON.                            **
C               **  DEFINE TOL = CUTOFF TOLERANCE FOR SUCCESSIVE ESTIMATES.  **
C               **  DEFINE MAXITS = MAX NUMBER OF ITERATIONS.                **
C               **  DEFINE EXPND = EXPANSION FACTOR                          **
C               **  DEFINE COMPR  = COMPRESSION FACTOR                       **
C               **  DEFINE NCONST = NUMBER OF PARAMETERS HELD CONSTANT.      **
C               **  DEFINE NP = NUMBER OF NON-CONSTANT PARAMETERS.           **
C               **  DEFINE DF = DEGREES OF FREEDOM.                          **
C               **  DEFINE SOME WORKING STORAGE START POINTS IN WS.          **
C               ***************************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREP='NO'
      REPSD=0.0
      REPDF=0.0
      IREPDF=REPDF+0.5
      RESSD=0.0
      RESDF=0.0
      ALFCDF=(-999.99)
      IF(NUMPAR.LE.0)GOTO2000
      EPS = 1.E-8
      DEPS=EPS
      TOL=0.00001
      DTOL=TOL
CCCCC MAXITS=50
CCCCC ALAMBA=1.
      ALAMBA=0.01
      EXPND=1.5
      COMPR=0.5
      NPST=NUMPAR
      NCONST=0
      DO501I=1,NUMPAR
      IF(ICON3(I).EQ.1)NCONST=NCONST+1
  501 CONTINUE
      NP=NUMPAR-NCONST
      IF(NP.GT.0) GO TO 35
      WRITE(ICOUT,117) NP
117   FORMAT(10X,'NO. OF PARAMETERS TO BE VARIED = ',I8,
     *'(LESS THAN ONE)')
      CALL DPWRST('XXX','BUG ')
      IER = 5
      IERROR='YES'
CCCCC THE FOLLOWING LINE WAS CHANGED    NOVEMBER 1995
CCCCC GOTO9000
      GOTO8100
   35 CONTINUE
      DF=N-NP
      RESDF=DF
      IRESDF=DF+0.5
      IC=0
      IER=2
      IDA=NP*NP
      IDU=IDA+NP
      ID =IDU+NP
      IDX=ID +NP
      IY =IDX+NP
 2000 CONTINUE
C
      ICASLS='ON'
      IF(FITPOW.LE.1.999)ICASLS='OFF'
      IF(FITPOW.GE.2.001)ICASLS='OFF'
C
      IF(IPRINT.EQ.'OFF')GOTO109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NUMPAR.GE.1.AND.ICASLS.EQ.'ON')WRITE(ICOUT,101)
  101 FORMAT('LEAST SQUARES NON-LINEAR PRE-FIT')
      IF(NUMPAR.GE.1.AND.ICASLS.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(NUMPAR.GE.1.AND.ICASLS.EQ.'OFF')WRITE(ICOUT,102)FITPOW
  102 FORMAT('NON-LINEAR PRE-FIT (FIT POWER = ',F10.5,')')
      IF(NUMPAR.GE.1.AND.ICASLS.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(NUMPAR.LE.0)WRITE(ICOUT,105)
  105 FORMAT('FULLY-SPECIFIED MODEL')
      IF(NUMPAR.LE.0)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,106)N
  106 FORMAT('      SAMPLE SIZE N = ',I8)
      CALL DPWRST('XXX','BUG ')
  109 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO2290
      IF(MODEL(1).NE.' ')IMIN=1
      IF(MODEL(1).EQ.' ')IMIN=2
      IMAX=NUMCHA
      IDEL=IMAX-IMIN+1
      NUMLIN=((IDEL-1)/100)+1
C
      IF(NUMLIN.LE.0)GOTO2290
      DO2240KLINE=1,NUMLIN
      IF(KLINE.EQ.1)GOTO2250
      IF(KLINE.GE.2)GOTO2260
C
 2250 CONTINUE
      KMIN=IMIN
      KMAX=KMIN+100-1
      IF(KMAX.GT.IMAX)KMAX=IMAX
      WRITE(ICOUT,2252)(MODEL(K),K=KMIN,KMAX)
 2252 FORMAT('      MODEL--',100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO2240
C
 2260 CONTINUE
      KMIN=KMAX+1
      KMAX=KMIN+100-1
      IF(KMAX.GT.IMAX)KMAX=IMAX
      WRITE(ICOUT,2262)(MODEL(K),K=KMIN,KMAX)
 2262 FORMAT(13X,100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO2240
 2240 CONTINUE
 2290 CONTINUE
C
C               **************************************************************
C               **  STEP 2.5--                                              **
C               **  CHECK FOR REPLICATION AND IF EXISTENT                   **
C               **  COMPUTE A (MODEL-FREE) REPLICATION STANDARD DEVIATION.  **
C               **************************************************************
C
      ISTEPN='2.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPREPS(Y,X1,X2,X3,X4,X5,N,NUMVAR,DUM1,DUM2,
     1IREP,REPSS,REPMS,REPSD,REPDF,NUMSET,IBUGA3,IERROR)
      IREPDF=REPDF+0.5
C
      IF(IREP.EQ.'NO')GOTO2800
      GOTO2900
C
 2800 CONTINUE
      IF(IPRINT.EQ.'OFF')GOTO2819
      WRITE(ICOUT,2811)
 2811 FORMAT('      NO REPLICATION CASE')
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
 2819 CONTINUE
      GOTO2999
C
 2900 CONTINUE
      IF(IPRINT.EQ.'OFF')GOTO2929
      WRITE(ICOUT,2911)
 2911 FORMAT('      REPLICATION CASE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2922)REPSD
 2922 FORMAT('      REPLICATION STANDARD DEVIATION = ',D20.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2923)IREPDF
 2923 FORMAT('      REPLICATION DEGREES OF FREEDOM = ',2X,I9)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2924)NUMSET
 2924 FORMAT('      NUMBER OF DISTINCT SUBSETS     = ',2X,I9)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
 2929 CONTINUE
      GOTO2999
C
 2999 CONTINUE
C
C               ***************************************************************
C               **  STEP 3--                                               **
C               **  TREAT THE SPECIAL CASE WHERE NO PARAMETERS               **
C               **  EXIST IN THE MODEL--                                     **
C               **  THAT IS, WE ARE REALLY INTERESTED                        **
C               **  IN GENERATING PREDICTED VALUES AND RESIDUALS             **
C               **  FROM A FULLY-SPECIFIED MODEL.                            **
C               **  (THIS IS USEFUL FOR MANUALLY ARRIVING AT                 **
C               **  REASONABLE STARTING VALUES FOR A MORE COMPLICATED PRE-FIT;**
C               **  AND ALSO FOR TESTING THE GOODNESS OF AN ALREADY-DERIVED  **
C               **  PRE-FIT FOR ONE DOMAIN OVER A SECOND DOMAIN.)            **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMPAR.GE.1)GOTO2664
      CALL DPPRE3(MODEL,NUMCHA,IPASS,PARAM5,IPARN5,IPARN6,NUMPV,
     1IPARN3,IVARN3,PARAM3,IPARN4,IVARN4,ICON3,
     1NUMPAR,NUMVAR,Y,X1,X2,X3,X4,X5,W,N,FITPOW,
     1IANGLU,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,PRED2,RES2,
     1RESSS,RESSD,RESDF,IBUGA3,IBUGCO,IBUGEV,IERROR)
CCCCC THE FOLLOWING LINE WAS CHANGED    NOVEMBER 1995
CCCCC IF(IERROR.EQ.'YES')GOTO9000
      IF(IERROR.EQ.'YES')GOTO8100
 2664 CONTINUE
C
C               *************************************************
C               **  STEP 5--                                   **
C               **  DETERMINE THE LATTICE OF PARAMETER VALUES  **
C               *************************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *************************************************
C               **  STEP 5.1--                                 **
C               **  SEARCH FOR THE FIRST OCCURRANCE OF    FOR  **
C               *************************************************
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPF=0
      JMAX=NUMARG-1
      DO3100J=1,JMAX
      J2=J
      JP1=J+1
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    '.AND.
     1IHARG(JP1).EQ.'I   '.AND.IHARG2(JP1).EQ.'   ')GOTO3150
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO3190
 3100 CONTINUE
 3150 CONTINUE
      CALL DPPRE3(MODEL,NUMCHA,IPASS,PARAM5,IPARN5,IPARN6,NUMPV,
     1IPARN3,IVARN3,PARAM3,IPARN4,IVARN4,ICON3,
     1NUMPAR,NUMVAR,Y,X1,X2,X3,X4,X5,W,N,FITPOW,
     1IANGLU,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,PRED2,RES2,
     1RESSS,RESSD,RESDF,IBUGA3,IBUGCO,IBUGEV,IERROR)
CCCCC THE FOLLOWING LINE WAS CHANGED   NOVEMBER 1995
CCCCC IF(IERROR.EQ.'YES')GOTO9000
      IF(IERROR.EQ.'YES')GOTO8100
      DO3160I=1,NUMPAR
      BEST(I)=PARAM3(I)
 3160 CONTINUE
      RESSMN=RESSD
      GOTO6100
 3190 CONTINUE
      IFOLOC=J2
      ILALOC=IFOLOC-1
C
C               ************************************************
C               **  STEP 5.2--                                **
C               **  EXTRACT START,INCREMENT, AND STOP VALUES  **
C               **  FOR EACH PARAMETER GIVEN                  **
C               **  VIA EACH    FOR    QUALIFICATION.         **
C               ************************************************
C
      ISTEPN='5.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPF=0
      IF(IPRINT.EQ.'ON')WRITE(ICOUT,999)
      IF(IPRINT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      DO3200ITER=1,1000
      IFOLOC=ILALOC+1
      J=IFOLOC
      JP1=J+1
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    '.AND.
     1IHARG(JP1).EQ.'I   '.AND.IHARG2(JP1).EQ.'   ')GOTO3280
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO3220
      GOTO3280
 3220 CONTINUE
      CALL DPEXSE(IFOLOC,IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IANS,IWIDTH,
     1IHPN,IHPN2,ASTART,AINC,ASTOP,NUMINC,ILALOC,IBUGA3,IFOUNF,IERROR)
      IF(IFOUNF.EQ.'NO')GOTO3280
      NUMPF=NUMPF+1
      IHPNV(NUMPF)=IHPN
      IHPNV2(NUMPF)=IHPN2
      ASTARV(NUMPF)=ASTART
      AINCV(NUMPF)=AINC
      ASTOPV(NUMPF)=ASTOP
      NUMINV(NUMPF)=NUMINC
      IF(IPRINT.EQ.'ON'.AND.NUMPF.GE.1)
     1WRITE(ICOUT,3221)IHPN,IHPN2,ASTART,AINC,ASTOP
 3221 FORMAT('      LATTICE VALUES FOR ',A4,A4,' = ',3E15.7)
      IF(IPRINT.EQ.'ON'.AND.NUMPF.GE.1)
     1CALL DPWRST('XXX','BUG ')
      IF(IBUGA3.EQ.'OFF')GOTO3239
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3231)NUMPF
 3231 FORMAT('NUMPF = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3232)IHPNV(NUMPF),IHPNV2(NUMPF)
 3232 FORMAT('IHPNV(NUMPF),IHPNV2(NUMPF) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3233)ASTARV(NUMPF),AINCV(NUMPF),ASTOPV(NUMPF)
 3233 FORMAT('ASTARV(NUMPF),AINCV(NUMPF),ASTOPV(NUMPF) = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3234)NUMINV(NUMPF)
 3234 FORMAT('NUMINV(NUMPF) = ',I8)
      CALL DPWRST('XXX','BUG ')
 3239 CONTINUE
 3200 CONTINUE
 3280 CONTINUE
C
      IPROD=1
      IF(NUMPF.LE.0)GOTO3289
      DO3285I=1,NUMPF
      IPROD=IPROD*NUMINV(I)
 3285 CONTINUE
 3289 CONTINUE
      NUMLAP=IPROD
      IF(IPRINT.EQ.'ON'.AND.NUMPF.GE.1)WRITE(ICOUT,999)
      IF(IPRINT.EQ.'ON'.AND.NUMPF.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IPRINT.EQ.'ON'.AND.NUMPF.GE.1)WRITE(ICOUT,3291)NUMLAP
 3291 FORMAT('      NUMBER OF LATTICE POINTS    = ',2X,I9)
      IF(IPRINT.EQ.'ON'.AND.NUMPF.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3292)NUMINV(NUMPF)
 3292 FORMAT('NUMINV(NUMPF) = ',I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************
C               **  STEP 5.3--           **
C               **  PRINT OUT A HEADING  **
C               ***************************
C
      ISTEPN='5.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO3390
      WRITE(ICOUT,3311)
 3311 FORMAT('  STEP                  RESIDUAL  *  PARAMETER')
      CALL DPWRST('XXX','BUG ')
      IF(ICASLS.EQ.'ON')WRITE(ICOUT,3312)
 3312 FORMAT(' NUMBER                 STANDARD  *  ESTIMATES')
      IF(ICASLS.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASLS.EQ.'OFF')WRITE(ICOUT,3313)
 3313 FORMAT(' NUMBER                   NORM    *  ESTIMATES')
      IF(ICASLS.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASLS.EQ.'ON')WRITE(ICOUT,3314)
 3314 FORMAT('                        DEVIATION *           ')
      IF(ICASLS.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASLS.EQ.'OFF')WRITE(ICOUT,3315)
 3315 FORMAT('                                  *           ')
      IF(ICASLS.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3316)
 3316 FORMAT('----------------------------------*-----------')
      CALL DPWRST('XXX','BUG ')
 3390 CONTINUE
C
C               ****************************************************
C               **  STEP 5.4--                                    **
C               **  STEP THROUGH THE VARIOUS VALUES               **
C               **  OF THE PARAMETER LATTICE;                     **
C               **  COMPUTE RESIDUAL STANDARD DEVIATION FOR EACH  **
C               **  LATTICE VALUE.                                **
C               ****************************************************
C
      ISTEPN='5.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      RESSMN=CPUMAX
      RESSMX=CPUMIN
C
      N1=0
      N2=0
      N3=0
      N4=0
      N5=0
      N6=0
      N7=0
      N8=0
      N9=0
      N10=0
C
      I1=1
      I2=1
      I3=1
      I4=1
      I5=1
      I6=1
      I7=1
      I8=1
      I9=1
      I10=1
C
      IF(NUMPF.LE.0)GOTO4090
      N1=NUMINV(1)
      IF(NUMPF.LE.1)GOTO4090
      N2=NUMINV(2)
      IF(NUMPF.LE.2)GOTO4090
      N3=NUMINV(3)
      IF(NUMPF.LE.3)GOTO4090
      N4=NUMINV(4)
      IF(NUMPF.LE.4)GOTO4090
      N5=NUMINV(5)
      IF(NUMPF.LE.5)GOTO4090
      N6=NUMINV(6)
      IF(NUMPF.LE.6)GOTO4090
      N7=NUMINV(7)
      IF(NUMPF.LE.7)GOTO4090
      N8=NUMINV(8)
      IF(NUMPF.LE.8)GOTO4090
      N9=NUMINV(9)
      IF(NUMPF.LE.9)GOTO4090
      N10=NUMINV(10)
      IF(NUMPF.LE.10)GOTO4090
 4090 CONTINUE
C
      ISTEP=0
C
      IPAR1=1
      I1=0
 4100 CONTINUE
      I1=I1+1
      AI1=I1
      P1=ASTARV(IPAR1)+(AI1-1.0)*AINCV(IPAR1)
      IF(I1.EQ.N1)P1=ASTOPV(IPAR1)
      IF(I1.GE.2)GOTO4115
      IH=IHPNV(IPAR1)
      IH2=IHPNV2(IPAR1)
      DO4110J1=1,NUMPAR
      J12=J1
      IF(IH.EQ.IPARN5(J1).AND.IH2.EQ.IPARN6(J1))GOTO4115
 4110 CONTINUE
      GOTO4119
 4115 CONTINUE
      PARAM3(J12)=P1
      PARAM5(J12)=P1
 4119 CONTINUE
      IF(NUMPF.LE.1)GOTO5100
C
      IPAR2=2
      I2=0
 4200 CONTINUE
      I2=I2+1
      AI2=I2
      P2=ASTARV(IPAR2)+(AI2-1.0)*AINCV(IPAR2)
      IF(I2.EQ.N2)P2=ASTOPV(IPAR2)
      IF(I2.GE.2)GOTO4215
      IH=IHPNV(IPAR2)
      IH2=IHPNV2(IPAR2)
      DO4210J2=1,NUMPAR
      J22=J2
      IF(IH.EQ.IPARN5(J2).AND.IH2.EQ.IPARN6(J2))GOTO4215
 4210 CONTINUE
      GOTO4219
 4215 CONTINUE
      PARAM3(J22)=P2
      PARAM5(J22)=P2
 4219 CONTINUE
      IF(NUMPF.LE.2)GOTO5100
C
      IPAR3=3
      I3=0
 4300 CONTINUE
      I3=I3+1
      AI3=I3
      P3=ASTARV(IPAR3)+(AI3-1.0)*AINCV(IPAR3)
      IF(I3.EQ.N3)P3=ASTOPV(IPAR3)
      IF(I3.GE.2)GOTO4315
      IH=IHPNV(IPAR3)
      IH3=IHPNV2(IPAR3)
      DO4310J3=1,NUMPAR
      J32=J3
      IF(IH.EQ.IPARN5(J3).AND.IH2.EQ.IPARN6(J3))GOTO4315
 4310 CONTINUE
      GOTO4319
 4315 CONTINUE
      PARAM3(J32)=P3
      PARAM5(J32)=P3
 4319 CONTINUE
      IF(NUMPF.LE.3)GOTO5100
C
      IPAR4=4
      I4=0
 4400 CONTINUE
      I4=I4+1
      AI4=I4
      P4=ASTARV(IPAR4)+(AI4-1.0)*AINCV(IPAR4)
      IF(I4.EQ.N4)P4=ASTOPV(IPAR4)
      IF(I4.GE.2)GOTO4415
      IH=IHPNV(IPAR4)
      IH4=IHPNV2(IPAR4)
      DO4410J4=1,NUMPAR
      J42=J4
      IF(IH.EQ.IPARN5(J4).AND.IH2.EQ.IPARN6(J4))GOTO4415
 4410 CONTINUE
      GOTO4419
 4415 CONTINUE
      PARAM3(J42)=P4
      PARAM5(J42)=P4
 4419 CONTINUE
      IF(NUMPF.LE.4)GOTO5100
C
      IPAR5=5
      I5=0
 4500 CONTINUE
      I5=I5+1
      AI5=I5
      P5=ASTARV(IPAR5)+(AI5-1.0)*AINCV(IPAR5)
      IF(I5.EQ.N5)P5=ASTOPV(IPAR5)
      IF(I5.GE.2)GOTO4515
      IH=IHPNV(IPAR5)
      IH5=IHPNV2(IPAR5)
      DO4510J5=1,NUMPAR
      J52=J5
      IF(IH.EQ.IPARN5(J5).AND.IH2.EQ.IPARN6(J5))GOTO4515
 4510 CONTINUE
      GOTO4519
 4515 CONTINUE
      PARAM3(J52)=P5
      PARAM5(J52)=P5
 4519 CONTINUE
      IF(NUMPF.LE.5)GOTO5100
C
      IPAR6=6
      I6=0
 4600 CONTINUE
      I6=I6+1
      AI6=I6
      P6=ASTARV(IPAR6)+(AI6-1.0)*AINCV(IPAR6)
      IF(I6.EQ.N6)P6=ASTOPV(IPAR6)
      IF(I6.GE.2)GOTO4615
      IH=IHPNV(IPAR6)
      IH6=IHPNV2(IPAR6)
      DO4610J6=1,NUMPAR
      J62=J6
      IF(IH.EQ.IPARN5(J6).AND.IH2.EQ.IPARN6(J6))GOTO4615
 4610 CONTINUE
      GOTO4619
 4615 CONTINUE
      PARAM3(J62)=P6
      PARAM5(J62)=P6
 4619 CONTINUE
      IF(NUMPF.LE.6)GOTO5100
C
      IPAR7=7
      I7=0
 4700 CONTINUE
      I7=I7+1
      AI7=I7
      P7=ASTARV(IPAR7)+(AI7-1.0)*AINCV(IPAR7)
      IF(I7.EQ.N7)P7=ASTOPV(IPAR7)
      IF(I7.GE.2)GOTO4715
      IH=IHPNV(IPAR7)
      IH7=IHPNV2(IPAR7)
      DO4710J7=1,NUMPAR
      J72=J7
      IF(IH.EQ.IPARN5(J7).AND.IH2.EQ.IPARN6(J7))GOTO4715
 4710 CONTINUE
      GOTO4719
 4715 CONTINUE
      PARAM3(J72)=P7
      PARAM5(J72)=P7
 4719 CONTINUE
      IF(NUMPF.LE.7)GOTO5100
C
      IPAR8=8
      I8=0
 4800 CONTINUE
      I8=I8+1
      AI8=I8
      P8=ASTARV(IPAR8)+(AI8-1.0)*AINCV(IPAR8)
      IF(I8.EQ.N8)P8=ASTOPV(IPAR8)
      IF(I8.GE.2)GOTO4815
      IH=IHPNV(IPAR8)
      IH8=IHPNV2(IPAR8)
      DO4810J8=1,NUMPAR
      J82=J8
      IF(IH.EQ.IPARN5(J8).AND.IH2.EQ.IPARN6(J8))GOTO4815
 4810 CONTINUE
      GOTO4819
 4815 CONTINUE
      PARAM3(J82)=P8
      PARAM5(J82)=P8
 4819 CONTINUE
      IF(NUMPF.LE.8)GOTO5100
C
      IPAR9=9
      I9=0
 4900 CONTINUE
      I9=I9+1
      AI9=I9
      P9=ASTARV(IPAR9)+(AI9-1.0)*AINCV(IPAR9)
      IF(I9.EQ.N9)P9=ASTOPV(IPAR9)
      IF(I9.GE.2)GOTO4915
      IH=IHPNV(IPAR9)
      IH9=IHPNV2(IPAR9)
      DO4910J9=1,NUMPAR
      J92=J9
      IF(IH.EQ.IPARN5(J9).AND.IH2.EQ.IPARN6(J9))GOTO4915
 4910 CONTINUE
      GOTO4919
 4915 CONTINUE
      PARAM3(J92)=P9
      PARAM5(J92)=P9
 4919 CONTINUE
      IF(NUMPF.LE.9)GOTO5100
C
      IPAR10=10
      I10=0
 5000 CONTINUE
      I10=I10+1
      AI10=I10
      P10=ASTARV(IPAR10)+(AI10-1.0)*AINCV(IPAR10)
      IF(I10.EQ.N10)P10=ASTOPV(IPAR10)
      IF(I10.GE.2)GOTO5015
      IH=IHPNV(IPAR10)
      IH10=IHPNV2(IPAR10)
      DO5010J10=1,NUMPAR
      J102=J10
      IF(IH.EQ.IPARN5(J10).AND.IH2.EQ.IPARN6(J10))GOTO5015
 5010 CONTINUE
      GOTO5019
 5015 CONTINUE
      PARAM3(J102)=P10
      PARAM5(J102)=P10
 5019 CONTINUE
      IF(NUMPF.LE.10)GOTO5100
C
 5100 CONTINUE
      ISTEP=ISTEP+1
      CALL DPPRE3(MODEL,NUMCHA,IPASS,PARAM5,IPARN5,IPARN6,NUMPV,
     1IPARN3,IVARN3,PARAM3,IPARN4,IVARN4,ICON3,
     1NUMPAR,NUMVAR,Y,X1,X2,X3,X4,X5,W,N,FITPOW,
     1IANGLU,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,PRED2,RES2,
     1RESSS,RESSD,RESDF,IBUGA3,IBUGCO,IBUGEV,IERROR)
CCCCC THE FOLLOWING LINE WAS CHANGE     NOVEMBER 1995
CCCCC IF(IERROR.EQ.'YES')GOTO9000
      IF(IERROR.EQ.'YES')GOTO8100
C
      IF(RESSD.GT.RESSMX)GOTO5110
      GOTO5119
 5110 CONTINUE
      DO5115I=1,NUMPAR
      WORST(I)=PARAM5(I)
 5115 CONTINUE
      RESSMX=RESSD
 5119 CONTINUE
C
CCCCC THE FOLLOWING 19 LINES WERE REWRITTEN    NOVEMBER 1995
      ISMALL='NO'
      IF(RESSD.LT.RESSMN)THEN
         DO5125I=1,NUMPAR
            BEST(I)=PARAM5(I)
 5125    CONTINUE
         RESSMN=RESSD
         ISMALL='YES'
      END IF
C
      IF(ISMALL.EQ.'YES')THEN
         IF(IPRINT.EQ.'ON')THEN
            WRITE(ICOUT,5191)ISTEP,RESSD,(PARAM3(J),J=1,NUMPAR)
 5191       FORMAT(I5,'--',4X,9X,1X,E12.5,' *',8E12.5)
            CALL DPWRST('XXX','BUG ')
         END IF
      END IF
C
      WRITE(IOUNI1,5192)RESSD,(PARAM3(J),J=1,NUMPAR)
 5192 FORMAT(1X,E12.5,8E12.5)
C
      IF(I10.LT.N10)GOTO5000
      IF(I9.LT.N9)GOTO4900
      IF(I8.LT.N8)GOTO4800
      IF(I7.LT.N7)GOTO4700
      IF(I6.LT.N6)GOTO4600
      IF(I5.LT.N5)GOTO4500
      IF(I4.LT.N4)GOTO4400
      IF(I3.LT.N3)GOTO4300
      IF(I2.LT.N2)GOTO4200
      IF(I1.LT.N1)GOTO4100
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  PRINT OUT FINAL PARAMETER ESTIMATES              **
C               **  AND THEIR STANDARD DEVIATIONS.                   **
C               **  ALSO PRINT OUT THE RESIDUAL STANDARD DEVIATION.  **
C               *******************************************************
C
 6100 CONTINUE
      ISTEPN='12'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO6110I=1,NUMPAR
      PARAM3(I)=BEST(I)
 6110 CONTINUE
      RESSD=RESSMN
C
      IF(IPRINT.EQ.'OFF')GOTO6119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC IF(NUMPF.GE.1)WRITE(ICOUT,999)
CCCCC IF(NUMPF.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6111)
 6111 FORMAT (7X,'FINAL PARAMETER ESTIMATES           ')
      CALL DPWRST('XXX','BUG ')
 6119 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO6129
      DO6120I=1,NUMPAR
      WRITE(ICOUT,6121)I,IPARN3(I),IPARN4(I),
     1PARAM3(I)
 6121 FORMAT(I8,2X,A4,A4,2X,G22.6)
      CALL DPWRST('XXX','BUG ')
 6120 CONTINUE
 6129 CONTINUE
C
C               *********************************************
C               **  STEP 13--                              **
C               **  PRINT OUT GOODNESS OF FIT INFORMATION  **
C               *********************************************
C
 7000 CONTINUE
      ISTEPN='13'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO7129
      IF(NUMPAR.GE.1)WRITE(ICOUT,999)
      IF(NUMPAR.GE.1)CALL DPWRST('XXX','BUG ')
      IF(ICASLS.EQ.'ON')WRITE(ICOUT,7125)RESSD
 7125 FORMAT('      RESIDUAL    STANDARD DEVIATION = ',F20.10)
      IF(ICASLS.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASLS.EQ.'OFF')WRITE(ICOUT,7126)RESSD
 7126 FORMAT('      RESIDUAL    NORM               = ',F20.10)
      IF(ICASLS.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7127)IRESDF
 7127 FORMAT('      RESIDUAL    DEGREES OF FREEDOM = ',2X,I9)
      CALL DPWRST('XXX','BUG ')
 7129 CONTINUE
C
      IF(IREP.EQ.'NO')GOTO7250
      IFITDF=IRESDF-IREPDF
      IF(IPRINT.EQ.'OFF')GOTO7269
      WRITE(ICOUT,7227)REPSD
 7227 FORMAT('      REPLICATION STANDARD DEVIATION = ',F20.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7228)IREPDF
 7228 FORMAT('      REPLICATION DEGREES OF FREEDOM = ',2X,I9)
      CALL DPWRST('XXX','BUG ')
      IF(IFITDF.GE.1)GOTO7261
      WRITE(ICOUT,7236)
 7236 FORMAT('      LACK OF FIT F TEST CANNOT BE DONE BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7237)
 7237 FORMAT('      HAVE ONLY 0 DEGREES OF FREEDOM IN ',
     1'NUMERATOR OF F RATIO.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7238)
 7238 FORMAT('      THIS HAPPENS WHEN NUMBER OF PARAMETERS ',
     1'FITTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7239)
 7239 FORMAT('      IS IDENTICAL TO NUMBER OF DISTINCT ',
     1'SUBSETS.')
      CALL DPWRST('XXX','BUG ')
 7269 CONTINUE
      GOTO7250
 7261 CONTINUE
C
      FITDF=IFITDF
      FITSS=RESSS-REPSS
      FITMS=FITSS/FITDF
      FSTAT=FITMS/REPMS
      CALL FCDF(FSTAT,IFITDF,IREPDF,CDF)
      CDF2=100.0*CDF
CCCCC THE FOLLOWING LINE WAS INSERTED MARCH 1988.
      ALFCDF=CDF
C
      IF(IPRINT.EQ.'OFF')GOTO7259
      WRITE(ICOUT,7240)FSTAT,CDF2
 7240 FORMAT('      LACK OF FIT F RATIO = ',F10.4,' = THE ',
     1F8.4,'% POINT OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7245)IFITDF,IREPDF
 7245 FORMAT('      F DISTRIBUTION WITH ',I6,' AND ',I6,
     1' DEGREES OF FREEDOM')
      CALL DPWRST('XXX','BUG ')
 7259 CONTINUE
 7250 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGED     NOVEMBER 1995
CCCCC IF(NUMPAR.LE.0)GOTO9000
      IF(NUMPAR.LE.0)GOTO8100
C
CCCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1995
C               **************************************
C               **  STEP 81--                       **
C               **  CLOSE       THE STORAGE FILES.  **
C               **************************************
C
 8100 CONTINUE
C
      ISTEPN='81'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRE2')
     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
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 DPPRE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NUMVAR,NUMPAR,NUMCHA
 9013 FORMAT('N,NUMVAR,NUMPAR,NUMCHA = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMPAR
      WRITE(ICOUT,9016)I,IPARN3(I),IPARN4(I),PARAM3(I)
 9016 FORMAT('I,IPARN3(I),IPARN4(I),PARAM3(I) = ',I8,2X,A4,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)IBUGA3,IBUGCO,IBUGEV
 9017 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N
      WRITE(ICOUT,9021)I,Y(I),X1(I),X2(I),W(I),PRED2(I),RES2(I)
 9021 FORMAT('I,Y(I),X1(I),X2(I),W(I),PRED2(I),RES2(I) = ',
     1I8,6E13.7)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPRE3(MODEL,NUMCHA,IPASS,PARAM5,IPARN5,IPARN6,NUMPV,
     1IPARN3,IVARN3,PARAM3,IPARN4,IVARN4,ICON3,
     1NUMPAR,NUMVAR,Y,X1,X2,X3,X4,X5,W,N,FITPOW,
     1IANGLU,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,PRED2,RES2,
     1RESSS,RESSD,RESDF,IBUGA3,IBUGCO,IBUGEV,IERROR)
C
C     PURPOSE--TAKE A MODEL AND A DATA SET
C              AND A SET OF PARAMETER VALUES
C              AND COMPUTE A RESIDUAL STANDARD DEVIATION.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--OCTOBER    1981.
C     UPDATED          --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 MODEL
      CHARACTER*4 IPARN5
      CHARACTER*4 IPARN6
      CHARACTER*4 IPARN3
      CHARACTER*4 IVARN3
      CHARACTER*4 IPARN4
      CHARACTER*4 IVARN4
      CHARACTER*4 IANGLU
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW2HOL
      CHARACTER*4 IW22HO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN3
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
      DIMENSION X3(*)
      DIMENSION X4(*)
      DIMENSION X5(*)
      DIMENSION W(*)
C
      DIMENSION PRED2(*)
      DIMENSION RES2(*)
C
      DIMENSION MODEL(*)
C
      DIMENSION IVARN3(*)
      DIMENSION IVARN4(*)
      DIMENSION PARAM3(*)
      DIMENSION IPARN3(*)
      DIMENSION IPARN4(*)
      DIMENSION ICON3(*)
      DIMENSION ITYPEH(*)
      DIMENSION IW2HOL(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IPARN5(*)
      DIMENSION IPARN6(*)
      DIMENSION PARAM5(*)
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='DPPR'
      ISUBN3='E3  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPRE3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NUMVAR,NUMPAR,NUMPV,NUMCHA
   52 FORMAT('N,NUMVAR,NUMPAR,NUMPV,NUMCHA = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA3,IBUGCO,IBUGEV
   53 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y(I),X1(I),W(I)
   56 FORMAT('I,Y(I),X1(I),W(I) = ',I5,3F20.10)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      DO61J=1,NUMVAR
      WRITE(ICOUT,62)J,IVARN3(J),IVARN4(J)
   62 FORMAT('I,IVARN3(I),IVARN4(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
      DO66J=1,NUMPV
      WRITE(ICOUT,67)J,IPARN3(J),IPARN4(J),PARAM3(J),ICON3(J)
   67 FORMAT('I,IPARN3(I),IPARN4(I),PARAM3(I),ICON3(I) = ',
     1I8,2X,A4,A4,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
   66 CONTINUE
      WRITE(ICOUT,71)(MODEL(J),J=1,NUMCHA)
   71 FORMAT('FUNCTIONAL EXPRESSION--',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)FITPOW
   72 FORMAT('FITPOW = ',E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      DO2100I=1,N
      W(I)=1.0
 2100 CONTINUE
C
      DO3000I=1,N
      IF(NUMVAR.LE.0)GOTO3090
      PARAM5(NUMPAR+1)=X1(I)
      IF(NUMVAR.LE.1)GOTO3090
      PARAM5(NUMPAR+2)=X2(I)
      IF(NUMVAR.LE.2)GOTO3090
      PARAM5(NUMPAR+3)=X3(I)
      IF(NUMVAR.LE.3)GOTO3090
      PARAM5(NUMPAR+4)=X4(I)
      IF(NUMVAR.LE.4)GOTO3090
      PARAM5(NUMPAR+5)=X5(I)
 3090 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,888)NUMPAR,NUMVAR,NUMPV
  888 FORMAT('NUMPAR,NUMVAR,NUMPV = ',3I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,889)X1(1),X1(I),IPARN5(3),IPARN6(3),
     1PARAM5(3)
  889 FORMAT('X1(1),X1(I),IPARN5(3),IPARN6(3),PARAM5(3) = ',
     1E15.7,E15.7,2X,A4,2X,A4,E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM5,IPARN5,IPARN6,NUMPV,
     1IANGLU,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,PRED2(I),
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
 3000 CONTINUE
C
      DO3100I=1,N
      RES2(I)=Y(I)-PRED2(I)
 3100 CONTINUE
C
      SUM=0.0
      DO3200I=1,N
      IF(RES2(I).EQ.0.0)GOTO3200
      SUM=SUM+ABS(RES2(I))**FITPOW
 3200 CONTINUE
      RESSS=SUM
C
      IRESDF=N-NUMPAR
      RESDF=IRESDF
      RESMS=RESSS/RESDF
      IF(RESMS.LE.0.0)RESSD=0.0
      IF(RESMS.GT.0.0)RESSD=SQRT(RESMS)
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 DPPRE3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NUMVAR,NUMPAR,NUMCHA
 9013 FORMAT('N,NUMVAR,NUMPAR,NUMCHA = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMPAR
      WRITE(ICOUT,9016)I,IPARN3(I),IPARN4(I),PARAM3(I)
 9016 FORMAT('I,IPARN3(I),IPARN4(I),PARAM3(I) = ',I8,2X,A4,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)IBUGA3,IBUGCO,IBUGEV
 9017 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)RESSS,RESSD,RESDF
 9018 FORMAT('RESSS,RESSD,RESDF = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N
      WRITE(ICOUT,9021)I,Y(I),X1(I),X2(I),W(I),PRED2(I),RES2(I)
 9021 FORMAT('I,Y(I),X1(I),X2(I),W(I),PRED2(I),RES2(I) = ',
     1I8,6E13.7)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPREC(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY THE PRECISION SWITCH WHICH IN TURN
C              DETERMINES WHETHER SUBSEQUENT CALCULATIONS WILL BE
C              CARRIED OUT IN SINGLE, DOUBLE,
C              TRIPLE, OR QUADRUPLE PRECISION
C              (IF AVAILABLE ON THE HOST COMPUTER).
C              THE SPECIFIED PRECISION SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IPREC.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFPR (A  HOLLERITH VARIABLE)
C                     --IHMXPR (A  HOLLERITH VARIABLE)
C     OUTPUT ARGUMENTS--IPREC  (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-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         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPR
      CHARACTER*4 IHMXPR
      CHARACTER*4 IPREC
      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
      IFOUND='YES'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1120
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1120
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
C
      IF(IHARG(NUMARG).EQ.'SING')GOTO1130
      IF(IHARG(NUMARG).EQ.'DOUB')GOTO1130
      IF(IHARG(NUMARG).EQ.'TRIP')GOTO1130
      IF(IHARG(NUMARG).EQ.'QUAD')GOTO1130
      GOTO1120
C
 1120 CONTINUE
      IHOLD=IDEFPR
      GOTO1160
C
 1130 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1160
C
 1160 CONTINUE
      IF(IHOLD.EQ.'DOUB'.AND.IHMXPR.EQ.'SING')GOTO1170
      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'SING')GOTO1170
      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'DOUB')GOTO1170
      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'SING')GOTO1170
      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'DOUB')GOTO1170
      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'TRIP')GOTO1170
      GOTO1180
C
 1170 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('***** ERROR IN DPPREC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)
 1173 FORMAT('      THE DESIRED PRECISION IS HIGHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)
 1174 FORMAT('      THAN PERMITTED ON THIS COMPUTER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1175)IHOLD
 1175 FORMAT('      DESIRED PRECISION           = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1176)IHMXPR
 1176 FORMAT('      MAXIMUM ALLOWABLE PRECISION = ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1180 CONTINUE
      IPREC=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1188)IPREC
 1188 FORMAT('THE PRECISION SWITCH HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPREE(IHARG,NUMARG,
     1IERASW,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY THE PRE-ERASE SWITCH WHICH IN TURN
C              DETERMINES WHETHER A PRE-ERASE WILL
C              AUTOMATICALLY OCCUR BEFORE PLOTS.
C              THIS CAPABILITY IS USEFUL FOR AUTOMATICALLY
C              CLEARING THE SCREEN BEFORE PLOTS.
C              THE SPECIFIED PRE-ERASE SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IERASW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IERASW (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-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 IERASW
      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(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'ERAS')GOTO1110
      GOTO1199
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')GOTO1150
      GOTO1150
C
 1150 CONTINUE
      IHOLD='ON'
      GOTO1180
C
 1160 CONTINUE
      IHOLD='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IERASW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IERASW
 1181 FORMAT('THE PRE-ERASE SWITCH HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPREF(IBUGA2,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,
     1IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A (LINEAR OR) NON-LINEAR PRE-FIT
C             = A FIT OVER A SPECIFIED LATTICE OF PARAMETER VALUES.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988.      ADD LOFCDF
C     UPDATED         --JUNE      1990.      TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --JUNE      1990.      MOVE DIMENSIONING OF ARRAYS
C     UPDATED         --NOVEMBER  1995. IANS, IWIDTH => CALLING ARGS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASFI
      CHARACTER*4 ICASEQ
      CHARACTER*4 IKEY
      CHARACTER*4 IWD
      CHARACTER*4 IWD1
      CHARACTER*4 IWD12
      CHARACTER*4 IWD2
      CHARACTER*4 IWD22
      CHARACTER*4 ICH
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW2HOL
      CHARACTER*4 IW22HO
      CHARACTER*4 IOP
      CHARACTER*4 IPAROC
      CHARACTER*4 IPARO3
      CHARACTER*4 IREPU
      CHARACTER*4 IRESU
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IPARN3
      CHARACTER*4 IPARN4
      CHARACTER*4 IHPARN
      CHARACTER*4 IHPAR2
      CHARACTER*4 IVARN3
      CHARACTER*4 IVARN4
      CHARACTER*4 IREP
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION IPAROC(100)
C
CCCCC DIMENSION ITYPEH(225)
CCCCC DIMENSION IW2HOL(225)
CCCCC DIMENSION IW22HO(225)
CCCCC DIMENSION W2HOLD(225)
      DIMENSION ITYPEH(1000)
      DIMENSION IW2HOL(1000)
      DIMENSION IW22HO(1000)
      DIMENSION W2HOLD(1000)
C
      DIMENSION PARAM(100)
      DIMENSION IPARN(100)
      DIMENSION IPARN2(100)
C
      DIMENSION X1(MAXOBV)
      DIMENSION X2(MAXOBV)
      DIMENSION X3(MAXOBV)
      DIMENSION X4(MAXOBV)
      DIMENSION X5(MAXOBV)
C
      DIMENSION W(MAXOBV)
C
      DIMENSION PRED2(MAXOBV)
      DIMENSION RES2(MAXOBV)
C
      DIMENSION PARAM3(100)
      DIMENSION IPARN3(100)
      DIMENSION IPARN4(100)
      DIMENSION ICON3(100)
      DIMENSION IPARO3(100)
      DIMENSION PARLI3(100)
      DIMENSION IVARN3(100)
      DIMENSION IVARN4(100)
      DIMENSION ICOLV3(100)
      DIMENSION NIV(100)
C
      DIMENSION ICH(10)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C---------------------------------------------------------------------
C
      EQUIVALENCE (W(1),X3D(1))
      EQUIVALENCE (PRED2(1),X(1))
      EQUIVALENCE (RES2(1),D(1))
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      DIMENSION DUM1(MAXOBV)
      DIMENSION DUM2(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),X2(1))
      EQUIVALENCE (GARBAG(IGARB3),X3(1))
      EQUIVALENCE (GARBAG(IGARB4),X4(1))
      EQUIVALENCE (GARBAG(IGARB5),X5(1))
      EQUIVALENCE (GARBAG(IGARB6),DUM1(1))
      EQUIVALENCE (GARBAG(IGARB7),DUM2(1))
CCCCC END CHANGE
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='DPPR'
      ISUBN2='EF  '
C
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IPAROC(1)='NONE'
C
      MAXV2=5
      MINN2=2
C
      MAXITS=IFITIT
      CPUEPS=R1MACH(3)
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
      MAXN4=MAXCHF
C
      NUMPV=(-999)
      IP=(-999)
      IV=(-999)
C
      IWIDMO=(-999)
C
      CUTOFF=2**(NUMBPW-3)
C
C               ******************************
C               **  TREAT THE PRE-FIT CASE  **
C               ******************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3
   53 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGCO,IBUGEV,IBUGQ
   54 FORMAT('IBUGCO,IBUGEV,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMNAM
   56 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO57I=1,NUMNAM
      WRITE(ICOUT,58)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
   58 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   57 CONTINUE
   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
      CALL CKPREF(ICASFI,ILOCFI,IBUGA3,IFOUND,IERROR)
      IF(ICASFI.EQ.'    '.OR.IFOUND.EQ.'NO')GOTO9000
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=0
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 3--
C               **  FOR THE CASES WHEN HAVE PRE-FIT Y = SOME EXPRESSION
C               **                   ROBUST PRE-FIT Y = SOME EXPRESSION       ,
C               **  DETERMINE IF WE HAVE A VALID FUNCTIONAL EXPRESSION--
C               **  IN PARTICULAR, CHECK THAT THE NUMBER OF ARGUMENTS
C               **  IS AT LEAST 1,
C               **  AND ALSO CHECK THAT THERE IS EXACTLY 1 EQUAL SIGN
C               **  AND THAT THIS EQUAL SIGN OCCURS AS THE SECOND ARGUMENT.
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1)GOTO2090
      WRITE(ICOUT,2001)
 2001 FORMAT('***** ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2002)
 2002 FORMAT('      NUMBER OF ARGUMENTS DETECTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2003)NUMARG
 2003 FORMAT('      IN PRE-FIT COMMAND = 0.  NUMARG = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2007)IWIDTH
 2007 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2008)(IANS(J),J=1,IWIDTH)
 2008 FORMAT('      COMMAND LINE--',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2090 CONTINUE
C
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO2110
 2100 CONTINUE
      ILOCQ=NUMARG+1
      GOTO2120
 2110 CONTINUE
      ILOCQ=J1
      GOTO2120
 2120 CONTINUE
C
      IF(ICASFI.EQ.'FIT')GOTO2125
      IF(ICASFI.EQ.'RFIT')GOTO2125
      GOTO2190
 2125 CONTINUE
      NUMEQ=0
      IMAX=ILOCQ-1
      DO2130I=1,IMAX
      IF(IHARG(I).EQ.'=   '.AND.IHARG2(I).EQ.'    ')NUMEQ=NUMEQ+1
 2130 CONTINUE
      IF(NUMEQ.EQ.1)GOTO2190
      WRITE(ICOUT,2131)
 2131 FORMAT('***** ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2132)
 2132 FORMAT('      NUMBER OF EQUAL SIGNS DETECTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2133)NUMEQ
 2133 FORMAT('      IN MODEL NOT EQUAL 1.  NUMEQ = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2134)NUMARG,IMAX
 2134 FORMAT('      NUMARG, IMAX = ',2I10)
      CALL DPWRST('XXX','BUG ')
      DO2135I=1,NUMARG
      WRITE(ICOUT,2136)I,IHARG(I),IHARG2(I)
 2136 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,A4)
      CALL DPWRST('XXX','BUG ')
 2135 CONTINUE
      WRITE(ICOUT,2137)IWIDTH
 2137 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2138)(IANS(J),J=1,IWIDTH)
 2138 FORMAT('      COMMAND LINE--',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2190 CONTINUE
C
      IF(ICASFI.EQ.'FIT'.AND.IHARG(2).NE.'=')GOTO2200
      IF(ICASFI.EQ.'RFIT'.AND.IHARG(3).NE.'=')GOTO2200
      GOTO2290
C
 2200 CONTINUE
      WRITE(ICOUT,2201)
 2201 FORMAT('***** ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2202)
 2202 FORMAT('      WHEN PRE-FITTING GENERAL EXPRESSIONS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2203)
 2203 FORMAT('      THE SECOND ARGUMENT AFTER THE WORD     PRE-FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2204)
 2204 FORMAT('      SHOULD BE (BUT WAS NOT) AN EQUAL SIGN.')
      CALL DPWRST('XXX','BUG ')
      IF(ICASFI.EQ.'FIT')WRITE(ICOUT,2205)IHARG(2),IHARG2(2)
 2205 FORMAT('     THE ARGUMENT WAS ',A4,A4)
      IF(ICASFI.EQ.'FIT')CALL DPWRST('XXX','BUG ')
      IF(ICASFI.EQ.'RFIT')WRITE(ICOUT,2205)IHARG(3),IHARG2(3)
      IF(ICASFI.EQ.'RFIT')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2207)IWIDTH
 2207 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2208)(IANS(J),J=1,IWIDTH)
 2208 FORMAT('      COMMAND LINE--',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2290 CONTINUE
C
C               **********************************************************
C               **  STEP 4--                                            **
C               **  FOR ALL VARIATIONS OF THE PRE-FIT COMMAND,              **
C               **  THE WORD AFTER     PRE-FIT     SHOULD BE THE RESPONSE   **
C               **  VARIABLE (= THE DEPENDENT VARIABLE).                **
C               **  EXTRACT THE RESPONSE VARIABLE AND DETERMINE         **
C               **  IF IT IS ALREADY IN THE NAME LIST AND IS, IN FACT,  **
C               **  A VARIABLE (AS OPPOSED TO A PARAMETER).             **
C               **********************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      I=0
      I2=I
      IP1=I+1
C
CCCCC IF(ICASFI.EQ.'FIT')GOTO2319
      IF(ICASFI.EQ.'RFIT')GOTO2319
      GOTO2349
 2319 CONTINUE
C
      IMAX=ILOCQ-1
      DO2330I=1,IMAX
      I2=I
      IF(IHARG(I).EQ.'PREF')GOTO2349
      IF(IHARG(I).EQ.'PRE ')GOTO2349
 2330 CONTINUE
      WRITE(ICOUT,2331)
 2331 FORMAT('***** INTERNAL ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2332)
 2332 FORMAT('      THE WORD     PRE     NOT FOUND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2333)
 2333 FORMAT('      IN THE ARGUMENT LIST, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3334)
 3334 FORMAT('      EVEN THOUGH IT HAD BEEN PREVIOSULY FOUND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2335)NUMARG,IMAX
 2335 FORMAT('      NUMARG, IMAX = ',2I10)
      CALL DPWRST('XXX','BUG ')
      DO2336I=1,NUMARG
      WRITE(ICOUT,2337)I,IHARG(I),IHARG2(I)
 2337 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,A4)
      CALL DPWRST('XXX','BUG ')
 2336 CONTINUE
      WRITE(ICOUT,2338)IWIDTH
 2338 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2339)(IANS(J),J=1,IWIDTH)
 2339 FORMAT('      COMMAND LINE--',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2349 CONTINUE
      ILOCFI=I2
C
      ILOCF1=ILOCFI+1
      IHLEFT=IHARG(ILOCF1)
      IHLEF2=IHARG2(ILOCF1)
      DO2350I=1,NUMNAM
      I2=I
      IF(IHLEFT.EQ.IHNAME(I2).AND.IHLEF2.EQ.IHNAM2(I2).AND.
     1IUSE(I2).EQ.'V')GOTO2379
 2350 CONTINUE
      WRITE(ICOUT,2361)
 2361 FORMAT('***** ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2362)
 2362 FORMAT('      THE NAME FOLLOWING THE WORD     PRE-FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2363)
 2363 FORMAT('      (WHICH SHOULD BE THE RESPONSE VARIABLE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2364)
 2364 FORMAT('      EITHER DOES NOT EXIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2365)
 2365 FORMAT('      OR IS A PARAMETER (AS OPPOSED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2366)
 2366 FORMAT('      TO A VARIABLE) IN THE CURRENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2367)
 2367 FORMAT('      LIST OF AVAILABLE VARIABLE AND PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2368)
 2368 FORMAT('      NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2369)IHLEFT,IHLEF2
 2369 FORMAT('      NAME AFTER THE WORD   PRE-FIT   = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
C
      IF(IBUGA2.EQ.'OFF')GOTO2377
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2372)
 2372 FORMAT('      CURRENT LIST OF DEFINED VARIABLES AND ',
     1'PARAMETERS--')
      CALL DPWRST('XXX','BUG ')
      DO2373K2=1,NUMNAM
      WRITE(ICOUT,2374)IHNAME(K2),IHNAM2(K2),IUSE(K2),IVALUE(K2),
     1VALUE(K2)
 2374 FORMAT(6X,A4,A4,6X,A4,6X,I6,6X,E15.7)
      CALL DPWRST('XXX','BUG ')
 2373 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2375)IWIDTH
 2375 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2376)IHLEFT,IHLEF2,ILOCFI,ILOCF1,I2
 2376 FORMAT('      IHLEFT,IHLEF2,ILOCFI,ILOCF1,I2 = ',A4,2X,A4,3I8)
      CALL DPWRST('XXX','BUG ')
 2377 CONTINUE
C
      IF(IWIDTH.GE.1)WRITE(ICOUT,2378)(IANS(J),J=1,IWIDTH)
 2378 FORMAT('      COMMAND LINE--',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2379 CONTINUE
      ILOCV=I2
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
 2390 CONTINUE
C
C               ***********************************************************
C               **  STEP 5--                                             **
C               **  FOR ALL VARIATIONS OF THE PRE-FIT COMMAND,           **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.            **
C               ***********************************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPPREF--')
      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 LEAST-SQUARES PRE-FIT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN PERFORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)NLEFT
  317 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS 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
C
  390 CONTINUE
C
C               ****************************************************************
C               **  STEP 6.1--
C               **  FOR THE CASES WHEN HAVE PRE-FIT Y = SOME EXPRESSION
C               **                   ROBUST PRE-FIT Y = SOME EXPRESSION       ,
C               **  EXTRACT THE ENTIRE (LEFT AND RIGHT SIDE) FUNCTIONAL
C               **  EXPRESSION FROM THE INPUT COMMAND LINE.
C               **  COPY OUT TO IWIDTH, OR OUT TO 'SUBS' (EXCLUSIVE),
C               **  OR OUT THE 'EXCE' (EXCLUSIVE)
C               **  OR OUT THE 'FOR' (EXCLUSIVE).
C               ****************************************************************
C
      ISTEPN='6.1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASFI.EQ.'FIT')GOTO4100
      IF(ICASFI.EQ.'RFIT')GOTO4100
      GOTO4190
 4100 CONTINUE
      IF(NUMARG.EQ.0)GOTO4160
      IF(IHARG(1).EQ.'SUBS'.AND.IHARG2(1).EQ.'ET  ')GOTO4160
      IF(IHARG(1).EQ.'EXCE'.AND.IHARG2(1).EQ.'PT  ')GOTO4160
      IF(IHARG(1).EQ.'FOR '.AND.IHARG2(1).EQ.'    ')GOTO4160
      ISTART=-99
      ISTOP=-99
      DO4110I=1,IWIDTH
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IP2.GT.IWIDTH)GOTO4120
      IF(IANS(I).EQ.'F'.AND.IANS(IP1).EQ.'I'.
     1AND.IANS(IP2).EQ.'T')
     1ISTART=IP3
C
      IF(IP4.GT.IWIDTH)GOTO4120
      IF(IANS(I).EQ.' '.AND.IANS(IP1).EQ.'F'.
     1AND.IANS(IP2).EQ.'O'.AND.IANS(IP3).EQ.'R'.
     1AND.IANS(IP4).EQ.' ')ISTOP=I
C
      IF(IP7.GT.IWIDTH)GOTO4120
      IF(IANS(I).EQ.' '.AND.IANS(IP1).EQ.'S'.
     1AND.IANS(IP2).EQ.'U'.AND.IANS(IP3).EQ.'B'.
     1AND.IANS(IP4).EQ.'S'.AND.IANS(IP5).EQ.'E'.
     1AND.IANS(IP6).EQ.'T'.AND.IANS(IP7).EQ.' ')ISTOP=I
C
 4110 CONTINUE
 4120 CONTINUE
      IF(ISTART.GE.1)GOTO4129
      IBRAN=4120
      WRITE(ICOUT,4121)IBRAN
 4121 FORMAT('*****INTERNAL ERROR IN DPPREF--',
     1'IMPOSSIBLE CONDITION AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4122)
 4122 FORMAT('THE STRING   PRE-FIT  NOT FOUND FOR MODEL EXTRACTION')
      CALL DPWRST('XXX','BUG ')
       WRITE(ICOUT,4123)
 4123 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4124)(IANS(I),I=1,IWIDTH)
 4124 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4129 CONTINUE
C
 4130 CONTINUE
      IF(ISTOP.EQ.-99)ISTOP=IWIDTH
      IF(ISTART.LE.ISTOP)GOTO4139
      IBRAN=4130
      WRITE(ICOUT,4131)
 4131 FORMAT('INTERNAL ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4132)IBRAN
 4132 FORMAT('AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4133)
 4133 FORMAT('ISTART GREATER THAN ISTOP FOR MODEL EXTRACTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4134)ISTART,ISTOP
 4134 FORMAT('ISTART, ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
       WRITE(ICOUT,4135)
 4135 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4136)(IANS(I),I=1,IWIDTH)
 4136 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4139 CONTINUE
C
      J=0
      DO4150I=ISTART,ISTOP
      J=J+1
      MODEL(J)=IANS(I)
 4150 CONTINUE
      NUMCHA=ISTOP-ISTART+1
 4160 CONTINUE
 4190 CONTINUE
C
C               ***************************************************
C               **  STEP 6.2--                                   **
C               **  FOR THE CASES WHEN HAVE ... PRE-FIT Y X   ,  **
C               **  EXTRACT THE INDEPENDENT VARIABLE,            **
C               **  AND FORM THE 1 CHARACTER PER WORD            **
C               **  REPRESENTATION OF THE MODEL.                 **
C               ***************************************************
C
      ISTEPN='6.2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASFI.EQ.'FIT')GOTO4290
      IF(ICASFI.EQ.'RFIT')GOTO4290
C
      ILOCRV=ILOCFI+1
      ILOCIV=ILOCFI+2
C
      IDEGRE=0
      IF(ICASFI.EQ.'0FIT')IDEGRE=0
      IF(ICASFI.EQ.'1FIT')IDEGRE=1
      IF(ICASFI.EQ.'2FIT')IDEGRE=2
      IF(ICASFI.EQ.'3FIT')IDEGRE=3
      IF(ICASFI.EQ.'4FIT')IDEGRE=4
      IF(ICASFI.EQ.'5FIT')IDEGRE=5
      IF(ICASFI.EQ.'6FIT')IDEGRE=6
      IF(ICASFI.EQ.'7FIT')IDEGRE=7
      IF(ICASFI.EQ.'8FIT')IDEGRE=8
      IF(ICASFI.EQ.'9FIT')IDEGRE=9
      IF(ICASFI.EQ.'10FI')IDEGRE=10
      K1=IDEGRE+1
C
      I=0
C
      IWD=IHARG(ILOCRV)
      CALL DPXH1H(IWD,ICH,IEND,IBUGA3)
      IF(IEND.LE.0)GOTO4219
      DO4210J=1,IEND
      I=I+1
      MODEL(I)=ICH(J)
 4210 CONTINUE
 4219 CONTINUE
C
      IWD=IHARG2(ILOCRV)
      CALL DPXH1H(IWD,ICH,IEND,IBUGA3)
      IF(IEND.LE.0)GOTO4229
      DO4220J=1,IEND
      I=I+1
      MODEL(I)=ICH(J)
 4220 CONTINUE
 4229 CONTINUE
C
      KMAX=IDEGRE+1
      I=I+1
      MODEL(I)='='
C
      KMAX=IDEGRE+1
      DO4250K=1,KMAX
      KM1=K-1
C
      IF(KM1.LE.0)GOTO4251
      I=I+1
      MODEL(I)='+'
 4251 CONTINUE
C
      I=I+1
      MODEL(I)='A'
C
      IF(0.LE.KM1.AND.KM1.LE.10)I=I+1
      IF(KM1.EQ.0)MODEL(I)='0'
      IF(KM1.EQ.1)MODEL(I)='1'
      IF(KM1.EQ.2)MODEL(I)='2'
      IF(KM1.EQ.3)MODEL(I)='3'
      IF(KM1.EQ.4)MODEL(I)='4'
      IF(KM1.EQ.5)MODEL(I)='5'
      IF(KM1.EQ.6)MODEL(I)='6'
      IF(KM1.EQ.7)MODEL(I)='7'
      IF(KM1.EQ.8)MODEL(I)='8'
      IF(KM1.EQ.9)MODEL(I)='9'
      IF(KM1.EQ.10)MODEL(I)='1'
      IF(KM1.EQ.10)I=I+1
      IF(J.EQ.10)MODEL(I)='0'
C
      IF(KM1.LE.0)GOTO4250
C
      I=I+1
      MODEL(I)='*'
C
      IWD=IHARG(ILOCIV)
      CALL DPXH1H(IWD,ICH,IEND,IBUGA3)
      IF(IEND.LE.0)GOTO4269
      DO4260J=1,IEND
      I=I+1
      MODEL(I)=ICH(J)
 4260 CONTINUE
 4269 CONTINUE
C
      IWD=IHARG2(ILOCIV)
      CALL DPXH1H(IWD,ICH,IEND,IBUGA3)
      IF(IEND.LE.0)GOTO4279
      DO4270J=1,IEND
      I=I+1
      MODEL(I)=ICH(J)
 4270 CONTINUE
 4279 CONTINUE
C
      IF(KM1.LE.1)GOTO4250
C
      I=I+1
      MODEL(I)='*'
      I=I+1
      MODEL(I)='*'
C
      IF(0.LE.KM1.AND.KM1.LE.10)I=I+1
      IF(KM1.EQ.0)MODEL(I)='0'
      IF(KM1.EQ.1)MODEL(I)='1'
      IF(KM1.EQ.2)MODEL(I)='2'
      IF(KM1.EQ.3)MODEL(I)='3'
      IF(KM1.EQ.4)MODEL(I)='4'
      IF(KM1.EQ.5)MODEL(I)='5'
      IF(KM1.EQ.6)MODEL(I)='6'
      IF(KM1.EQ.7)MODEL(I)='7'
      IF(KM1.EQ.8)MODEL(I)='8'
      IF(KM1.EQ.9)MODEL(I)='9'
      IF(KM1.EQ.10)MODEL(I)='1'
      IF(KM1.EQ.10)I=I+1
      IF(J.EQ.10)MODEL(I)='0'
C
 4250 CONTINUE
 4290 CONTINUE
      IWIDMO=I
      NUMCHA=IWIDMO
C
C               **************************************************
C               **  STEP 6.3--                                  **
C               **  FOR ALL VARIATIONS OF THE PRE-FIT COMMAND,  **
C               **  CHECK TO SEE THE TYPE CASE--                **
C               **    1) UNQUALIFIED (THAT IS, FULL);           **
C               **    2) SUBSET/EXCEPT; OR                      **
C               **    3) FOR.                                   **
C               **************************************************
C
      ISTEPN='6.3'
      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'
      IKEY='SUBS'
      IF(IHARG(J1).EQ.'EXCE')IKEY='EXCE'
      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.4--                                  **
C               **  FOR ALL VARIATIONS OF THE PRE-FIT COMMAND,  **
C               **  EXTRACT THE UNDERLYING FUNCTION             **
C               **  FROM FUNCTION DEFINITIONS.                  **
C               **************************************************
C
C
      ISTEPN='6.4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5170I=1,NUMCHA
      I2=I
      IF(MODEL(I).EQ.'=')GOTO5175
 5170 CONTINUE
      IBRAN=5170
      WRITE(ICOUT,5171)IBRAN
 5171 FORMAT('*****INTERNAL ERROR IN DPPREF--',
     1'IMPOSSIBLE CONDITION AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5172)
 5172 FORMAT('NO EQUAL SIGN FOUND FOR MODEL EXTRACTION')
      CALL DPWRST('XXX','BUG ')
       WRITE(ICOUT,5173)
 5173 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5174)(IANS(I),I=1,IWIDTH)
 5174 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5175 CONTINUE
      ILOCEQ=I2
C
      IWD1='=   '
      IWD12='    '
      IF(ICASEQ.EQ.'FULL')IWD2='    '
      IF(ICASEQ.EQ.'FULL')IWD22='    '
      IF(ICASEQ.EQ.'SUBS'.AND.IKEY.EQ.'SUBS')IWD2='SUBS'
      IF(ICASEQ.EQ.'SUBS'.AND.IKEY.EQ.'SUBS')IWD22='ET  '
      IF(ICASEQ.EQ.'SUBS'.AND.IKEY.EQ.'EXCE')IWD2='EXCE'
      IF(ICASEQ.EQ.'SUBS'.AND.IKEY.EQ.'EXCE')IWD22='PT  '
      IF(ICASEQ.EQ.'FOR')IWD2='FOR '
      IF(ICASEQ.EQ.'FOR')IWD22='    '
C
      IF(ICASFI.EQ.'FIT'.OR.ICASFI.EQ.'RFIT')
     1CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(ICASFI.NE.'FIT'.AND.ICASFI.NE.'RFIT')
     1CALL DPEXST(MODEL,IWIDMO,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3379
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3371)
 3371 FORMAT('***** ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3372)
 3372 FORMAT('      INVALID COMMAND FORM FOR PRE-FITTING.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3373)
 3373 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3374)
 3374 FORMAT('      PRE-FIT ... = ...  ',
     1'SUBSET ... ... ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3375)
 3375 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3376)(IANS(I),I=1,IWIDTH)
 3376 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3379 CONTINUE
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      J=ILOCEQ
      DO5180I=1,N3
      J=J+1
      MODEL(J)=IFUNC3(I)
 5180 CONTINUE
      NUMCHA=J
C
C               **********************************************************
C               **  STEP 7--                                            **
C               **  MAKE A NON-CALCULATING PASS AT THE MODEL            **
C               **  SO AS TO EXTRACT ALL PARAMETER AND VARIABLE NAMES.  **
C               **********************************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPASS=1
CCCCC CALL COMPI2(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
CCCCC1IANGLU,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,PRED,
CCCCC1IBUGCO,IBUGEV,IERROR)
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,AJUNK,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 8--                              **
C               **  CHECK TO MAKE SURE THAT THE COMBINED  **
C               **  NUMBER OF PARAMETERS AND VARIABLES    **
C               **  IN THE MODEL IS AT LEAST 1.           **
C               ********************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMPV.GE.1)GOTO4400
      WRITE(ICOUT,4401)
 4401 FORMAT('***** ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4402)
 4402 FORMAT('      COMBINED NUMBER OF PARAMETERS AND VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4403)NUMVAR
 4403 FORMAT('      DETECTED IN THE MODEL IS 0.   NUMVP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4407)NUMCHA
 4407 FORMAT('      NUMBER OF CHARACTERS IN MODEL = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCHA.GE.1)WRITE(ICOUT,4408)(MODEL(J),J=1,NUMCHA)
 4408 FORMAT('      MODEL--',100A1)
      IF(NUMCHA.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4400 CONTINUE
C
C               **************************************************************
C               **  STEP 9--                                                **
C               **  CHECK THAT ALL VARIABLES                                **
C               **  IN THE MODEL ARE ALREADY PRESENT                        **
C               **  IN THE AVAILABLE NAME LIST IHNAME(.) AND IHNAM2(.).     **
C               **  CHECK THAT ALL PARAMETERS                               **
C               **  IN THE MODEL ARE ALREADY PRESENT                        **
C               **  IN THE AVAILABLE NAME LIST IHNAME(.) AND IHNAM2(.).     **
C               **  ALL NAMES IN THE MODEL THAT ARE NOT                     **
C               **  IN THE NAME LIST AT ALL WILL BE ADDED                   **
C               **  TO THE LIST, DEFINED AS PARAMETERS,                     **
C               **  AND GIVEN A VALUE OF 1.0.                               **
C               **  THIS ALLOWS US TO MAKE AN INITIAL PRE-FIT
C               **  WITHOUT HAVING TO DEFINE STARTING VALUES AT ALL         **
C               **  (THEY WILL BE AUTOMATICALLY SET TO 1.0).                **
C               **  ALSO, FORM A NEW VECTOR WHICH HAS ONLY PARAMETER NAMES  **
C               **  AND ANOTHER VECTOR WHICH HAS ONLY VARIABLE NAMES.       **
C               **************************************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IP=0
      IV=0
      DO4165J=1,NUMPV
      IHPARN=IPARN(J)
      IHPAR2=IPARN2(J)
      DO4166I=1,NUMNAM
      I2=I
      IF(IHPARN.EQ.IHNAME(I).AND.IHPAR2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO4180
      IF(IHPARN.EQ.IHNAME(I).AND.IHPAR2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO4170
 4166 CONTINUE
      IP=IP+1
      IPARN3(IP)=IPARN(J)
      IPARN4(IP)=IPARN2(J)
      PARAM3(IP)=1.0
C
      IF(NUMNAM.LT.MAXNAM)GOTO7769
      WRITE(ICOUT,7751)
 7751 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7752)
 7752 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7753)MAXNAM
 7753 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7754)
 7754 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7755)
 7755 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7756)
 7756 FORMAT('      WAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7757)
 7757 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7758)
 7758 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7759)
 7759 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7760)
 7760 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7761)
 7761 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7762)
 7762 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7763)(IANS(I),I=1,IWIDTH)
 7763 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 7769 CONTINUE
C
      I2=NUMNAM+1
      IHNAME(I2)=IPARN(J)
      IHNAM2(I2)=IPARN2(J)
      IUSE(I2)='P'
      IVALUE(I2)=1
      VALUE(I2)=1.0
      IN(I2)=1
      NUMNAM=I2
CCCCC IF(IFEEDB.EQ.'OFF')GOTO4259
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,4252)
C4252 FORMAT('      NOTE--A NAME USED IN AN EXPRESSION')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,4253)IPARN(J),IPARN2(J)
C4253 FORMAT('      HAS NOT YET BEEN DEFINED.  NAME = ',A4,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,4255)
C4255 FORMAT('      THIS NAME HAS BEEN ADDED TO THE LIST,')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,4256)
C4256 FORMAT('      SPECIFIED AS A PARAMETER,')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,4257)
C4257 FORMAT('      AND GIVEN THE VALUE 1.0 .')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,4258)(MODEL(I),I=1,NUMCHA)
C4258 FORMAT('      FUNCTION EXPRESSION--'100A1)
CCCCC CALL DPWRST('XXX','BUG ')
C4259 CONTINUE
      GOTO4165
 4170 CONTINUE
      IP=IP+1
      IPARN3(IP)=IPARN(J)
      IPARN4(IP)=IPARN2(J)
      PARAM3(IP)=VALUE(I2)
      GOTO4165
 4180 CONTINUE
      IV=IV+1
CCCCC LOCX(IV)=J
      IVARN3(IV)=IPARN(J)
      IVARN4(IV)=IPARN2(J)
      ICOLV3(IV)=IVALUE(I2)
      NIV(IV)=IN(I2)
      GOTO4165
 4165 CONTINUE
      NUMPAR=IP
      NUMVAR=IV
C
C               *******************************************
C               **  STEP 10--                            **
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               **  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='10'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.GE.1.AND.NUMVAR.LE.MAXV2)GOTO520
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A LEAST SQUARES PRE-FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)
  553 FORMAT('      THE NUMBER OF INDEPENDENT VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)MAXV2
  554 FORMAT('      MUST BE AT LEAST 1 AND AT MOST ',I8,'  ;')
      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)NUMVAR
  557 FORMAT('      OF INDEPENDENT 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 ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4507)NUMCHA
 4507 FORMAT('      NUMBER OF CHARACTERS IN MODEL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4508)(MODEL(J),J=1,NUMCHA)
 4508 FORMAT('      MODEL--',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4504)
 4504 FORMAT('      VARIABLES EXTRACTED FROM MODEL--')
      CALL DPWRST('XXX','BUG ')
      DO4505J=1,NUMVAR
      WRITE(ICOUT,4506)J,IVARN3(J),IVARN4(J),ICOLV3(J)
 4506 FORMAT('I,IVARN3(I),IVARN4(I),ICOLV3(I) = ',I8,2X,A4,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
 4505 CONTINUE
      IERROR='YES'
      GOTO9000
C
  520 CONTINUE
      DO540J=1,NUMVAR
      IF(NIV(J).NE.NLEFT)GOTO560
  540 CONTINUE
      GOTO590
C
  560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,561)
  561 FORMAT('***** ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)
  562 FORMAT('      FOR A LEAST SQUARES PRE-FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,564)
  564 FORMAT('      IN EACH INDEPENDENT VARIABLE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,565)
  565 FORMAT('      SHOULD BE THE SAME AS THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,566)
  566 FORMAT('      IN THE DEPENDENT VARIABLE (RESPONSE);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,567)
  567 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('      DEPENDENT   VARIABLE  (RESPONSE)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)IHLEFT,IHLEF2,NLEFT
  572 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,576)
  576 FORMAT('      INDEPENDENT VARIABLES           --')
      CALL DPWRST('XXX','BUG ')
      DO580J=1,NUMVAR
      WRITE(ICOUT,578)IVARN3(J),IVARN4(J),NIV(J)
  578 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
  580 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               ****************************************************************
C               **  STEP 11--
C               **  DUMP THE COMMON VECTOR V(.) OUT ONTO MASS STORAGE
C               **  SO AS TO PRESERVE THEIR CONTENTS FOR LATER USE
C               **  (AFTER DPPRE2).
C               **  THE ABOVE DUMP TO MASS STORAGE IS UNNECESSARY AND IS NOT DON
C               **  FOR THE SPECIAL CASE WHEN THE NUMBER OF PARAMETERS
C               **  IS 0 (A NO-PRE-FIT CASE WHEREBY WE ARE REALLY INTERESTED
C               **  IN GENERATING PREDICTED VALUES AND RESIDUALS
C               **  FOR A GIVEN FULLY-SPECIFIED MODEL).
C               ****************************************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOP='WRIT'
      CALL DPSWAP(IOP,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
     1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGA3,ISUBRO,IERROR)
C
C               *************************************************************
C               **  STEP 12--                                              **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; THEN                **
C               **  COPY OVER THE RESPONSE VECTOR TO BE USED IN THE MODEL  **
C               **  INTO THE VECTOR Y; AND                                 **
C               **  COPY OVER THE VECTORS THAT WERE USED IN THE MODEL      **
C               **  INTO THE VECTORS X1, X2, X3,X4, AND X5.                **
C               **  (MAX NUMBER OF ALLOWABLE VECTORS = 5.)                 **
C               *************************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON')WRITE(ICOUT,601)N,NUMVAR
  601 FORMAT('N,NUMVAR = ',2I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
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 DPSUB3(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
      K=ICOLL
      J=0
      DO4500I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO4500
      J=J+1
      IJ=MAXN*(K-1)+I
      IF(K.LE.MAXCOL)Y(J)=V(IJ)
      IF(K.EQ.MAXCP1)Y(J)=PRED(I)
      IF(K.EQ.MAXCP2)Y(J)=RES(I)
      IF(K.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(K.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(K.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(K.EQ.MAXCP6)Y(J)=TAGPLO(I)
 4500 CONTINUE
C
      K=ICOLV3(1)
      J=0
      DO4510I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO4510
      J=J+1
      IJ=MAXN*(K-1)+I
      IF(K.LE.MAXCOL)X1(J)=V(IJ)
      IF(K.EQ.MAXCP1)X1(J)=PRED(I)
      IF(K.EQ.MAXCP2)X1(J)=RES(I)
      IF(K.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(K.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(K.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(K.EQ.MAXCP6)X1(J)=TAGPLO(I)
 4510 CONTINUE
      IF(NUMVAR.LE.1)GOTO4590
C
      K=ICOLV3(2)
      J=0
      DO4520I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO4520
      J=J+1
      IJ=MAXN*(K-1)+I
      IF(K.LE.MAXCOL)X2(J)=V(IJ)
      IF(K.EQ.MAXCP1)X2(J)=PRED(I)
      IF(K.EQ.MAXCP2)X2(J)=RES(I)
      IF(K.EQ.MAXCP3)X2(J)=YPLOT(I)
      IF(K.EQ.MAXCP4)X2(J)=XPLOT(I)
      IF(K.EQ.MAXCP5)X2(J)=X2PLOT(I)
      IF(K.EQ.MAXCP6)X2(J)=TAGPLO(I)
 4520 CONTINUE
      IF(NUMVAR.LE.2)GOTO4590
C
      K=ICOLV3(3)
      J=0
      DO4530I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO4530
      J=J+1
      IJ=MAXN*(K-1)+I
      IF(K.LE.MAXCOL)X3(J)=V(IJ)
      IF(K.EQ.MAXCP1)X3(J)=PRED(I)
      IF(K.EQ.MAXCP2)X3(J)=RES(I)
      IF(K.EQ.MAXCP3)X3(J)=YPLOT(I)
      IF(K.EQ.MAXCP4)X3(J)=XPLOT(I)
      IF(K.EQ.MAXCP5)X3(J)=X2PLOT(I)
      IF(K.EQ.MAXCP6)X3(J)=TAGPLO(I)
 4530 CONTINUE
      IF(NUMVAR.LE.3)GOTO4590
C
      K=ICOLV3(4)
      J=0
      DO4540I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO4540
      J=J+1
      IJ=MAXN*(K-1)+I
      IF(K.LE.MAXCOL)X4(J)=V(IJ)
      IF(K.EQ.MAXCP1)X4(J)=PRED(I)
      IF(K.EQ.MAXCP2)X4(J)=RES(I)
      IF(K.EQ.MAXCP3)X4(J)=YPLOT(I)
      IF(K.EQ.MAXCP4)X4(J)=XPLOT(I)
      IF(K.EQ.MAXCP5)X4(J)=X2PLOT(I)
      IF(K.EQ.MAXCP6)X4(J)=TAGPLO(I)
 4540 CONTINUE
      IF(NUMVAR.LE.4)GOTO4590
C
      K=ICOLV3(5)
      J=0
      DO4550I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO4550
      J=J+1
      IJ=MAXN*(K-1)+I
      IF(K.LE.MAXCOL)X5(J)=V(IJ)
      IF(K.EQ.MAXCP1)X5(J)=PRED(I)
      IF(K.EQ.MAXCP2)X5(J)=RES(I)
      IF(K.EQ.MAXCP3)X5(J)=YPLOT(I)
      IF(K.EQ.MAXCP4)X5(J)=XPLOT(I)
      IF(K.EQ.MAXCP5)X5(J)=X2PLOT(I)
      IF(K.EQ.MAXCP6)X5(J)=TAGPLO(I)
 4550 CONTINUE
 4590 CONTINUE
      NS=J
C
C               ****************************************************************
C               **  STEP 13--
C               **  PREPARE FOR ENTRANCE INTO DPPRE2--
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C               **  SET THE ICON3 VECTOR
C               **  (WHICH INDICATES WHICH PARAMETERS ARE TO BE HELD CONSTANT)
C               **  EQUAL TO 0 THROUGHOUT.
C               **  DEFINE CONSTRAINTS AND LIMITS.
C               ****************************************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO4592I=1,NS
      W(I)=1.0
 4592 CONTINUE
C
      DO4195I=1,NUMPAR
      ICON3(I)=0
 4195 CONTINUE
C
      IF(NUMCON.EQ.0)GOTO4890
      DO4700I=1,NUMPAR
      DO4800J=1,NUMCON
      J2=J
      IF(IPARN3(I).EQ.IPARNC(J).AND.IPARN4(I).EQ.IPANC2(J))GOTO4810
 4800 CONTINUE
      IPARO3(I)='NONE'
      GOTO4700
 4810 CONTINUE
      IPARO3(I)=IPAROC(J2)
      PARLI3(I)=PARLIM(J2)
 4700 CONTINUE
 4890 CONTINUE
C
C               ********************
C               **  STEP 14--     **
C               **  ENTER DPPRE2. **
C               ********************
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO6099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6081)
 6081 FORMAT('***** FROM DPPREF, AS WE ARE ABOUT TO CALL DPPRE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6082)NUMCHA,NLEFT,MAXN,NS,NUMPV,NUMPAR,NUMVAR
 6082 FORMAT('NUMCHA,NLEFT,MAXN,NS,NUMPV,NUMPAR,NUMVAR = ',7I8)
      CALL DPWRST('XXX','BUG ')
      DO6083I=1,NS
      WRITE(ICOUT,6084)I,Y(I),X1(I),X2(I),X3(I),X4(I),X5(I),W(I)
 6084 FORMAT('I,Y(I),X1(I),X2(I),X3(I),X4(I),X5(I),W(I) = ',
     1I6,2X,7F10.5)
      CALL DPWRST('XXX','BUG ')
 6083 CONTINUE
      WRITE(ICOUT,6085)(MODEL(I),I=1,NUMCHA)
 6085 FORMAT('MODEL(.)--',120A1)
      CALL DPWRST('XXX','BUG ')
      DO6086J=1,NUMPAR
      WRITE(ICOUT,6087)J,IPARN3(J),IPARN4(J),PARAM3(J),ICON3(J)
 6087 FORMAT('I,IPARN3(I),IPARN4(I),PARAM3(I),ICON3(I) = ',
     1I8,2X,A4,A4,E15.7,A4)
      CALL DPWRST('XXX','BUG ')
 6086 CONTINUE
      DO6088J=1,NUMVAR
      WRITE(ICOUT,6089)J,IVARN3(J),IVARN4(J),ICOLV3(J)
 6089 FORMAT('I,IVARN3(I),IVARN4(I),ICOLV3(I) = ',I8,2X,A4,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
 6088 CONTINUE
CCCCC IBUGA3='ABCD'
CCCCC IBUGCO='EFGH'
CCCCC IBUGEV='IJKL'
      WRITE(ICOUT,6091)IBUGA3,IBUGCO,IBUGEV
 6091 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 6099 CONTINUE
C
CCCCC JUNE 1990.  DIMENSION DUM1, DUM2 IN DPPREF RATHER THAN DPPRE2.
      CALL DPPRE2(Y,X1,X2,X3,X4,X5,NUMVAR,IVARN3,IVARN4,W,NS,
     1MODEL,NUMCHA,PARAM3,IPARN3,IPARN4,NUMPAR,ICON3,IANGLU,IPARO3,
     1PARLI3,V,MAXITS,FITSD,FITPOW,CPUEPS,
     1ITYPEH,IW2HOL,IW22HO,W2HOLD,NWHOLD,
     1IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IREP,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
CCCCC THE FOLLOWING LINE WAS AUGMENTED    NOVEMBER 1995
CCCCC1DUM1,DUM2,
     1DUM1,DUM2,IANS,IWIDTH,
     1IBUGA3,IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO8000
C
C               ***************************************
C               **  STEP 15--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
 7000 CONTINUE
C
      ISTEPN='15'
      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
      IF(ICASFI.EQ.'FIT')GOTO7900
      IF(ICASFI.EQ.'RFIT')GOTO7900
C
      L=0
      DO7600J=1,K1
      L=L+1
      IH2='    '
      IF(J.EQ.1)IH='A0  '
      IF(J.EQ.2)IH='A1  '
      IF(J.EQ.3)IH='A2  '
      IF(J.EQ.4)IH='A3  '
      IF(J.EQ.5)IH='A4  '
      IF(J.LE.5)GOTO7640
      IF(J.EQ.6)IH='A5  '
      IF(J.EQ.7)IH='A6  '
      IF(J.EQ.8)IH='A7  '
      IF(J.EQ.9)IH='A8  '
      IF(J.EQ.10)IH='A9  '
      IF(J.LE.10)GOTO7640
      IF(J.EQ.11)IH='A10 '
      IF(J.LE.11)GOTO7640
C
 7640 CONTINUE
      DO7650I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO7680
 7650 CONTINUE
      IF(NUMNAM.LT.MAXNAM)GOTO7670
      WRITE(ICOUT,7651)
 7651 FORMAT('***** ERROR IN DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7652)
 7652 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7653)MAXNAM
 7653 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7654)
 7654 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7655)
 7655 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7656)
 7656 FORMAT('      WAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7657)
 7657 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7658)
 7658 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7659)
 7659 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7660)
 7660 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7661)
 7661 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7662)
 7662 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7663)(IANS(I),I=1,IWIDTH)
 7663 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 7670 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      VALUE(ILOC)=PARAM3(L)
CCCCC IVALUE(ILOC)=VALUE(ILOC)+0.5      JUNE 10, 1987
      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
      GOTO7600
C
 7680 CONTINUE
      VALUE(I2)=PARAM3(L)
CCCCC IVALUE(ILOC)=VALUE(ILOC)+0.5      JUNE 9, 1987
CCCCC IVALUE(I2)=VALUE(I2)+0.5          JUNE 10, 1987
      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
      GOTO7600
C
 7600 CONTINUE
 7900 CONTINUE
C
C               ****************************************************************
C               **  STEP 16--
C               **  READ BACK IN FROM MASS STORAGE
C               **  THE CONTENTS OF THE V(.) VECTOR.
C               **  THE ABOVE RETRIEVAL FROM MASS STORAGE IS UNNECESSARY AND IS
C               **  FOR THE SPECIAL CASE WHEN THE NUMBER OF PARAMETERS
C               **  IS 0 (A NO-PRE-FIT CASE WHEREBY WE ARE REALLY INTERESTED
C               **  IN GENERATING PREDICTED VALUES AND RESIDUALS
C               **  FOR A GIVEN FULLY-SPECIFIED MODEL).
C               ****************************************************************
C
 8000 CONTINUE
C
      ISTEPN='16'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO8109
      WRITE(ICOUT,8101)
 8101 FORMAT('WE ARE IN DPPREF AND ARE ABOUT TO READ V BACK IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8102)MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1)
 8102 FORMAT('MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1) = ',
     15I6,3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8103)
 8103 FORMAT('NOTE THAT IF NUMBER OF PARAMETERS = 0, THEN ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8104)
 8104 FORMAT('NO   DUMP TO/RETRIEVAL FROM   MASS STORAGE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8105)
 8105 FORMAT('IS DONE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8106)NUMPAR
 8106 FORMAT('NUMPAR = ',I8)
      CALL DPWRST('XXX','BUG ')
 8109 CONTINUE
C
      IOP='READ'
      CALL DPSWAP(IOP,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
     1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGA3,ISUBRO,IERROR)
C
      IF(IBUGA2.EQ.'OFF')GOTO8129
      WRITE(ICOUT,8121)
 8121 FORMAT('WE ARE IN DPPREF AND HAVE JUST READ ',
     1'V(.) BACK IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8122)MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1)
 8122 FORMAT('MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1) = ',
     15I6,3E15.7)
      CALL DPWRST('XXX','BUG ')
 8129 CONTINUE
C
C               *************************************************
C               **  STEP 17--                                  **
C               **  COPY THE FINAL ESTIMATES FROM THE PRE-FIT  **
C               **  BACK INTO THE PARAMETERS.                  **
C               **  THESE FINAL ESTIMATES WILL THUS OVERWRITE  **
C               **  THE STARTING VALUES THAT WERE              **
C               **  ORIGINALLY ASSIGNED TO THE PARAMETERS.     **
C               *************************************************
C
 6000 CONTINUE
C
      ISTEPN='17'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMPAR.LE.0)GOTO6190
      DO6100J=1,NUMPAR
      IH=IPARN3(J)
      IH2=IPARN4(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      VALUE(ILOCP)=PARAM3(J)
CCCCC IVALUE(ILOCP)=VALUE(ILOCP)+0.5      JUNE 10, 1987
      VAL=VALUE(ILOCP)
      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(ILOCP)=IVAL
 6100 CONTINUE
 6190 CONTINUE
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 DPPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGCO,IBUGEV,IBUGQ
 9013 FORMAT('IBUGCO,IBUGEV,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NS,ICASFI
 9015 FORMAT('NS,ICASFI = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMNAM
 9016 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9017I=1,NUMNAM
      WRITE(ICOUT,9018)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
 9018 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9017 CONTINUE
      WRITE(ICOUT,9021)NUMPV
 9021 FORMAT('NUMPV = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMPV.LE.0)GOTO9029
      DO9022I=1,NUMPV
      WRITE(ICOUT,9023)I,IPARN(I),IPARN2(I)
 9023 FORMAT('I,IPARN(I),IPARN2(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9031)IP
 9031 FORMAT('IP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IP.LE.0)GOTO9039
      DO9032I=1,IP
      WRITE(ICOUT,9033)I,IPARN3(I),IPARN4(I)
 9033 FORMAT('I,IPARN3(I),IPARN4(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9039 CONTINUE
      WRITE(ICOUT,9041)IV
 9041 FORMAT('IV = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IV.LE.0)GOTO9049
      DO9042I=1,IV
      WRITE(ICOUT,9043)I,IVARN3(I),IVARN4(I)
 9043 FORMAT('I,IVARN3(I),IVARN4(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
 9049 CONTINUE
      WRITE(ICOUT,9051)MAXN2,NLEFT,NS,V(1),PRED(1),RES(1)
 9051 FORMAT('MAXN2,NLEFT,NS,V(1),PRED(1),RES(1) = ',3I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)ICASEQ
 9052 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)IWIDTH
 9061 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,9062)(IANS(I),I=1,IWIDTH)
 9062 FORMAT('(IANS(I),I=1,IWIDTH) = ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9063)IWIDMO
 9063 FORMAT('IWIDMO = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDMO.GE.1)WRITE(ICOUT,9064)(MODEL(I),I=1,IWIDMO)
 9064 FORMAT('(MODEL(I),I=1,IWIDMO) = ',100A1)
      IF(IWIDMO.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9069)IFOUND,IERROR
 9069 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPREG(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING PLOTS:
C              1) A PARTIAL REGRESSION PLOT
C              2) A PARTIAL RESIDUAL PLOT
C              3) A PARTIAL LEVERAGE PLOT
C              4) A CCPR (COMPONENT AND COMPONENT-PLUS-RESIDUAL) PLOT
C              DPPRPL GENERATES THE PARTIAL REGRESSION PLOTS FOR ALL
C              OF THE X VARIABLES WHILE THIS COMMAND GENERATES THE
C              COORDINATES FOR A SINGLE X VARIABLE.  NOTE THAT THIS
C              COMMAND ASSUMES THE FIT HAS ALREADY BEEN GENERATED
C              (THIS IS DONE AUTOMATICALLY IN DPPRPL) AND THE SYNTAX
C              IS THEN: PARTIAL Y X1 TO XK INDEX
C              WHERE INDEX IS A PARAMETER THAT IDENTIFIES WHICH OF
C              THE X VARIABLES TO USE.
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--2002/6
C     ORIGINAL VERSION--JUNE      2002.
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 IHP
      CHARACTER*4 IHP2
      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  MAXPRG IS THE MAXIMUM NUMBER OF VARIABLES TO USE IN CREATING THE
C  PARTIAL REGRESSION PLOT
C
      PARAMETER(MAXPRG=30)
C
      DIMENSION IVARN1(MAXPRG)
      DIMENSION IVARN2(MAXPRG)
      DIMENSION ILIS(MAXPRG)
      DIMENSION XMAT(15*MAXOBV)
      DIMENSION XSCRT1(15*MAXOBV)
      DIMENSION XSCRT2(15*MAXOBV)
      DIMENSION Y1(MAXOBV)
      DIMENSION YTEMP2(MAXOBV)
      DIMENSION YTEMP3(MAXOBV)
      DIMENSION RES2(MAXOBV)
      DIMENSION COEF(MAXPRG)
C
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (G2RBAG(1),XMAT(1))
      EQUIVALENCE (G2RBAG(15*MAXOBV+1),XSCRT1(1))
      EQUIVALENCE (G2RBAG(30*MAXOBV+1),XSCRT2(1))
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),YTEMP2(1))
      EQUIVALENCE (GARBAG(IGARB3),YTEMP3(1))
      EQUIVALENCE (GARBAG(IGARB4),RES2(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='DPPR'
      ISUBN2='EG  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=1
      NLOCAL=0
      NPLOTP=0
      NZ=0
      NPLOTV=0
      NS=0
C
      ICOLH=0
C
C               ***********************************************
C               **  TREAT THE PARTIAL REGRESSSION PLOT CASE  **
C               ***********************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PREG')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPREG--')
      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 ')
      WRITE(ICOUT,55)NUMARG
   55 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO59I=1,NUMARG
      WRITE(ICOUT,57)I,IHARG(I),IHARG2(I)
   57 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   59 CONTINUE
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PREG')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'REGR'.AND.
     1  IHARG(2).EQ.'PLOT')THEN
        ICASPL='PREG'
        GOTO112
      ENDIF
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'VARI'.AND.
     1  IHARG(2).EQ.'PLOT')THEN
        ICASPL='PREG'
        GOTO112
      ENDIF
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LEVE'.AND.
     1  IHARG(2).EQ.'PLOT')THEN
        ICASPL='PLEV'
        GOTO112
      ENDIF
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'RESI'.AND.
     1  IHARG(2).EQ.'PLOT')THEN
        ICASPL='PRES'
        GOTO112
      ENDIF
C
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'PLUS'.AND.
     1  IHARG(2).EQ.'RESI'.AND.IHARG(3).EQ.'PLOT')THEN
        ICASPL='PRES'
        GOTO112
      ENDIF
C
      IF(ICASPL.EQ.'CCPR'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')THEN
        ICASPL='CCPR'
        GOTO111
      ENDIF
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO119
C
  112 CONTINUE
      ILASTC=2
      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.'PREG')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=3
      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.'PREG')
     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.'PREG')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               **  NOTE: LAST "VARIABLE" SHOULD BE A PARAMETER **
C               **        CONTAINING THE "INDEX" OF THE PRIMARY **
C               **        VARIABLE OF THE PLOT.                 **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PREG')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=ILOCQ-1
      CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXPRG,
     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 AND THE SAME      **
C               **  NUMBER OF OBSERVATIONS           **
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PREG')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFLAG=0
      NVTOT=NUMVAR
      NUMVAR=NUMVAR-1
      DO1300I=1,NVTOT
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)NTEMP=NRIGHT
      ILIS(I)=ILOCV
      IF(NRIGHT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1311)
 1311   FORMAT('***** ERROR IN DPPREG--')
        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 PARTIAL REGRESSSION 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)THEN
          WRITE(ICOUT,1329)(IANS(J),J=1,MIN(80,IWIDTH))
 1329     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ELSE IF(NRIGHT.NE.NTEMP)THEN
        WRITE(ICOUT,1411)
 1411   FORMAT('***** ERROR IN DPPREG--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1413)
 1413   FORMAT('      THE NUMBER OF OBSERVATIONS IN ALL VARIABLES ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1414)
 1414   FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        I2=ILIS(I)
        WRITE(ICOUT,1416)IVARN1(I2),IVARN2(I2),IN(I2)
 1416   FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1         ' OBSERVATIONS;')
        CALL DPWRST('XXX','BUG ')
 1417   CONTINUE
        WRITE(ICOUT,1420)
 1420   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1421)(IANS(L),L=1,MIN(100,IWIDTH))
 1421     FORMAT('      ',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
 1300 CONTINUE
C
      IF(NUMVAR*NRIGHT.GT.15*MAXOBV)THEN
        WRITE(ICOUT,1501)
 1501   FORMAT('***** ERROR IN DPPREG--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1503)
 1503   FORMAT('      SCRATCH SPACE EXCEEDED.  USE FEWER VARIABLES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1505)15*MAXOBV
 1505   FORMAT('      ROWS TIMES COLUMMS MUST BE <= ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1507)NRIGHT,NUMVAR,NUMVAR*NRIGHT
 1507   FORMAT('      CURRENT: ROWS = ',I8,', COLUMNS = ',I8,
     1         ', TOTAL = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ******************************************************
C               **  STEP 1.5--                                      **
C               **  LAST VARIABLE IDENTIFIES THE PRIMARY VARIABLE   **
C               **  (WHICH SHOULD ALREADY BE IN THE LIST)           **
C               ******************************************************
C
      IHRIGH=IVARN1(NVTOT)
      IHRIG2=IVARN2(NVTOT)
C
      DO1521I=2,NUMVAR
        IF(IHRIGH.EQ.IVARN1(I).AND.IHRIG2.EQ.IVARN2(I))THEN
          IX=I
          GOTO1529
        ENDIF
 1521 CONTINUE
      WRITE(ICOUT,1523)
 1523 FORMAT('***** ERROR IN DPPREG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)IHRIGH,IHRIG2
 1525 FORMAT('      THE NAME OF THE PRIMARY VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1527)
 1527 FORMAT('      DOES NOT MATCH ANY OF THE INDEPENDENT VARIABLES.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1529 CONTINUE
C
C               ******************************************************
C               **  STEP 1.6--                                      **
C               **  EXTRACT FIT COEFFICIENTS FROM PREVIOUS FIT.     **
C               **  (A0, A1, ....)                                  **
C               ******************************************************
C
      IHP='A0  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      COEF(1)=VALUE(ILOCP)
C
      NX=NUMVAR-1
      DO1610I=1,MIN(9,NX)
        IHP='A   '
        WRITE(IHP(2:2),'(I1)')I
        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
        COEF(I+1)=VALUE(ILOCP)
 1610 CONTINUE
      IF(NX.GE.10)THEN
        DO1620I=1,MIN(10,NX)
          IHP='A   '
          WRITE(IHP(2:3),'(I2)')I
          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
          COEF(I+1)=VALUE(ILOCP)
 1620   CONTINUE
      ENDIF
C
      NX=NUMVAR-1
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.'PREG')
     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.'PREG')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2200K=1,NVTOT-1
      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 DPPREG 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.'PREG')
     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.'PREG')
     1CALL DPWRST('XXX','BUG ')
      IF(K.EQ.1)THEN
        IF(ICOLR.LE.MAXCOL)Y1(J)=V(IJ)
        IF(ICOLR.EQ.MAXCP1)Y1(J)=PRED(I)
        IF(ICOLR.EQ.MAXCP2)Y1(J)=RES(I)
        IF(ICOLR.EQ.MAXCP3)Y1(J)=YPLOT(I)
        IF(ICOLR.EQ.MAXCP4)Y1(J)=XPLOT(I)
        IF(ICOLR.EQ.MAXCP5)Y1(J)=X2PLOT(I)
        IF(ICOLR.EQ.MAXCP6)Y1(J)=TAGPLO(I)
        RES2(J)=RES(I)
        XMAT(J)=1.0
      ELSE
        IJK=(K-1)*NQ+J
        IF(ICOLR.LE.MAXCOL)XMAT(IJK)=V(IJ)
        IF(ICOLR.EQ.MAXCP1)XMAT(IJK)=PRED(I)
        IF(ICOLR.EQ.MAXCP2)XMAT(IJK)=RES(I)
        IF(ICOLR.EQ.MAXCP3)XMAT(IJK)=YPLOT(I)
        IF(ICOLR.EQ.MAXCP4)XMAT(IJK)=XPLOT(I)
        IF(ICOLR.EQ.MAXCP5)XMAT(IJK)=X2PLOT(I)
        IF(ICOLR.EQ.MAXCP6)XMAT(IJK)=TAGPLO(I)
      ENDIF
 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.'PREG')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPPRG2(Y1,YTEMP2,YTEMP3,RES2,COEF,ITEMP1,
     1XMAT,XSCRT1,XSCRT2,ICASPL,
     1NLOCAL,NUMVAR,IX,MAXPRG,
     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.'PREG')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPREG--')
      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)NLOCAL
 9021 FORMAT('NLOCAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NLOCAL.LE.0)GOTO9024
      DO9022I=1,NLOCAL
      WRITE(ICOUT,9023)I,Y1(I),RES2(I),XMAT(I)
 9023 FORMAT('I,YTEMP1(I),RES(I),XMAT(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9024 CONTINUE
      WRITE(ICOUT,9041)NZ,NPLOTV,NPLOTP
 9041 FORMAT('NZ,NPLOTV,NPLOTP = ',3I8)
      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 DPPRG2(Y1,Y2,Y3,RES,COEF,ITEMP1,
     1XMAT,XSCRT1,XSCRT2,ICASPL,
     1N,NUMVAR,IX,MAXPRG,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING PLOTS:
C              1) A PARTIAL REGRESSION PLOT
C              2) A PARTIAL RESIDUAL PLOT
C              3) A PARTIAL LEVERAGE PLOT
C              4) A CCPR (COMPONENT AND COMPONENT-PLUS-RESIDUAL) PLOT
C              DPPRPL GENERATES THE PARTIAL REGRESSION PLOTS FOR ALL
C              OF THE X VARIABLES WHILE THIS COMMAND GENERATES THE
C              COORDINATES FOR A SINGLE X VARIABLE.  NOTE THAT THIS
C              COMMAND ASSUMES THE FIT HAS ALREADY BEEN GENERATED
C              (THIS IS DONE AUTOMATICALLY IN DPPRPL) AND THE SYNTAX
C              IS THEN: PARTIAL Y X1 TO XK INDEX
C              WHERE INDEX IS A PARAMETER THAT IDENTIFIES WHICH OF
C              THE X VARIABLES TO USE.
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--2002/6
C     ORIGINAL VERSION--JUNE      2002.
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
      DOUBLE PRECISION DSUM1
C
      DIMENSION XMAT(N,NUMVAR)
      DIMENSION XSCRT1(N,NUMVAR)
      DIMENSION XSCRT2(N,NUMVAR)
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y3(*)
      DIMENSION RES(*)
      DIMENSION ITEMP1(*)
      DIMENSION COEF(*)
C
      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='DPPR'
      ISUBN2='G2  '
C
      IERROR='NO'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LE.1)THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPPRG2--')
      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
      ENDIF
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PRG2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPPRG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,NUMVAR,N,IX
   72 FORMAT('ICASPL,NUMVAR,N,IX = ',A4,2X,3I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.GT.0)THEN
      DO81I=1,N
      WRITE(ICOUT,82)I,Y(I),(XMAT(I,K),K=1,MIN(5,NUMVAR))
   82 FORMAT('I,Y(I),XMAT(I,K) = ',I8,6E12.5)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      ENDIF
      DO85I=1,NUMVAR
      WRITE(ICOUT,87)I,COEF(I)
   87 FORMAT('I,COEF(I) = ',I8,E12.5)
      CALL DPWRST('XXX','BUG ')
   85 CONTINUE
   90 CONTINUE
C
C               ****************************************
C               **  STEP 11--                         **
C               **  DETERMINE PLOT COORDINATES        **
C               **  PARTIAL REGRESSION PLOT CASE      **
C               ****************************************
C
      IF(ICASPL.EQ.'PREG')THEN
C
        CALL CATCHR(XMAT,XSCRT1,XSCRT2,Y2,Y3,ITEMP1,
     1              N,NUMVAR,N,NUMVAR,
     1              IBUGG3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PRG2')THEN
          IF(N.GT.0)THEN
            DO101I=1,N
            WRITE(ICOUT,102)I,(XSCRT2(I,K),K=1,MIN(7,NUMVAR))
  102       FORMAT('I,XSCRT(I,K) = ',I8,7E12.5)
            CALL DPWRST('XXX','BUG ')
  101       CONTINUE
          ENDIF
        ENDIF
C
        DSUM1=0.0D0
        DO110I=1,N
          DSUM1=DSUM1 + DBLE(XSCRT2(I,IX))**2
  110   CONTINUE
        DENOM=REAL(DSUM1)
        DO120I=1,N
          XJDOTJ=XSCRT2(I,IX)/DENOM
          Y(I)=RES(I) + COEF(IX)*XJDOTJ
          X(I)=XJDOTJ
          D(I)=1.0
  120   CONTINUE
C
        NPLOTP=N
        NPLOTV=2
        GOTO9000
      ELSEIF(ICASPL.EQ.'PLEV')THEN
C
        CALL CATCHR(XMAT,XSCRT1,XSCRT2,Y2,Y3,ITEMP1,
     1              N,NUMVAR,N,NUMVAR,
     1              IBUGG3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PRG2')THEN
          IF(N.GT.0)THEN
            DO201I=1,N
            WRITE(ICOUT,202)I,(XSCRT2(I,K),K=1,MIN(7,NUMVAR))
  202       FORMAT('I,XSCRT(I,K) = ',I8,7E12.5)
            CALL DPWRST('XXX','BUG ')
  201       CONTINUE
          ENDIF
        ENDIF
C
        DSUM1=0.0D0
        DO210I=1,N
          DSUM1=DSUM1 + DBLE(XSCRT2(I,IX))**2
  210   CONTINUE
        DENOM=REAL(DSUM1)
        DSUM1=0.0
        DO220I=1,N
          XJDOTJ=XSCRT2(I,IX)/DENOM
          XJDOTJ=XJDOTJ*XJDOTJ
          DSUM1=DSUM1 + DBLE(XJDOTJ)
  220   CONTINUE
        DENOM2=REAL(DSUM1)
        DO230I=1,N
          XJDOTJ=XSCRT2(I,IX)/DENOM
          XJDOTJ=XJDOTJ*XJDOTJ
          Y(I)=XJDOTJ/DENOM2
          X(I)=REAL(I)
          D(I)=1.0
  230   CONTINUE
C
        NPLOTP=N
        NPLOTV=2
        GOTO9000
      ELSEIF(ICASPL.EQ.'PRES')THEN
C
        DO420I=1,N
          Y(I)=RES(I) + COEF(IX)*XMAT(I,IX)
          X(I)=XMAT(I,IX)
          D(I)=1.0
  420   CONTINUE
C
        NPLOTP=N
        NPLOTV=2
        GOTO9000
      ELSEIF(ICASPL.EQ.'CCPR')THEN
C
        DO520I=1,N
          Y(I)=RES(I) + COEF(IX)*XMAT(I,IX)
          X(I)=XMAT(I,IX)
          D(I)=1.0
  520   CONTINUE
C
        DO530I=1,N
          Y(I+N)=COEF(IX)*XMAT(I,IX)
          X(I+N)=XMAT(I,IX)
          D(I+N)=2.0
  530   CONTINUE
C
        NPLOTP=2*N
        NPLOTV=2
        GOTO9000
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,410)ICASPL
  410   FORMAT('***** ERROR IN DPPRG2: PLOT TYPE ',A4,' NOT ',
     1         'RECOGNIZED.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PRG2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPRG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,NUMVAR,NPLOTP,IERROR
 9012 FORMAT('ICASPL,NUMVAR,NPLOTP,IERROR = ',A4,2I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NPLOTP,NPLOTV
 9031 FORMAT('NPLOTP,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,NPLOTP
      WRITE(ICOUT,9036)I,Y(I),X(I),D(I)
 9036 FORMAT('I,Y(I),X(I),D(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPRES(IHARG,NUMARG,ISORSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PRE-SORT SWITCH ISORSW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--ISORSW  ('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--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 ISORSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1199
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'SORT')GOTO1150
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SORT')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')GOTO1150
      GOTO1199
C
 1150 CONTINUE
      ISORSW='ON'
      GOTO1180
C
 1160 CONTINUE
      ISORSW='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)ISORSW
 1181 FORMAT('THE PRE-SORT SWITCH HAS JUST BEEN TURNED ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPRFO(IHARG,NUMARG,
     1IPRITY,IFOUND,IERROR)
C
C     PURPOSE--SET THE FORMAT/TYPE SWITCH FOR THE PRINTER.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IPRITY (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-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--92/4
C     ORIGINAL VERSION--MARCH     1992.
C     UPDATED         --FEBRUARY  1993.  DEFAULT CHANGED TO POSTSCRIPT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IPRITY
      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')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'?')GOTO1160
      GOTO1170
C
 1150 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGED FEBRUARY 1993
CCCCC IHOLD='ASCI'
      IHOLD='POST'
      GOTO1180
C
 1160 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1161)IPRITY
 1161 FORMAT('THE CURRENT FORMAT FOR THE PRINTER IS ',A4)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      IFOUND='YES'
      GOTO1199
C
 1170 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IPRITY=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IPRITY
 1181 FORMAT('THE PRINTER FORMAT SWITCH HAS JUST ',
     1'BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPRIF(ILAB,NUMWDL,IFUNC,NCF,IBUGA3)
C
C     PURPOSE--PRINT OUT A FUNCTION IN A NEAT FORM.
C     NOTE--THIS SUBROUTINE IS NECESSITATED BECAUSE
C           SOME STORED WORDS HAVE 1 CHARACTER (E.G, A, B, C, ETC.)
C           WHILE OTHERS HAVE SEVERAL CHARACTERS PACKED INTO
C           A SINGLE WORD (E.G., SQRT, ARCT, ETC.).
C     NOTE--ILAB(.) AND IFUNC(.) ARE HOLLERITH A4 VECTORS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JULY      1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ILAB
      CHARACTER*4 IFUNC
      CHARACTER*4 IBUGA3
C
      CHARACTER*4 IBLANK
      CHARACTER*4 IBUF
      CHARACTER*4 ILAST
      CHARACTER*4 IB
      CHARACTER*4 ICH
C
C---------------------------------------------------------------------
C
      DIMENSION ILAB(*)
      DIMENSION IFUNC(*)
C
      DIMENSION IB(140)
      DIMENSION ICH(10)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA MAXCPL/128/
      DATA NUMASC/4/
C
C-----START POINT-----------------------------------------------------
C
      ILAST='UNKN'
C
C               *******************************************************
C               **  DECOMPOSE EACH WORD INTO INDIVIDUAL CHARACTERS.  **
C               **  PRINT OUT ONLY THE LEADING NON-BLANK CHARACTERS. **
C               *******************************************************
C
      IBLANK=' '
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 DPPRIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NUMWDL
   52 FORMAT('NUMWDL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)(ILAB(I),I=1,NUMWDL)
   53 FORMAT('ILAB(.) = ',30A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NCF
   55 FORMAT('NCF = ',I8)
      CALL DPWRST('XXX','BUG ')
CCCCC FEBRUARY 1995.  CHECK FOR NCF > 30.
      NPRINT=NCF
      IF(NPRINT.GT.30)NPRINT=30
CCCCC IF(NCF.GE.1)WRITE(ICOUT,56)(IFUNC(I),I=1,NCF)
      IF(NPRINT.GE.1)WRITE(ICOUT,56)(IFUNC(I),I=1,NPRINT)
   56 FORMAT('IFUNC(.) = ',30A4)
      IF(NCF.GE.1)CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      NUMCPL=MAXCPL-NUMWDL*NUMASC
C
      L=0
      IL=0
      ICF=0
      IF(NCF.LE.0)ILAST='YES'
      IF(NCF.GE.1)ILAST='NO'
      IBUF='NO'
  100 CONTINUE
      ICF=ICF+1
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,101)ICF,L,IBUF,ILAST,IL
  101 FORMAT('ICF,L,IBUF,ILAST,IL = ',I8,I8,2X,A4,2X,A4,I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICF.GT.NCF)GOTO300
      IF(ICF.EQ.NCF)ILAST='YES'
C
      CALL DPXH1H(IFUNC(ICF),ICH,IEND,IBUGA3)
C
      ITEST=L+IEND
      IF(ITEST.LE.NUMCPL)GOTO200
      IBUF='YES'
      GOTO300
C
  200 CONTINUE
      DO400I=1,IEND
      L=L+1
      IB(L)=ICH(I)
  400 CONTINUE
      GOTO100
C
  300 CONTINUE
      NUMCTL=L
      L=0
      IL=IL+1
C
      IF(NUMWDL.EQ.0)GOTO600
      IF(NUMWDL.EQ.1)GOTO610
      IF(NUMWDL.EQ.2)GOTO620
      IF(NUMWDL.EQ.3)GOTO630
      IF(NUMWDL.EQ.4)GOTO640
      IF(NUMWDL.EQ.5)GOTO650
      IF(NUMWDL.EQ.6)GOTO660
      IF(NUMWDL.EQ.7)GOTO670
      IF(NUMWDL.EQ.8)GOTO680
      IF(NUMWDL.GE.9)GOTO690
C
  600 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,606)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO609
      IF(IL.EQ.1)WRITE(ICOUT,606)(IB(K),K=1,MIN(NUMCTL,128))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,606)(IB(K),K=1,MIN(NUMCTL,128))
  606 FORMAT(128A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  605 CONTINUE
  609 CONTINUE
      GOTO700
C
  610 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,616)(ILAB(J),J=1,NUMWDL)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO619
      IF(IL.EQ.1)WRITE(ICOUT,616)(ILAB(J),J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,124))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,616)(IBLANK ,J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,128))
  616 FORMAT(A4,124A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  615 CONTINUE
  619 CONTINUE
      GOTO700
C
  620 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,626)(ILAB(J),J=1,NUMWDL)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO629
      IF(IL.EQ.1)WRITE(ICOUT,626)(ILAB(J),J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,120))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,626)(IBLANK ,J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,120))
  626 FORMAT(2A4,120A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  625 CONTINUE
  629 CONTINUE
      GOTO700
C
  630 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,636)(ILAB(J),J=1,NUMWDL)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO639
      IF(IL.EQ.1)WRITE(ICOUT,636)(ILAB(J),J=1,NUMWDL),
     1(IB(K),K=1,MIN(NUMCTL,116))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,636)(IBLANK ,J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,116))
  636 FORMAT(3A4,116A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  635 CONTINUE
  639 CONTINUE
      GOTO700
C
  640 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,646)(ILAB(J),J=1,NUMWDL)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO649
      IF(IL.EQ.1)WRITE(ICOUT,646)(ILAB(J),J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,112))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,646)(IBLANK ,J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,112))
  646 FORMAT(4A4,112A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  645 CONTINUE
  649 CONTINUE
      GOTO700
C
  650 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,656)(ILAB(J),J=1,NUMWDL)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO659
      IF(IL.EQ.1)WRITE(ICOUT,656)(ILAB(J),J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,108))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,656)(IBLANK ,J=1,NUMWDL),
     1          (IB(K),K=1,MIN(NUMCTL,108))
  656 FORMAT(5A4,108A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  655 CONTINUE
  659 CONTINUE
      GOTO700
C
  660 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,666)(ILAB(J),J=1,NUMWDL)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO669
      IF(IL.EQ.1)WRITE(ICOUT,666)(ILAB(J),J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,104))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,666)(IBLANK ,J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,104))
  666 FORMAT(6A4,104A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  665 CONTINUE
  669 CONTINUE
      GOTO700
C
  670 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,676)(ILAB(J),J=1,NUMWDL)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO679
      IF(IL.EQ.1)WRITE(ICOUT,676)(ILAB(J),J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,100))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,676)(IBLANK ,J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,100))
  676 FORMAT(7A4,100A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  675 CONTINUE
  679 CONTINUE
      GOTO700
C
  680 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,686)(ILAB(J),J=1,NUMWDL)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO689
      IF(IL.EQ.1)WRITE(ICOUT,686)(ILAB(J),J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,96))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,686)(IBLANK ,J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,96))
  686 FORMAT(8A4,96A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  685 CONTINUE
  689 CONTINUE
      GOTO700
C
  690 CONTINUE
      IF(NUMCTL.LE.0)WRITE(ICOUT,696)(ILAB(J),J=1,NUMWDL)
      IF(NUMCTL.LE.0)CALL DPWRST('XXX','BUG ')
      IF(NUMCTL.LE.0)GOTO699
      IF(IL.EQ.1)WRITE(ICOUT,696)(ILAB(J),J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,92))
      IF(IL.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IL.GE.2)WRITE(ICOUT,696)(IBLANK ,J=1,NUMWDL),
     1           (IB(K),K=1,MIN(NUMCTL,92))
  696 FORMAT(9A4,92A1)
      IF(IL.GE.2)CALL DPWRST('XXX','BUG ')
  695 CONTINUE
  699 CONTINUE
      GOTO700
C
  700 CONTINUE
      IF(IL.LT.100)GOTO710
      WRITE(ICOUT,701)
  701 FORMAT('***** INTERNAL ERROR IN DPFUIP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,702)
  702 FORMAT('INFINITE LOOP--IL = 100')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,703)NCF,L,IBUF,ILAST,IL
  703 FORMAT('NCF,L,IBUF,ILAST,IL = ',I8,I8,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  710 CONTINUE
      IF(IBUF.EQ.'YES')GOTO800
      GOTO850
C
  800 CONTINUE
      DO810I=1,IEND
      L=L+1
      IB(L)=ICH(I)
  810 CONTINUE
      IBUF='NO'
C
      IF(ILAST.EQ.'YES')GOTO300
      IF(ILAST.EQ.'NO')GOTO100
C
  850 CONTINUE
      IF(ILAST.EQ.'YES')GOTO9000
      IF(ILAST.EQ.'NO')GOTO100
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPRIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICF,L,IBUF,ILAST,IL,NUMCTL
 9012 FORMAT('ICF,L,IBUF,ILAST,IL,NUMCTL = ',2I8,2X,A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)(IB(I),I=1,MIN(NUMCTL,120))
 9013 FORMAT('IB(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
