      SUBROUTINE DPI(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICONT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 4 I PLOTS--
C              1) MEDIAN;
C              2) MEAN;
C              3) MIDRANGE;
C              4) MIDMEAN;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
C
      DIMENSION XIDTEM(MAXOBV)
      DIMENSION TEMP(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPI '
      ISUBN2='    '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLH=0
C
C               *******************************
C               **  TREAT THE I   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 DPI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICONT,IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('ICONT,IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               **********************************
C               **  STEP 1.1--                  **
C               **  SEARCH FOR MEDIAN I   PLOT  **
C               **********************************
C
      ICASPL='MDIP'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MEDI'.AND.IHARG(1).EQ.'I'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'I'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
C
C               ********************************
C               **  STEP 1.2--                **
C               **  SEARCH FOR MEAN I   PLOT  **
C               ********************************
C
      ICASPL='MEIP'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MEAN'.AND.IHARG(1).EQ.'I'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'XBAR'.AND.IHARG(1).EQ.'I'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AVER'.AND.IHARG(1).EQ.'I'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
C
C               **********************************
C               **  STEP 1.3--                  **
C               **  SEARCH FOR MIDRANGE I PLOT  **
C               **********************************
C
      ICASPL='MRIP'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MIDR'.AND.IHARG(1).EQ.'I'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
C
C               **********************************
C               **  STEP 1.4--                  **
C               **  SEARCH FOR MIDMEAN I  PLOT  **
C               **********************************
C
      ICASPL='MMIP'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MIDM'.AND.IHARG(1).EQ.'I'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
C
      ICASPL='    '
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               ***********************************************************
C               **  STEP 1--                                             **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,ICOLL,NLEFT
  211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.                **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MDIP')WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A (MEDIAN) I   PLOT ')
      IF(ICASPL.EQ.'MDIP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MEIP')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A MEAN I   PLOT ')
      IF(ICASPL.EQ.'MEIP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MRIP')WRITE(ICOUT,323)
  323 FORMAT('      (FOR WHICH A MIDRANGE I   PLOT ')
      IF(ICASPL.EQ.'MRIP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MMIP')WRITE(ICOUT,324)
  324 FORMAT('      (FOR WHICH A MIDMEAN I   PLOT ')
      IF(ICASPL.EQ.'MMIP')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)MINN2
  326 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,329)(IANS(I),I=1,IWIDTH)
  329 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPI')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ************************************************************
C               **  STEP 5--                                              **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS                **
C               **  INDICATES THAT THE VALUES IN THE                      **
C               **  FIRST VARIABLE ARE TO BE GROUPED                      **
C               **  BASED ON VALUES OF THE SECOND VARIABLE;               **
C               **  THAT IS, THE SECOND VARAIBLE DEFINES THE              **
C               **  GROUP NUMBERS WITHIN WHICH THE MEANS,                 **
C               **  STANDARD DEVIATIONS, RANGES, AND                      **
C               **  CUMULATIVE SUMS ARE TO BE COMPUTED.                   **
C               **  THE VALUES IN THE SECOND VARIABLE                     **
C               **  ARE THE X VALUES FOR EACH MEAN, STANDARD DEVIATION,   **
C               **  ETC.  IN THE RESULTING I   PLOT     .                 **
C               **  THE VALUES IN THE SECOND VARIABLE                     **
C               **  NEED NOT HAVE BEEN PREVIOUSLY                         **
C               **  SORTED OR HAVE COMMON VALUES ADJACENT.                **
C               **  IF WE HAVE THE 2-VARIABLE CASE,                       **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.        **
C               ************************************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.1)GOTO590
      IF(NUMV2.EQ.2)GOTO530
      GOTO510
C
  510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPI--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MDIP')WRITE(ICOUT,512)
  512 FORMAT('      FOR A (MEDIAN) I   PLOT, ')
      IF(ICASPL.EQ.'MDIP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MEIP')WRITE(ICOUT,513)
  513 FORMAT('      FOR A MEAN I   PLOT, ')
      IF(ICASPL.EQ.'MEIP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MRIP')WRITE(ICOUT,514)
  514 FORMAT('      (FOR WHICH A MIDRANGE I   PLOT ')
      IF(ICASPL.EQ.'MRIP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MMIP')WRITE(ICOUT,515)
  515 FORMAT('      (FOR WHICH A MIDMEAN I   PLOT ')
      IF(ICASPL.EQ.'MMIP')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,518)
  518 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,519)
  519 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,520)
  520 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,521)
  521 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,522)NUMV2
  522 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,523)
  523 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,524)(IANS(I),I=1,IWIDTH)
  524 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  530 CONTINUE
      IHHOR=IHARG(2)
      IHHOR2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH=IVALUE(ILOCV)
      NHOR=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,531)IHHOR,ICOLH,NHOR
  531 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NHOR.NE.NLEFT)GOTO570
      GOTO590
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPI--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MDIP')WRITE(ICOUT,572)
  572 FORMAT('      FOR A (MEDIAN) I   PLOT CHART, ')
      IF(ICASPL.EQ.'MDIP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MEIP')WRITE(ICOUT,573)
  573 FORMAT('      FOR A MEAN I   PLOT,')
      IF(ICASPL.EQ.'MEIP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MRIP')WRITE(ICOUT,574)
  574 FORMAT('      (FOR WHICH A MIDRANGE I   PLOT ')
      IF(ICASPL.EQ.'MRIP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MMIP')WRITE(ICOUT,575)
  575 FORMAT('      (FOR WHICH A MIDMEAN I   PLOT ')
      IF(ICASPL.EQ.'MMIP')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)
  578 FORMAT('      WHEN HAVE 2 VARAIBLES SPECIFIED, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,580)
  580 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      THE FIRST  VARIABLE  (RESPONSE VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,NLEFT
  584 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)
  585 FORMAT('      THE SECOND VARIABLE  (HORIZ. AXIS VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHHOR,NHOR
  586 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *************************************************
C               **  STEP 6--                                   **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
      IF(NUMV2.LE.1)GOTO660
C
      IJ=MAXN*(ICOLH-1)+I
      IF(ICOLH.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLH.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLH.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLH.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLH.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLH.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLH.EQ.MAXCP6)X1(J)=TAGPLO(I)
C
  660 CONTINUE
      NLOCAL=J
C
C               ****************************************************************
C               **  STEP 7--                                                  **
C               **  FOR THE 1-VARIABLE CASE ONLY,                             *
C               **  DETERMINE IF THE ANALYST                                  **
C               **  HAS SPECIFIED    THE GROUP SIZE,                          **
C               **  FOR THE I   PLOT      ANALYSIS.                           **
C               **  THE GROUP SIZE SETTING IS DEFINED BY SEARCHING THE        **
C               **  INTERNAL TABLE FOR THE PARAMETER NAME      NI   ;         **
C               **  IF FOUND, USE THE SPECIFIED VALUE.                        **
C               **  IF NOT FOUND, GENERATE AN ERROR MESSAGE.                  **
C               ****************************************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.GE.2)GOTO790
C
      IH='NI  '
      IH2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IERROR=IERRO2
      IF(IERRO2.EQ.'YES')GOTO9000
      ISIZE=VALUE(ILOCP)+0.5
  790 CONTINUE
C
C
C               *************************************************************
C               **  STEP 8--                                               **
C               **  COMPUTE THE APPROPRIATE I   PLOT      STATISTIC--      **
C               **  (MEDIAN OR MEDAN ).                                    **
C               **  COMPUTE CONFIDENCE LINES.                              **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                  **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.                     **
C               **  DEFINE THE VECTOR D(.) TO 1'S, 2'S, AND 3'S            **
C               **  FOR THE PLOTTED VALUE, THE LOWER CONFIDENCE LINE,      **
C               **  AND THE UPPER CONFIDENCE LINE.                         **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  809 CONTINUE
      CALL DPI2(Y1,X1,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,
     1XIDTEM,TEMP,
     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 DPI--')
      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)ISIZE
 9014 FORMAT('ISIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPI2(Y,X,N,NUMV2,ICASPL,ISIZE,ICONT,
     1XIDTEM,TEMP,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN I PLOT
C              OF THE FOLLOWING TYPES--
C                 1) (MEDIAN) I  PLOT;
C                 2) MEAN I  PLOT;
C                 3) MIDRANGE I  PLOT;
C                 4) MIDMEAN I  PLOT;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION XIDTEM(*)
      DIMENSION TEMP(*)
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='DPI2'
      ISUBN2='    '
C
      I2=0
      AN=0.0
C
      N50=1
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPI2--')
      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 DPI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)
   47 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,48)
   48 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   49 CONTINUE
C
      HOLD=Y(1)
      DO60I=1,N
      IF(Y(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DPI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,NUMV2,ISIZE,ICONT
   71 FORMAT('N,ICASPL,NUMV2,ISIZE,ICONT = ',I8,2X,A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO72I=1,N
      WRITE(ICOUT,73)I,Y(I),X(I)
   73 FORMAT('I, Y(I), X(I) = ',I8,2F15.7)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES           **
C               **  FOR VARIABLE 2 (THE GROUP VARIABLE).              **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS             **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE           **
C               **  WHICH IS AN ERROR CONDITION FOR AN I PLOT .       **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.EQ.1)GOTO110
      IF(NUMV2.EQ.2)GOTO150
C
  110 CONTINUE
      NUMSET=0
      DO120I=ISIZE,N,ISIZE
      I2=I
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=NUMSET
  120 CONTINUE
      IF(I2.LT.N)GOTO130
      GOTO140
  130 CONTINUE
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=NUMSET
  140 CONTINUE
      DO145I=1,N
      IGROUP=1+((I-1)/ISIZE)
      IMID=(IGROUP-1)*ISIZE+(ISIZE/2)
      X(I)=IMID
  145 CONTINUE
      GOTO190
C
  150 CONTINUE
      NUMSET=0
      DO160I=1,N
      IF(NUMSET.EQ.0)GOTO165
      DO170J=1,NUMSET
      IF(X(I).EQ.XIDTEM(J))GOTO160
  170 CONTINUE
  165 CONTINUE
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=X(I)
  160 CONTINUE
      CALL SORT(XIDTEM,NUMSET,XIDTEM)
C
      XID1=XIDTEM(1)
      XID2=XIDTEM(NUMSET)
C
  190 CONTINUE
C
      IF(NUMSET.EQ.0)WRITE(ICOUT,191)
  191 FORMAT('ERROR IN DPI2   SUBROUTINE--NUMSET = 0')
      IF(NUMSET.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.0)GOTO9000
      IF(NUMSET.EQ.0)IERROR='YES'
C
      IF(NUMSET.EQ.N)WRITE(ICOUT,192)
  192 FORMAT('ERROR IN DPI2   SUBROUTINE--NUMSET = N')
      IF(NUMSET.EQ.N)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.N)IERROR='YES'
      IF(NUMSET.EQ.N)GOTO9000
C
C               **************************************************************
C               **  STEP 4--                                                **
C               **  IN ORDER TO DETERMINE THE PROPER PLOT COOORDINATES      **
C               **  FOR THE DESIRED PLOT,                                   **
C               **  FIRST BRANCH TO THE PROPER SUBCASE--                    **
C               **         1) (MEDIAN) I  PLOT;                            **
C               **         2) MEAN I  PLOT;                                **
C               **************************************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'MDIP')GOTO1100
      IF(ICASPL.EQ.'MEIP')GOTO1100
      IF(ICASPL.EQ.'MRIP')GOTO1100
      IF(ICASPL.EQ.'MMIP')GOTO1100
C
  260 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPI2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,262)
  262 FORMAT('      AT BRANCH POINT 261--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,263)
  263 FORMAT('      ICASPL NOT EQUAL ONE OF THE ALLOWABLE 4--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,264)
  264 FORMAT('      MDIP, MEIP, MRIP, OR MMIP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ***************************************************
C               **  STEP 4A--                                    **
C               **  DETERMINE PLOT COORDINATES FOR 4 SUBCASES--  **
C               **      1) (MEDIAN) I  PLOT;                     **
C               **      2) MEAN I  PLOT;                         **
C               **      3) MIDRANGE I  PLOT;                     **
C               **      4) MIDMEAN I  PLOT;                      **
C               ***************************************************
C
 1100 CONTINUE
C
      ISTEPN='4A'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      AN=N
      ANUMSE=NUMSET
C
      P1=0.25
      P2=0.75
C
      NUMCPL=11
      J=0
      JD=0
      DO1110ISET=1,NUMSET
C
      K=0
      DO1120I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 1120 CONTINUE
      NI=K
      ANI=NI
C
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,1121)ISET,XIDTEM(ISET),NI
 1121 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NI.LE.0)GOTO1140
      CALL SORT(TEMP,NI,TEMP)
C
      XMID=XIDTEM(ISET)
C
C               ***************************
C               **  STEP 4.1--           **
C               **  COMPUTE THE MAXIMUM  **
C               ***************************
C
      YMAX=TEMP(NI)
C
C               *********************************
C               **  STEP 4.2--                 **
C               **  COMPUTE THE TYPICAL VALUE  **
C               **  (MEDIAN, MEAN,             **
C               **  MIDRANGE, OR TRIMMED MEAN) **
C               *********************************
C
      IF(ICASPL.EQ.'MDIP')GOTO1131
      IF(ICASPL.EQ.'MEIP')GOTO1133
      IF(ICASPL.EQ.'MRIP')GOTO1135
      IF(ICASPL.EQ.'MMIP')GOTO1137
C
 1131 CONTINUE
      N50=NI/2
      N50P1=N50+1
      IEVODD=NI-2*(NI/2)
      IF(IEVODD.EQ.0)Y50=(TEMP(N50)+TEMP(N50P1))/2.0
      IF(IEVODD.EQ.1)Y50=TEMP(N50P1)
      GOTO1139
C
 1133 CONTINUE
      SUM=0.0
      DO1134I=1,NI
      SUM=SUM+TEMP(I)
 1134 CONTINUE
      Y50=SUM/ANI
      GOTO1139
C
 1135 CONTINUE
      Y50=(TEMP(1)+TEMP(NI))/2.0
      GOTO1139
C
 1137 CONTINUE
      NP1=P1*ANI+0.0001
      NP2=P2*ANI+0.0001
      IMIN=NP1+1
      IMAX=N-NP2
      IF(IMIN.LT.1)IMIN=1
      IF(IMAX.GT.NI)IMAX=NI
      IF(IMIN.GT.IMAX)IMIN=IMAX
      Y50=TEMP(1)
      SUM=0.0
      L=0
      DO1138I=IMIN,IMAX
      L=L+1
      SUM=SUM+TEMP(I)
 1138 CONTINUE
      AL=L
      Y50=SUM/AL
      GOTO1139
C
 1139 CONTINUE
      NP1=P1*ANI+0.0001
      NP2=P2*ANI+0.0001
C
C               ***************************
C               **  STEP 4.3--           **
C               **  COMPUTE THE MINIMUM  **
C               ***************************
C
      YMIN=TEMP(1)
C
      GOTO1149
C
 1140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** INTERNAL ERROR IN DPI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)ISET,XIDTEM(ISET),NI
 1143 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1149 CONTINUE
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,1151)YMIN,Y50,YMAX,ISET,K,TEMP(K)
 1151 FORMAT('YMIN,Y50,YMAX,ISET,K,TEMP(K) = ',3E15.7,2I8,E15.7)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
 1160 CONTINUE
C
C               ********************************************
C               **  STEP 4.11--                           **
C               **  DEFINE THE CHARACTER AT THE MAXIMUM;  **
C               ********************************************
C
      CALL DPCHLI(ICONT,NUMCPL,YMAX,YMAX,XMID,XMID,J,JD,Y2,X2,D2,IERROR)
C
C               ***************************************
C               **  STEP 4.12--                      **
C               **  DEFINE THE CHARACTER             **
C               **  FOR THE TYPICAL VALUE            **
C               **  (SUCH AS THE MEDIAN OR MEAN)     **
C               ***************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y50,Y50,XMID,XMID,J,JD,Y2,X2,D2,IERROR)
C
C               ********************************************
C               **  STEP 4.13--                           **
C               **  DEFINE THE CHARACTER AT THE MINIMUM.  **
C               ********************************************
C
      CALL DPCHLI(ICONT,NUMCPL,YMIN,YMIN,XMID,XMID,J,JD,Y2,X2,D2,IERROR)
C
C               *************************************
C               **  STEP 4.14--                    **
C               **  DEFINE THE VERTICAL LINE FROM  **
C               **  THE MAX TO THE TYPICAL VALUE   **
C               *************************************
C
      CALL DPCHLI(ICONT,NUMCPL,YMAX,Y50,XMID,XMID,J,JD,Y2,X2,D2,IERROR)
C
C               **********************************
C               **  STEP 4.15--                 **
C               **  DEFINE THE VERTICAL LINE    **
C               **  FROM THE TYPICAL VALUE      **
C               **  TO THE MIN                  **
C               **********************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y50,YMIN,XMID,XMID,J,JD,Y2,X2,D2,IERROR)
C
 1110 CONTINUE
C
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,N,NUMSET,N2,IERROR
 9012 FORMAT('ICASPL,N,NUMSET,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMV2
 9013 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)AN,NI,N50
 9014 FORMAT('AN,NI,N50 = ',E15.7,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
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPIF(ILOCS,ICASIF,IBUGQ,IERROR)
C
C     PURPOSE--DEFINE A TRUE-FALSE CHARACTER VARIABLE
C              WHICH WILL BE USED IN OTHER SUBROUTINES
C              FOR THE CONDITIONAL EXECTUION OF STATEMENTS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83/1
C     ORIGINAL VERSION--JANUARY   1983.
C     UPDATED         --AUGUST    1987. (TO ALLOW <> TO WORK)
C     UPDATED         --AUGUST    1992. TO ALLOW    ... NOT EXIST
C     UPDATED         --AUGUST    1997. TO ALLOW    ... EXIST
C     UPDATED         --FEBRUARY  1999. IF ERROR, SET IF TO FALSE
C     UPDATED         --JULY      2002. REDO IF NOT EXIST AND IF EXIST
C     UPDATED         --JULY      2002. ADD: IF STRING = "..."
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGQ
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASIF
C
      CHARACTER*4 ISTATI
      CHARACTER*4 ICASSC
      CHARACTER*4 ICASQU
      CHARACTER*4 ICASPA
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASOP
      CHARACTER*4 IHSET
      CHARACTER*4 IHSET2
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*8 ITYPE
      CHARACTER*80 ITEXT1
      CHARACTER*80 ITEXT2
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='DPIF'
      ISUBN2='    '
C
      IERROR='NO'
C
      ICASIF='TRUE'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
C
C               ********************************
C               **  TREAT THE IF     CASE     **
C               ********************************
C
      IF(IBUGQ.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ILOCS,ICASIF
   52 FORMAT('ILOCS,ICASIF = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGQ,IERROR
   54 FORMAT('IBUGQ,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMARG,NUMNAM,MAXNAM,N,MAXN
   55 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IWIDTH,ILOCS,ILOCS2,ILOCTG
   56 FORMAT('IWIDTH,ILOCS,ILOCS2,ILOCTG = ',4I8)
      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(IBUGQ.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
CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1992
C               **************************************************
C               **  STEP 2.0--                                  **
C               **  TREAT THE     IF ... NOT EXIST CASE         **
C               **      IF ... NOT EXIST THEN ==> ICASIF = TRUE **
C               **      IF ... EXIST THEN ==> ICASIF = FALSE    **
C               **************************************************
C
      IF(NUMARG.GE.3)THEN
         IF(IHARG(2).EQ.'NOT'.AND.IHARG(3).EQ.'EXIS')THEN
C
            IH=IHARG(1)
            IH2=IHARG2(1)
            MESSAG='NO'
            CALL CHECKF(IH,IH2,IHWUSE,
     1      IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1      ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,ITYPE)
C
            IF(ITYPE.EQ.'NONE')THEN
              ICASIF='TRUE'
            ELSE
              ICASIF='FALS'
            ENDIF
            IERROR='NO'
            GOTO9000
C
         ENDIF
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1997
C               **************************************************
C               **  STEP 2.0A--                                 **
C               **  TREAT THE     IF ...     EXIST CASE         **
C               **      IF ...     EXIST THEN ==> ICASIF = TRUE **
C               **      IF ... NOT EXIST THEN ==> ICASIF = FALSE**
C               **************************************************
C
      ICASIF='TRUE'
      IF(NUMARG.GE.2)THEN
         IF(IHARG(2).EQ.'EXIS')THEN
C
            IH=IHARG(1)
            IH2=IHARG2(1)
            MESSAG='NO'
            CALL CHECKF(IH,IH2,IHWUSE,
     1      IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1      ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,ITYPE)
C
            IF(ITYPE.EQ.'NONE')THEN
              ICASIF='FALS'
            ELSE
              ICASIF='TRUE'
            ENDIF
            IERROR='NO'
            GOTO9000
C
         ENDIF
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED JULY 2002.
C               **************************************************
C               **  STEP 2.0B-                                  **
C               **  TREAT THE                                   **
C               **      IF STRING = "....."     CASE            **
C               **      IF STRING <> "..."      CASE            **
C               **************************************************
C
      IF(ICOM.EQ.'IF')THEN
        IF(NUMARG.GE.3.AND.(IHARG(2).EQ.'='.OR.IHARG(2).EQ.'<>'))THEN
C
          IH=IHARG(1)
          IH2=IHARG2(1)
          MESSAG='NO'
          CALL CHECKF(IH,IH2,IHWUSE,
     1    IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1    ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,ITYPE)
C
          IF(ITYPE.NE.'STRING')GOTO199
          IF(IHARG(2).EQ.'=')IFLAG=0
          IF(IHARG(2).EQ.'<>')IFLAG=1
          IERROR='NO'
C
CCCCC SEARCH FOR STRING AFTER THE "=" OR "<>".
C
          IF(IFLAG.EQ.0)THEN
            DO110I=1,80
              IF(IANSLC(I).EQ.'=')THEN
                ISTRT=I+1
                GOTO119
              ENDIF
  110       CONTINUE
            IERROR='YES'
            GOTO9000
  119       CONTINUE
          ELSE
            DO120I=1,79
              IF(IANSLC(I).EQ.'<' .AND. IANSLC(I).EQ.'>')THEN
                ISTRT=I+2
                GOTO129
              ENDIF
  120       CONTINUE
            IERROR='YES'
            GOTO9000
  129       CONTINUE
          ENDIF
C
          NTEXT2=0
          ITEXT2=' '
          DO130I=ISTRT,IWIDTH
            IF(IANSLC(I).EQ.' ')THEN
              GOTO130
            ELSEIF(IANSLC(I).EQ.'"')THEN
              NSTRT=I+1
              ICOUNT=0
              DO132J=NSTRT,IWIDTH
                IF(IANSLC(J).EQ.'"')THEN
                  NLAST=J-1
                  GOTO134
                ELSE
                  ICOUNT=ICOUNT+1
                  ITEXT2(ICOUNT:ICOUNT)=IANSLC(J)(1:1)
                ENDIF
  132         CONTINUE
              NLAST=IWIDTH
  134         CONTINUE
              NTEXT2=NLAST-NSTRT+1
              GOTO139
            ELSE
              NSTRT=I
              ICOUNT=0
              DO137J=NSTRT,IWIDTH
                IF(IANSLC(J).EQ.' ')THEN
                  NLAST=J-1
                  GOTO138
                ELSE
                  ICOUNT=ICOUNT+1
                  ITEXT2(ICOUNT:ICOUNT)=IANSLC(J)(1:1)
                ENDIF
  137         CONTINUE
              NLAST=IWIDTH
  138         CONTINUE
              NTEXT2=NLAST-NSTRT+1
              GOTO139
            ENDIF
  130     CONTINUE
  139     CONTINUE
C
CCCCC EXTRACT VALUE OF STRING IN ARGUMENT 1
C
          NTEXT1=0
          ITEXT1=' '
          NSTRT=IVSTAR(ILOC)
          NSTOP=IVSTOP(ILOC)
          DO140J=NSTRT,NSTOP
            NTEXT1=NTEXT1+1
            ITEXT1(NTEXT1:NTEXT1)=IFUNC(J)(1:1)
  140     CONTINUE
C
CCCCC NOW COMPARE THE TWO STRINGS (IMTCH=0 FOR MATCH, 1 FOR NO MATCH)
C
          IMTCH=0
          IF(NTEXT1.EQ.NTEXT2)THEN
            DO150J=1,NTEXT1
              IF(ITEXT1(J:J).NE.ITEXT2(J:J))THEN
                IMTCH=1
                GOTO159
              ENDIF
  150       CONTINUE
  159       CONTINUE
          ELSE
            IMTCH=1
          ENDIF
C
CCCCC SET IF STATUS
C
          IF(IMTCH.EQ.0)THEN
            ICASIF='TRUE'
          ELSE
            ICASIF='FALS'
          ENDIF
C
          GOTO9000
C
         ENDIF
      ENDIF
C
  199 CONTINUE
C
C               ****************************************************************
C               ****************************************************************
C               **  STEP 2.1--
C               **  INITIALIZE ALL ELEMENTS IN ISUB(.) TO 11
C               **  ISUB(.) WILL TAKE ON 4 VALUES AT MOST--
C               **  00, 01, 10, 11   .
C               **  THE FIRST  DIGIT INDICATES WHETHER OR NOT THE GIVEN ELEMENT
C               **  IS OUT (0) OR IN (1) OF THE LOCAL  CUMULATIVE UNION SET.
C               **  THE SECOND DIGIT INDICATES WHETHER OR NOT THE GIVEN ELEMENT
C               **  IS OUT (0) OR IN (1) OF THE GLOBAL CUMULATIVE INTERSECTION S
C               **  THE INITIALIZATION OF ALL ELEMENTS TO 11
C               **  THUS INDICATES THAT INITIALLY ALL ELEMENTS (TEMPORARILY)
C               **  ARE IN THE LOCAL UNION SET,
C               **  AND INITIALLY ALL ELEMENTS
C               **  ARE IN THE GLOBAL INTERSECTION SET.
C               ****************************************************************
C
      ISTEPN='2.1'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NIOLD=1
      DO200I=1,NIOLD
      ISUB(I)=11
  200 CONTINUE
C
C               *************************************************
C               **  STEP 2.2--                                 **
C               **  IF EXISTENT,                               **
C               **  PACK < = INTO <=                           **
C               **  PACK = < INTO =<                           **
C               **  PACK > = INTO >=                           **
C               **  PACK = > INTO =>                           **
C               **  THIS IS BECAUSE = SIGNS ARE AUTOMATICALLY  **
C               **  GIVEN A SPACE IN DPTYPE AND TREATED AS     **
C               **  AS A SEPARATE WORD.                        **
C               **  NOTE THAT NUMARG WILL BE CHANGED.          **
C               *************************************************
C
      ISTEPN='2.2'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL ADJUS2(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
C
C               ************************************************
C               **  STEP 3.1--                                **
C               **  CHECK TO SEE IF HAVE THE  IF      CASE.   **
C               **  LOCATE THE POSITION IN THE ARGUMENT LIST  **
C               **  OF THE WORD    IF   .                     **
C               ************************************************
C
      ISTEPN='3.1'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMAX=0
      ICASSC='SEAR'
      ICASQU='UNKN'
      NUMSV=0
      DO300IPASS=1,100
C
      IF(IBUGQ.EQ.'OFF')GOTO309
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,301)
  301 FORMAT('***** AT THE BEGINNING OF ANOTHER PASS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,302)IPASS
  302 FORMAT('IPASS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,303)ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG)
  303 FORMAT('ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG) = ',
     1A4,I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,304)JMAX
  304 FORMAT('JMAX= ',I8)
      CALL DPWRST('XXX','BUG ')
  309 CONTINUE
C
      IF(ICASSC.EQ.'STOP')GOTO1100
      JMIN=JMAX+1
      IF(JMIN.GT.NUMARG)GOTO1100
      IF(JMIN.EQ.NUMARG.AND.IHARG(JMIN).EQ.'AND '.AND.
     1IHARG2(JMIN).EQ.'    ')GOTO1100
C
      IF(ICASSC.EQ.'CONT')GOTO600
      DO310I=1,NIOLD
      ITEMP=ISUB(I)
      IF(ITEMP.EQ.00)ISUB(I)=00
      IF(ITEMP.EQ.10)ISUB(I)=00
      IF(ITEMP.EQ.01)ISUB(I)=00
      IF(ITEMP.EQ.11)ISUB(I)=11
  310 CONTINUE
C
      ICASQU='UNKN'
      DO340J=JMIN,NUMARG
      J2=J
      IF(IHARG(J).EQ.'IF  '.AND.IHARG2(J).EQ.'    ')GOTO350
  340 CONTINUE
      IF(JMIN.EQ.1.AND.
     1ICOM.EQ.'IF  '.AND.ICOM2.EQ.'    ')J2=0
      IF(JMIN.EQ.1.AND.
     1ICOM.EQ.'IF  '.AND.ICOM2.EQ.'    ')GOTO350
      ILOCS=NUMARG+1
      GOTO1100
C
  350 CONTINUE
      ICASQU='IF  '
      ILOCS=J2
      GOTO390
C
  390 CONTINUE
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,391)IPASS,ICASQU,ILOCS
  391 FORMAT('IPASS,ICASQU,ILOCS = ',I8,2X,A4,I8)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               *******************************************
C               **  STEP 3.2--                           **
C               **  IF HAVE THE IF     CASE,             **
C               **  INITIALIZE ISUB(.) TO 0X--00 OR 01.  **
C               *******************************************
C
      ISTEPN='3.2'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQU.EQ.'IF  ')GOTO400
      IERROR='YES'
      GOTO9000
C
  400 CONTINUE
      DO401I=1,NIOLD
      ITEMP=ISUB(I)
      IF(ITEMP.EQ.00)ISUB(I)=00
      IF(ITEMP.EQ.10)ISUB(I)=00
      IF(ITEMP.EQ.01)ISUB(I)=01
      IF(ITEMP.EQ.11)ISUB(I)=01
  401 CONTINUE
      GOTO409
C
  409 CONTINUE
C
C               ********************************************************
C               **  STEP 4--                                          **
C               **  CHECK VALIDITY OF FIRST ARGUMENT AFTER     IF **
C               **  THIS SHOULD BE THE IF PARAMETER                **
C               ********************************************************
C
      ISTEPN='4'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPA='UNKN'
      ILOCS1=ILOCS+1
      JMAX=ILOCS1
      IF(ILOCS1.LE.NUMARG)GOTO429
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,411)
  411 FORMAT('***** ERROR IN DPIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,412)
  412 FORMAT('      THE WORD    IF    WAS THE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,413)
  413 FORMAT('      FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,414)
  414 FORMAT('      THE WORD    IF    SHOULD HAVE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,415)
  415 FORMAT('      BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,416)
  416 FORMAT('           IF A = 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,417)
  417 FORMAT('           IF A > 6')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,418)
  418 FORMAT('           IF X >= B')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,419)
  419 FORMAT('           AND SO FORTH.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,421)
  421 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,422)(IANS(I),I=1,IWIDTH)
  422 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  429 CONTINUE
C
      IHSET=IHARG(ILOCS1)
      IHSET2=IHARG2(ILOCS1)
C
  440 CONTINUE
      ICASPA='P   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ASETV=VALUE(ILOC)
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,451)ILOCS1,IHSET,IHSET2,ASETV
  451 FORMAT('ILOCS1,IHSET,IHSET2,ASETV = ',I8,3X,2A4,3X,E15.7)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
      GOTO490
C
  490 CONTINUE
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,491)IPASS,IHSET,IHSET2,ICASPA,ASETV
  491 FORMAT('IPASS,IHSET,IHSET2,ICASPA,ASETV = ',
     1I8,2X,A4,2X,A4,2X,A4,E15.7)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ****************************************************************
C               **  STEP 5--
C               **  CHECK TO SEE IF NEXT ARGUMENT IS
C               **        <
C               **        <=
C               **        =
C               **        >=
C               **        >
C               **        <>
C               **  IF NONE OF THE ABOVE, THEN THE ASSUMED OPERATION IS   =   .
C               ****************************************************************
C
      ISTEPN='5'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASOP='UNKN'
      ILOCS2=ILOCS+2
      JMAX=ILOCS2
      IF(ILOCS2.LE.NUMARG)GOTO529
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,501)
  501 FORMAT('***** ERROR IN DPIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,502)
  502 FORMAT('      THE    IF    PARAMETER NAME WAS THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,503)
  503 FORMAT('      FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,504)
  504 FORMAT('      THE    IF    PARAMETER NAME SHOULD HAVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,505)
  505 FORMAT('      BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,506)
  506 FORMAT('           IF A = 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,507)
  507 FORMAT('           IF A > 6')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,508)
  508 FORMAT('           IF A >= B')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,510)
  510 FORMAT('           AND SO FORTH.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,521)
  521 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,522)(IANS(I),I=1,IWIDTH)
  522 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  529 CONTINUE
C
      IHSET=IHARG(ILOCS2)
      IHSET2=IHARG2(ILOCS2)
C
      IF(IHSET.EQ.'<   ')GOTO531
      IF(IHSET.EQ.'<=  ')GOTO532
      IF(IHSET.EQ.'=<  ')GOTO532
      IF(IHSET.EQ.'=   ')GOTO533
      IF(IHSET.EQ.'>=  ')GOTO534
      IF(IHSET.EQ.'=>  ')GOTO534
      IF(IHSET.EQ.'>   ')GOTO535
      IF(IHSET.EQ.'<>  ')GOTO536
      IF(IHSET.EQ.'><  ')GOTO536
      GOTO537
C
  531 CONTINUE
      ICASOP='<   '
      ILOCTG=ILOCS2
      GOTO590
C
  532 CONTINUE
      ICASOP='<=  '
      ILOCTG=ILOCS2
      GOTO590
C
  533 CONTINUE
      ICASOP='=   '
      ILOCTG=ILOCS2
      GOTO590
C
  534 CONTINUE
      ICASOP='>=  '
      ILOCTG=ILOCS2
      GOTO590
C
  535 CONTINUE
      ICASOP='>   '
      ILOCTG=ILOCS2
      GOTO590
C
  536 CONTINUE
      ICASOP='<>  '
      ILOCTG=ILOCS2
      GOTO590
C
  537 CONTINUE
      ICASOP='=ASS'
      ILOCTG=ILOCS2-1
      GOTO590
C
  590 CONTINUE
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,591)IPASS,IHSET,IHSET2,ICASPA,ICASOP
  591 FORMAT('IPASS,IHSET,IHSET2,ICASPA,ICASOP = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               **************************************************************
C               **  STEP 6--                                                **
C               **  DETERMINE THE LOWER LIMIT OF THE INTERVAL OF INTEREST.  **
C               **  THIS IS DONE BY CHECKING THE FIRST (NEXT) ARGUMENT      **
C               **  IN THE LIST.                                            **
C               **  ALSO, FOR THOSE 4 CASES IN WHICH                        **
C               **  ICASOP IS   <   <=   >=   >                             **
C               **  DETERMINE THE UPPER LIMIT OF THE INTERVAL OF INTEREST.  **
C               **************************************************************
C
  600 CONTINUE
C
      ISTEPN='6'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGQ.EQ.'OFF')GOTO609
      WRITE(ICOUT,601)
  601 FORMAT('     AT THE BEGINNING OF STEP 6 IN DPIF--')
      CALL DPWRST('XXX','BUG ')
      DO605I=1,NIOLD
      WRITE(ICOUT,606)I,ISUB(I)
  606 FORMAT('I,ISUB(I) = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
  605 CONTINUE
  609 CONTINUE
C
      ILOCTG=ILOCTG+1
      JMAX=ILOCTG
      IF(ILOCTG.LE.NUMARG)GOTO629
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,611)
  611 FORMAT('***** ERROR IN DPIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,612)
  612 FORMAT('      THE    IF    OPERATION   <   <=  =  >=  >')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,613)
  613 FORMAT('      WAS THE FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,614)
  614 FORMAT('      THE    IF    VARIABLE NAME SHOULD HAVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,615)
  615 FORMAT('      BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,616)
  616 FORMAT('           IF A = 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,617)
  617 FORMAT('           IF A > 6')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,618)
  618 FORMAT('           IF A >= 6')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,620)
  620 FORMAT('           AND SO FORTH.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,621)
  621 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,622)(IANS(I),I=1,IWIDTH)
  622 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  629 CONTINUE
C
      IF(IARGT(ILOCTG).EQ.'NUMB')GOTO640
      IF(IARGT(ILOCTG).EQ.'WORD')GOTO650
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,631)
  631 FORMAT('***** INTERNAL ERROR IN DPIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,632)
  632 FORMAT('      AN ARGUMENT TYPE WHICH SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,633)
  633 FORMAT('      EITHER A NUMBER OR A WORD, IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,634)IHARG(ILOCTG),IHARG2(ILOCTG)
  634 FORMAT('      ARGUMENT                  = ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,635)ILOCTG
  635 FORMAT('      LOCATION IN ARGUMENT LIST = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,636)IARGT(ILOCTG)
  636 FORMAT('      ARGUMENT TYPE             = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,637)
  637 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,638)(IANS(I),I=1,IWIDTH)
  638 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  640 CONTINUE
      DMIN=ARG(ILOCTG)
      DMAX=ARG(ILOCTG)
      IF(ICASOP.EQ.'=   ')GOTO690
      IF(ICASOP.EQ.'=ASS')GOTO690
      IF(ICASOP.EQ.'<>  ')GOTO690
      IF(ICASOP.EQ.'<   ')DMIN=CPUMIN
      IF(ICASOP.EQ.'<   ')DMAX=ARG(ILOCTG)
      IF(ICASOP.EQ.'<   ')GOTO690
      IF(ICASOP.EQ.'<=  ')DMIN=CPUMIN
      IF(ICASOP.EQ.'<=  ')DMAX=ARG(ILOCTG)
      IF(ICASOP.EQ.'<=  ')GOTO690
      IF(ICASOP.EQ.'>=  ')DMIN=ARG(ILOCTG)
      IF(ICASOP.EQ.'>=  ')DMAX=CPUMAX
      IF(ICASOP.EQ.'>=  ')GOTO690
      IF(ICASOP.EQ.'>   ')DMIN=ARG(ILOCTG)
      IF(ICASOP.EQ.'>   ')DMAX=CPUMAX
      IF(ICASOP.EQ.'>   ')GOTO690
      GOTO690
C
  650 CONTINUE
      IH=IHARG(ILOCTG)
      IH2=IHARG2(ILOCTG)
      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
      DMIN=VALUE(ILOC)
      DMAX=VALUE(ILOC)
      IF(ICASOP.EQ.'=   ')GOTO690
      IF(ICASOP.EQ.'=ASS')GOTO690
      IF(ICASOP.EQ.'<>  ')GOTO690
      IF(ICASOP.EQ.'<   ')DMIN=CPUMIN
      IF(ICASOP.EQ.'<   ')DMAX=VALUE(ILOC)
      IF(ICASOP.EQ.'<   ')GOTO690
      IF(ICASOP.EQ.'<=  ')DMIN=CPUMIN
      IF(ICASOP.EQ.'<=  ')DMAX=VALUE(ILOC)
      IF(ICASOP.EQ.'<=  ')GOTO690
      IF(ICASOP.EQ.'>=  ')DMIN=VALUE(ILOC)
      IF(ICASOP.EQ.'>=  ')DMAX=CPUMAX
      IF(ICASOP.EQ.'>=  ')GOTO690
      IF(ICASOP.EQ.'>   ')DMIN=VALUE(ILOC)
      IF(ICASOP.EQ.'>   ')DMAX=CPUMAX
      IF(ICASOP.EQ.'>   ')GOTO690
      GOTO690
C
  690 CONTINUE
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,691)IPASS,ICASPA,ICASOP,IH,IH2,DMIN,
     1DMAX
  691 FORMAT('IPASS,ICASPA,ICASOP,IH,IH2,DMIN,DMAX = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4,2E15.7)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ****************************************************************
C               **  STEP 7--
C               **  DETERMINE THE UPPER LIMIT OF THE INTERVAL OF INTEREST.
C               **  NOTE THAT FOR THOSE 4 CASES IN WHICH
C               **  ICASOP IS   <   <=   >=   >                             **
C               **  THE UPPER LIMIT OF THE INTERVAL   **
C               **  HAS ALREADY BEEN DETERMINED AND SO **
C               **  ALL OF THE CODE OF THIS SECTION MAY BE SKIPPED.
C               **  ON THE OTHER HAND WHEN THE OPERATION IS    =   ,
C               **  (EXPLICITLY OR ASSUMED),                **
C               **  OR <>    ,
C               **  THE UPPER LIMIT MUST BE DETERMINED.
C               **  THIS IS DONE BY CHECKING THE NEXT ARGUMENT
C               **  IN THE LIST.
C               **  IF THIS NEXT ARGUMENT IS    TO   ,
C               **  THIS IMPLIES THAT AN UPPER LIMIT WILL BE PROVIDED
C               **  (IN THE ARGUMENT AFTER THE   TO   ).
C               **  HOWEVER, IF THE NEXT ARGUMENT IS NOT A    TO   ,
C               **  THEN THIS IMPLIES THAT THE LIST CONSISTS
C               **  OF INDIVIDUAL ELEMENTS OF THE SUBSET
C               **  AND SO THE UPPER LIMIT WILL BE IDENTICAL
C               **  TO THE LOWER LIMIT.
C               ****************************************************************
C
  700 CONTINUE
C
      ISTEPN='7'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASOP.EQ.'<   ')ICASSC='SEAR'
      IF(ICASOP.EQ.'<   ')GOTO790
      IF(ICASOP.EQ.'<=  ')ICASSC='SEAR'
      IF(ICASOP.EQ.'<=  ')GOTO790
      IF(ICASOP.EQ.'>=  ')ICASSC='SEAR'
      IF(ICASOP.EQ.'>=  ')GOTO790
      IF(ICASOP.EQ.'>   ')ICASSC='SEAR'
      IF(ICASOP.EQ.'>   ')GOTO790
C
      ILOCTG=ILOCTG+1
C
      IF(ILOCTG.GT.NUMARG)GOTO710
      IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND.
     1IHARG2(ILOCTG).EQ.'    ')GOTO710
      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'IF  '.AND.
     1IHARG2(ILOCTG).EQ.'    ')GOTO720
      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO  '.AND.
     1IHARG2(ILOCTG).EQ.'    ')GOTO750
      GOTO730
C
  710 CONTINUE
      ILOCTG=ILOCTG-1
      JMAX=ILOCTG
      ICASSC='STOP'
      DMAX=DMIN
      GOTO790
C
  720 CONTINUE
      ILOCTG=ILOCTG-1
      JMAX=ILOCTG
      ICASSC='SEAR'
      DMAX=DMIN
      GOTO790
C
  730 CONTINUE
      ILOCTG=ILOCTG-1
      JMAX=ILOCTG
      ICASSC='CONT'
      DMAX=DMIN
      GOTO790
C
  750 CONTINUE
      ILOCTG=ILOCTG+1
      JMAX=ILOCTG
      IF(ILOCTG.GT.NUMARG)GOTO760
      IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND.
     1IHARG2(ILOCTG).EQ.'    ')GOTO760
      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'IF  '.AND.
     1IHARG2(ILOCTG).EQ.'    ')GOTO760
      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO  '.AND.
     1IHARG2(ILOCTG).EQ.'    ')GOTO760
      GOTO770
C
  760 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,761)
  761 FORMAT('***** ERROR IN DPIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,762)
  762 FORMAT('      THE WORD    TO    SHOULD HAVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,763)
  763 FORMAT('      BEEN FOLLOWED BY A NUMBER OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,764)
  764 FORMAT('      BY A PARAMETER NAME, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,765)IHARG(ILOCTG),IHARG2(ILOCTG)
  765 FORMAT('      TO    WAS FOLLOWED BY THE WORD   ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,766)
  766 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,767)(IANS(I),I=1,IWIDTH)
  767 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  770 CONTINUE
      IF(IARGT(ILOCTG).EQ.'NUMB')GOTO775
      IF(IARGT(ILOCTG).EQ.'WORD')GOTO776
C
      IBRAN=770
      WRITE(ICOUT,771)IBRAN
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,772)ILOCTG,IARGT(ILOCTG)
  771 FORMAT('***** INTERNAL ERROR IN DPIF--',
     1'IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
  772 FORMAT('ILOCTG, IARGT(ILOCTG) = ',I8,2X,A4)
      IERROR='YES'
      GOTO9000
C
  775 CONTINUE
      DMAX=ARG(ILOCTG)
      GOTO780
C
  776 CONTINUE
      IH=IHARG(ILOCTG)
      IH2=IHARG2(ILOCTG)
      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
      DMAX=VALUE(ILOC)
      GOTO780
C
  780 CONTINUE
      ILOCTG=ILOCTG+1
      ICASSC='CONT'
      IF(ILOCTG.GT.NUMARG)ICASSC='STOP'
      IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND.
     1IHARG2(ILOCTG).EQ.'    ')ICASSC='STOP'
      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'IF  '.AND.
     1IHARG2(ILOCTG).EQ.'    ')ICASSC='SEAR'
      ILOCTG=ILOCTG-1
      JMAX=ILOCTG
C
  790 CONTINUE
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,791)IPASS,ICASPA,ICASOP,IH,IH2,DMIN,
     1DMAX
  791 FORMAT('IPASS,ICASPA,ICASOP,IH,IH2,DMIN,DMAX = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4,2E15.7)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************
C               **  STEP 8--                                     **
C               **  TO ALLOW FOR ROUNDOFF ERRORS IN THE          **
C               **  STORAGE OF NUMBERS,                          **
C               **  JUDICIOUSLY EXPAND THE INTERVAL OF INTEREST  **
C               **  BY AN    EPSILON    AMOUNT.                      **
C               ***************************************************
C
      ISTEPN='8'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGQ.EQ.'OFF')GOTO804
      WRITE(ICOUT,801)
  801 FORMAT('      AT THE BEGINNING OF STEP 8--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,802)DMIN,DMAX
  802 FORMAT('DMIN,DMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
  804 CONTINUE
C
      IF(DMIN.LE.DMAX)GOTO809
      HOLD=DMIN
      DMIN=DMAX
      DMAX=HOLD
  809 CONTINUE
C
      IF(DMIN.EQ.CPUMIN)GOTO819
      IF(DMIN.EQ.CPUMAX)GOTO819
      IF(ABS(DMIN).EQ.0.0)EPS=0.000001
      IF(ABS(DMIN).NE.0.0)EPS=ABS(DMIN*0.000001)
      IF(ICASOP.EQ.'=   ')DMIN=DMIN-EPS
      IF(ICASOP.EQ.'=ASS')DMIN=DMIN-EPS
      IF(ICASOP.EQ.'<>  ')DMIN=DMIN-EPS
      IF(ICASOP.EQ.'<   ')DMIN=DMIN-EPS
      IF(ICASOP.EQ.'<=  ')DMIN=DMIN-EPS
      IF(ICASOP.EQ.'>=  ')DMIN=DMIN-EPS
      IF(ICASOP.EQ.'>   ')DMIN=DMIN+EPS
  819 CONTINUE
C
      IF(DMAX.EQ.CPUMAX)GOTO829
      IF(DMAX.EQ.CPUMIN)GOTO829
      IF(ABS(DMAX).EQ.0.0)EPS=0.000001
      IF(ABS(DMAX).NE.0.0)EPS=ABS(DMAX*0.000001)
      IF(ICASOP.EQ.'=   ')DMAX=DMAX+EPS
      IF(ICASOP.EQ.'=ASS')DMAX=DMAX+EPS
      IF(ICASOP.EQ.'<>  ')DMAX=DMAX+EPS
      IF(ICASOP.EQ.'<   ')DMAX=DMAX-EPS
      IF(ICASOP.EQ.'<=  ')DMAX=DMAX+EPS
      IF(ICASOP.EQ.'>=  ')DMAX=DMAX+EPS
      IF(ICASOP.EQ.'>   ')DMAX=DMAX+EPS
  829 CONTINUE
C
  890 CONTINUE
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,891)IPASS,ICASPA,ICASOP,IH,IH2
  891 FORMAT('IPASS,ICASPA,ICASOP,IH,IH2 = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,892)EPS,DMIN,DMAX,CPUMIN,CPUMAX
  892 FORMAT('EPS,DMIN,DMAX,CPUMIN,CPUMAX = ',5E15.7)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ****************************************************
C               **  STEP 9--                                      **
C               **  DEFINE THE ISUB(.) VECTOR--                   **
C               **  FOR ANY K (K = 1 TO NIOLD),                  **
C               **  IF THE K-TH ELEMENT OF THE                    **
C               **  SUBSET SPECIFICATION VARIABLE                 **
C               **  (THE VARIABLE SPECIFIED AFTER    SUBSET   **
C               **  IN THE COMMAND LINE)                          **
C               **  IS WITHIN THE SPECIFIED (DMIN,DMAX) LIMITS,   **
C               **  THEN ISUB(K) SHOULD RESULT IN A VALUE OF 1;   **
C               **  BUT IF THE K-TH ELEMENT OF THE                **
C               **  SUBSET SPECIFICATION VARIABLE                 **
C               **  IS OUTSIDE THE SPECIFIED (DMIN,DMAX) LIMITS,  **
C               **  THEN ISUB(K) SHOULD RESULT IN A 0 .           **
C               ****************************************************
C
      ISTEPN='9'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,901)ILOCS1,IHSET,IHSET2,ICASPA,ASETV,
     1MAXCOL
  901 FORMAT('ILOCS1,IHSET,IHSET2,ICASPA,ASETV,MAXCOL = ',
     1I8,2X,A4,2X,A4,2X,A4,E15.7,I8)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(ICASPA.EQ.'UNKN')GOTO910
      IF(ICASPA.EQ.'P   ')GOTO940
C
  910 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,911)
  911 FORMAT('***** INTERNAL ERROR IN DPIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,912)
  912 FORMAT('      IMPROPER VALUE FOR ICASPA AND/OR ASETV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,913)ICASPA,ASETV,MAXCOL,MAXCP1,MAXCP2
  913 FORMAT('      ICASPA,ASETV,MAXCOL,MAXCP1,MAXCP2 = ',A4,
     1E15.7,3I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  940 CONTINUE
      NS=0
      ND=0
      DO941I=1,NIOLD
      VIJ=ASETV
      IF(IBUGQ.EQ.'ON')WRITE(9,947)I,NIOLD,ASETV,DMIN,DMAX,VIJ
  947 FORMAT('I,NIOLD,ASETV,DMIN,DMAX,VIJ = ',
     12I8,E15.7,3F12.5)
      TARGET=VIJ
      ISTATI='FALS'
C
      IF(ICASQU.EQ.'IF  '.AND.ICASOP.EQ.'<>  '.AND.
     1TARGET.LT.DMIN)GOTO942
      IF(ICASQU.EQ.'IF  '.AND.ICASOP.EQ.'<>  '.AND.
     1DMAX.LT.TARGET)GOTO942
      IF(ICASQU.EQ.'IF  '.AND.ICASOP.EQ.'<>  '.AND.
     1DMIN.LE.TARGET.AND.TARGET.LE.DMAX)GOTO943
      IF(ICASQU.EQ.'IF  '.AND.
     1DMIN.LE.TARGET.AND.TARGET.LE.DMAX)GOTO942
      IF(ICASQU.EQ.'IF  ')GOTO943
      GOTO941
C
  942 CONTINUE
      ISTATI='TRUE'
      ITEMP=ISUB(I)
      IF(ITEMP.EQ.00)ISUB(I)=10
      IF(ITEMP.EQ.10)ISUB(I)=10
      IF(ITEMP.EQ.01)ISUB(I)=11
      IF(ITEMP.EQ.11)ISUB(I)=11
      NS=NS+1
      GOTO941
  943 CONTINUE
      ND=ND+1
      GOTO941
  941 CONTINUE
      GOTO990
C
  990 CONTINUE
      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,991)IPASS,ICASQU,DMIN,DMAX,EPS,
     1NIOLD,NS,ND
  991 FORMAT('IPASS,ICASQU,DMIN,DMAX,EPS,NIOLD,NS,ND = ',
     1I8,2X,A4,3E15.7,3I8)
      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IBUGQ.EQ.'OFF')GOTO994
      DO992I=1,NIOLD
      WRITE(ICOUT,993)I,ISUB(I)
  993 FORMAT('I,ISUB(I) = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
  992 CONTINUE
      WRITE(ICOUT,995)ITEMP,ISTATI
  995 FORMAT('ITEMP,ISTATI = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  994 CONTINUE
C
C               *************************************************
C               **  STEP 10--                                  **
C               **  WRITE OUT A MESSAGE FOR THIS STEP          **
C               **  INDICATING                                 **
C               **  THE SUBSET PARAMETER NAME,                 **
C               **  THE SUBSET MINIMUM,                        **
C               **  THE SUBSET MAXIMUM,                        **
C               **  THE SUBSET PARAMETER VALUE,                        **
C               **  THE SUBSET PARAMETER STATUS,                        **
C               *************************************************
C
      ISTEPN='10'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 1010 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1019
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** NOTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)IHARG(ILOCS1),IHARG2(ILOCS1)
 1012 FORMAT('      IF     PARAMETER = ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)DMIN
 1013 FORMAT('      IF     MINIMUM   = ',E17.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)DMAX
 1014 FORMAT('      IF     MAXIMUM   = ',E17.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1015)ASETV
 1015 FORMAT('      IF     PARAMETER VALUE    = ',E17.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1016)ISTATI
 1016 FORMAT('      IF     PARAMETER STATUS   = ',A4)
      CALL DPWRST('XXX','BUG ')
 1019 CONTINUE
      GOTO1050
C
 1050 CONTINUE
CCCCC IF(NS.GE.1)GOTO1059
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1051)
C1051 FORMAT('***** ERROR IN DPIF--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1052)
C1052 FORMAT('      THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
C1059 CONTINUE
C
      NUMSV=IPASS
C
  300 CONTINUE
C
 1100 CONTINUE
      DO1110I=1,NIOLD
      ITEMP=ISUB(I)
      IF(ITEMP.EQ.00)ISUB(I)=00
      IF(ITEMP.EQ.10)ISUB(I)=00
      IF(ITEMP.EQ.01)ISUB(I)=00
      IF(ITEMP.EQ.11)ISUB(I)=11
 1110 CONTINUE
C
C               *************************************
C               **  STEP 11--                      **
C               **  PUT ISUB(.) IN FINAL 0,1 FORM  **
C               *************************************
C
      ISTEPN='11'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1210I=1,NIOLD
      ITEMP=ISUB(I)
      IF(ITEMP.EQ.00)ISUB(I)=0
      IF(ITEMP.EQ.10)ISUB(I)=0
      IF(ITEMP.EQ.01)ISUB(I)=1
      IF(ITEMP.EQ.11)ISUB(I)=1
 1210 CONTINUE
C
C               *****************************************
C               **  STEP 12--                          **
C               **  IF THERE WERE 2 OR MORE SUBSET     **
C               **  VARIABLES, GATHER INFORMATION      **
C               **  FOR A FINAL SUMMARY MESSAGE BY     **
C               **  DETERMINING THE FINAL NUMBER OF    **
C               **  ELEMENTS IN THE SUBSET             **
C               **  (AFTER ALL VARIABLES HAVE          **
C               **  BEEN INDIVIDUALLY ACCOUNTED FOR).  **
C               *****************************************
C
 1500 CONTINUE
C
      ISTEPN='12'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMSV.LE.1)GOTO1590
      NS=0
      DO1510I=1,NIOLD
      IF(ISUB(I).EQ.1)NS=NS+1
 1510 CONTINUE
 1590 CONTINUE
C
C               *************************************************
C               **  STEP 13--                                  **
C               **  IF THERE WERE 2 OR MORE SUBSET VARIABLES,  **
C               **  WRITE OUT A FINAL MESSAGE                  **
C               **  SUMMARIZING FOR ALL VARIABLES              **
C               **  THE NUMBER OF SUBSET VARIABLES             **
C               **  THE INPUT NUMBER OF OBSERVATIONS (LOCAL),  **
C               **  THE NUMBER OF OBSERVATIONS IGNORED         **
C               **  AND THE OUTPUT NUMBER OF OBSERVATIONS      **
C               **  (THAT IS, THE SUBSET SAMPLE SIZE).         **
C               **  ALSO, CHECK THAT NS IS POSITIVE.           **
C               *************************************************
C
      ISTEPN='13'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASIF='FALS'
      IF(ISUB(1).EQ.1)ICASIF='TRUE'
C
      IF(NUMSV.LE.1)GOTO1690
C
      IF(IFEEDB.EQ.'OFF')GOTO1609
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1601)
 1601 FORMAT('*****    IF    SUMMARY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1602)NUMSV
 1602 FORMAT('      NUMBER OF SPECIFICATIONS       = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1605)ICASIF
 1605 FORMAT('      FINAL    IF    STATUS          = ',A4)
      CALL DPWRST('XXX','BUG ')
 1609 CONTINUE
C
 1690 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
C  IF ERROR, THEN SET IF STATUS TO FALSE.    FEBRUARY 1999
C
      IF(IERROR.EQ.'YES')THEN
        ICASIF='FALS'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9001)
 9001   FORMAT('***** ERROR IN DPIF, IF STATUS SET TO FALSE.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(IBUGQ.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPIF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NIOLD,ILOCS,NS
 9012 FORMAT('NIOLD,ILOCS,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IBUGQ,IERROR
 9014 FORMAT('IBUGQ,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMARG,NUMNAM,MAXNAM,N,MAXN
 9015 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IWIDTH,ILOCS,ILOCS2,ILOCTG
 9016 FORMAT('IWIDTH,ILOCS,ILOCS2,ILOCTG = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)NUMSV,ND
 9017 FORMAT('NUMSV,ND = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)ICASQU,ICASPA,ICASOP,ICASSC
 9018 FORMAT('ICASQU,ICASPA,ICASOP,ICASSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,NIOLD
      WRITE(ICOUT,9021)I,ISUB(I)
 9021 FORMAT('I,ISUB(I) = ',2I8)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
      WRITE(ICOUT,9022)ISTATI,ICASIF
 9022 FORMAT('ISTATI,ICASIF = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)JMIN,JMAX,NUMARG
 9023 FORMAT('JMIN,JMAX,NUMARG = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPIMP1(IX2TSW,IY2TSW,IX2ZSW,IY2ZSW,NCY2LA,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--THIS IS IMPLEMENTATION MODULE NUMBER 1.
C              THIS WILL RESULT IN--
C                 1) NO TIC MARKS OR TIC MARK LABELS ON UPPER FRAME LINE
C                 2) NO TIC MARKS OR TIC MARK LABELS ON RIGHT FRAME LINE
C                 3) NO VERTICAL LABEL (Y2LABEL) ON RIGHT FRAME LINE
C     NOTE--THIS SUBROUTINE WILL BE EXECUTED WHEN THE
C           ANALYST ENTERS THE COMMAND--
C                   IMPLEMENT 1
C     NOTE--THE IMPLEMENT COMMAND IS USEFUL FOR IMPLEMENTATION ,DEBUGGING,
C           AND FOR NON-STANDARD CONVENTIONS (E.G., PLOTS WITH NON-STANDARD
C           SIZE OR TIC MARK CONVENTIONS OTHER THAN DATAPLOT'S DEFAULT)
C     INPUT  ARGUMENTS--NONE
C     OUTPUT ARGUMENTS--
C                     --IX2TSW
C                     --IY2TSW
C                     --IX2ZSW
C                     --IY2ZSW
C                     --NCY2LA
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
C
      CHARACTER*4 IX2TSW
      CHARACTER*4 IY2TSW
C
      CHARACTER*4 IX2ZSW
      CHARACTER*4 IY2ZSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      IFOUND='YES'
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPIMP1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IX2TSW,IY2TSW
   52 FORMAT('IX2TSW,IY2TSW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IX2ZSW,IY2ZSW
   53 FORMAT('IX2ZSW,IY2ZSW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NCY2LA
   54 FORMAT('NCY2LA = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGS2,IFOUND,IERROR
   59 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C               ***********************************************
C               **  STEP 1--                                 **
C               **  DEFINE PARAMETER CHANGES TO BE MADE      **
C               **  FOR THIS IMPLEMENTATION MODULE NUMBER 1  **
C               ***********************************************
C
      IX2TSW='ON'
      IY2TSW='ON'
C
      IX2ZSW='ON'
      IY2ZSW='ON'
C
CCCCC NCY2LA=0
C
C               ***************************
C               **  STEP 2--             **
C               **  WRITE OUT A MESSAGE. **
C               ***************************
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('THE IMPLEMENTATION MODULE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      HAS JUST BEEN ACTIVATED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      WHICH ALLOWS TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)
 1154 FORMAT('      AND TIC MARK LABELS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      ON THE TOP AND RIGHT FRAME LINES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)
 1156 FORMAT('      OF ALL SUBSEQUENT PLOTS.')
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPIMP1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IX2TSW,IY2TSW
 9012 FORMAT('IX2TSW,IY2TSW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IX2ZSW,IY2ZSW
 9013 FORMAT('IX2ZSW,IY2ZSW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NCY2LA
 9014 FORMAT('NCY2LA = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPIMP2(ANUMVP,ANUMHP,
     1ISQUAR,
     1PXMIN,PYMIN,PXMAX,PYMAX,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--THIS IS IMPLEMENTATION MODULE NUMBER 2.
C              THIS WILL RESULT IN--
C                    THE PLOT FRAME CHANGED FROM RECTANGULAR
C                    TO SQUARE FOR ALL FUTURE PLOTS
C                    ON TEKTRONIX GRAPHICS DEVICES.
C     NOTE--THIS SUBROUTINE WILL BE EXECUTED WHEN THE
C           ANALYST ENTERS THE COMMAND--
C                   IMPLEMENT 2
C     NOTE--THE IMPLEMENT COMMAND IS USEFUL FOR IMPLEMENTATION ,DEBUGGING,
C           AND FOR NON-STANDARD CONVENTIONS (E.G., PLOTS WITH NON-STANDARD
C           SIZE OR TIC MARK CONVENTIONS OTHER THAN DATAPLOT'S DEFAULT)
C     INPUT  ARGUMENTS--NONE
C     OUTPUT ARGUMENTS--
C                     --PXMIN
C                     --PYMIN
C                     --PXMAX
C                     --PYMAX
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISQUAR
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      IFOUND='YES'
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPIMP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ANUMVP,ANUMHP
   52 FORMAT('ANUMVP,ANUMHP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ISQUAR
   53 FORMAT('ISQUAR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)PXMIN,PXMAX,PYMIN,PYMAX
   54 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGS2,IFOUND,IERROR
   59 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***********************************************
C               **  STEP 1--                                 **
C               **  DEFINE PARAMETER CHANGES TO BE MADE      **
C               **  FOR THIS IMPLEMENTATION MODULE NUMBER 2  **
C               ***********************************************
C
      ISQUAR='ON'
C
CCCCC PXMIN=15.0
CCCCC PYMIN=20.0
CCCCC PYMAX=90.0
C
CCCCC PYDEL=PYMAX-PYMIN
CCCCC PXDEL=PYDEL*(ANUMVP/ANUMHP)
CCCCC PXMAX=PXMIN+PXDEL
C
C               ***************************
C               **  STEP 2--             **
C               **  WRITE OUT A MESSAGE. **
C               ***************************
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('THE IMPLEMENTATION MODULE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      HAS JUST BEEN ACTIVATED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      WHICH YIELDS A SQUARE PLOT FRAME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)
 1154 FORMAT('      FOR ALL SUBSEQUENT PLOTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      ON (CONTINUOUS) GRAPHICS DEVICES.')
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPIMP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ISQUAR
 9012 FORMAT('ISQUAR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ANUMVP,ANUMHP
 9013 FORMAT('ANUMVP,ANUMHP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)PXMIN,PXMAX,PYMIN,PYMAX
 9014 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGS2,IFOUND,IERROR
 9019 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPIMPL(IHARG,IARGT,IARG,NUMARG,
     1IX2TSW,IY2TSW,IX2ZSW,IY2ZSW,NCY2LA,
     1ISQUAR,
     1PXMIN,PYMIN,PXMAX,PYMAX,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--REINITIALIZE A SET OF UNDERLYING
C              FORTRAN PARAMETERS SO AS TO ACHIEVE
C              ALTERNATE SETTINGS FOR SUCH PARAMETERS.
C     NOTE--THIS CAPABILITY IS USEFUL FOR IMPLEMENTATION ,DEBUGGING,
C           AND FOR NON-STANDARD CONVENTIONS (E.G., PLOTS WITH NON-STANDARD
C           SIZE OR NO TIC MARKS ON UPPER AND RIGHT FRAME).
C     INPUT  ARGUMENTS--
C                     --IHARG
C                     --IARGT
C                     --IARG
C                     --NUMARG
C                     --IBUGS2
C     OUTPUT ARGUMENTS--
C                     --IX2TSW
C                     --IY2TSW
C                     --IX2ZSW
C                     --IY2ZSW
C                     --NCY2LA
C
C                     --PXMIN
C                     --PYMIN
C                     --PXMAX
C                     --PYMAX
C
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISQUAR
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IX2TSW
      CHARACTER*4 IY2TSW
C
      CHARACTER*4 IX2ZSW
      CHARACTER*4 IY2ZSW
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
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
      IHOLD=(-999)
      IMPLNU=(-999)
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1050
      IF(IHARG(NUMARG).EQ.'ON')GOTO1050
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1050
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1050
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1050
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1060
      GOTO1040
C
 1040 CONTINUE
      IF(IHARG(NUMARG).EQ.'TICS')GOTO1100
      IF(IHARG(NUMARG).EQ.'SQUA')GOTO1200
      GOTO8000
C
 1050 CONTINUE
      IHOLD=0
      GOTO1070
C
 1060 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1070
C
 1070 CONTINUE
      IFOUND='YES'
      IMPLNU=IHOLD
C
      IF(IMPLNU.EQ.1)GOTO1100
      IF(IMPLNU.EQ.2)GOTO1200
      GOTO8000
C
 1100 CONTINUE
      CALL DPIMP1(IX2TSW,IY2TSW,IX2ZSW,IY2ZSW,NCY2LA,
     1IBUGS2,IFOUND,IERROR)
      GOTO9000
C
 1200 CONTINUE
      CALL DPIMP2(ANUMVP,ANUMHP,
     1ISQUAR,
     1PXMIN,PYMIN,PXMAX,PYMAX,
     1IBUGS2,IFOUND,IERROR)
      GOTO9000
C
 8000 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)
 8111 FORMAT('***** ERROR IN DPIMPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)
 8112 FORMAT('      AN ATTEMPT WAS MADE TO ACTIVATE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8113)IHARG(NUMARG)
 8113 FORMAT('      IMPLEMENTATION MODULE ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8114)
 8114 FORMAT('      BUT SUCH A MODULE DOES NOT EXIST.')
      CALL DPWRST('XXX','BUG ')
 8119 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF DPIMPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NUMARG
 9012 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IHARG(1),IARGT(1),IARG(1)
 9013 FORMAT('IHARG(1),IARGT(1),IARG(1) = ',
     1A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHARG(NUMARG),IARGT(NUMARG),IARG(NUMARG)
 9014 FORMAT('IHARG(NUMARG),IARGT(NUMARG),IARG(NUMARG) = ',
     1A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IHOLD
 9015 FORMAT('IHOLD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IMPLNU
 9016 FORMAT('IMPLNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGS2,IFOUND,IERROR
 9029 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPINCU(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ISEED,
     1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING INFLUENCE CURVES--
C              AN INFLUENCE CURVE IS A MEASURE OF ROBUSTNESS.
C              IT PLOTS THE VALUE OF A STATISTIC WHEN ONE ADDITIONAL
C              VALUE IS ADDED.  FOR EXAMPLE,
C                 MEAN INFLUENCE CURVE Y XSEQ
C              CYCLES THROUGH THE POINTS IN XSEQ.  THE VERTICAL
C              AXIS IS THE VALUE OF THE MEAN FOR THE POINTS IN Y
C              WITH THE SINGLE VALUE IN XSEQ ADDED TO Y.
C
C              FOR THIS PLOT, ONLY ONE VARIABLE STATISTICS ARE
C              SUPPORTED (I.E., NO CORRELATION, ETC.).
C
C                 MEAN INFLUENCE CURVE
C                 MIDM INFLUENCE CURVE
C                 MEDI INFLUENCE CURVE
C                 WINSORIZED MEAN INFLUENCE CURVE
C                 BIWEIGHT LOCATION INFLUENCE CURVE
C                 GEOMETRIC MEAN INFLUENCE CURVE
C                 HARMONIC MEAN INFLUENCE CURVE
C                 HODGES LEHMAN PLOT
C                 SD INFLUENCE CURVE
C                 REL SD INFLUENCE CURVE
C                 SD MEAN INFLUENCE CURVE
C                 TRIMMED MEAN STANDARD ERROR INFLUENCE CURVE
C                 VARI INFLUENCE CURVE
C                 REL VARI INFLUENCE CURVE
C                 VARI MEAN INFLUENCE CURVE
C                 RANG INFLUENCE CURVE
C                 GEOMETRIC STANDARD DEVIATION INFLUENCE CURVE
C                 AAD INFLUENCE CURVE
C                 MAD INFLUENCE CURVE
C                 SN INFLUENCE CURVE
C                 QN INFLUENCE CURVE
C                 INTERQUARTILE RANGE INFLUENCE CURVE
C                 BIWEIGHT SCALE INFLUENCE CURVE
C                 BIWEIGHT MIDVARIANCE PLOT
C                 PERCENTAGE BEND MIDVARIANCE PLOT
C                 WINSORIZED VARIANCE INFLUENCE CURVE
C                 WINSORIZED SD INFLUENCE CURVE
C                 MINI INFLUENCE CURVE
C                 MAXI INFLUENCE CURVE
C                 EXTREME INFLUENCE CURVE
C                 SKEW INFLUENCE CURVE
C                 KURT INFLUENCE CURVE
C                 AUCR INFLUENCE CURVE
C                 SDM INFLUENCE CURVE
C                 AUCV INFLUENCE CURVE
C                 RACV INFLUENCE CURVE
C                 LOWH INFLUENCE CURVE
C                 UPPH INFLUENCE CURVE
C                 LOWQ INFLUENCE CURVE
C                 UPPQ INFLUENCE CURVE
C                 TRIM INFLUENCE CURVE
C                 WINM INFLUENCE CURVE
C                 MIDQ INFLUENCE CURVE
C                 PERCENTILE INFLUENCE CURVE
C                 QUANTILE INFLUENCE CURVE
C                 QUANTILE STANDARD ERROR INFLUENCE CURVE
C                 1DEC INFLUENCE CURVE
C                 2DEC INFLUENCE CURVE
C                 3DEC INFLUENCE CURVE
C                 4DEC INFLUENCE CURVE
C                 5DEC INFLUENCE CURVE
C                 6DEC INFLUENCE CURVE
C                 7DEC INFLUENCE CURVE
C                 8DEC INFLUENCE CURVE
C                 9DEC INFLUENCE CURVE
C                 SINE FREQUENCY INFLUENCE CURVE
C                 SINE AMPLITUDE INFLUENCE CURVE
C                 TAGUCHI SIGNAL-TO-NOISE INFLUENCE CURVES
C                 CP INFLUENCE CURVE
C                 CPL INFLUENCE CURVE
C                 CPU INFLUENCE CURVE
C                 CPK INFLUENCE CURVE
C                 CPM INFLUENCE CURVE
C                 CC INFLUENCE CURVE
C                 CNPK INFLUENCE CURVE
C                 PERCENT DEFECTIVE INFLUENCE CURVE
C                 EXPECTED LOSS INFLUENCE CURVE
C                 NORM PPCC INFLUENCE CURVE
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--2002/7
C     ORIGINAL VERSION--JULY      2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IHX
      CHARACTER*4 IHX2
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Z1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),Z1(1))
      EQUIVALENCE (GARBAG(IGARB4),XTEMP3(1))
C
      INCLUDE 'DPCOZI.INC'
C
      INTEGER ITEMP1(MAXOBV)
      INTEGER ITEMP2(MAXOBV)
      INTEGER ITEMP3(MAXOBV)
      INTEGER ITEMP4(MAXOBV)
      INTEGER ITEMP5(MAXOBV)
      INTEGER ITEMP6(MAXOBV)
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5(1))
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='INCU'
      ISUBN2='    '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLL=0
      ICOLH=0
      ICOLX=0
C
C               ************************************
C               **  TREAT THE INFLUENCE CURVE CASE  **
C               ************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'INCU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPINCU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
   52 FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPINCU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE IF OF THIS TYPE  **
C               **  AND BRANCH ACCORDINGLY.    **
C               *********************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.AND.ISUBRO.NE.'INCU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
C
      IF(ICOM.EQ.'MIDR'.AND.ICOM2.EQ.'ANGE')GOTO221
      IF(ICOM.EQ.'MEAN'.AND.ICOM2.EQ.'    ')GOTO222
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AVER'.AND.ICOM2.EQ.'AGE '.AND.IHARG(1).EQ.'ABSO'.AND.
     1IHARG(2).EQ.'DEVI')GOTO413
      IF(ICOM.EQ.'AAD '.AND.ICOM2.EQ.'    ')GOTO414
C
      IF(ICOM.EQ.'AVER'.AND.ICOM2.EQ.'AGE ')GOTO222
      IF(ICOM.EQ.'MIDM'.AND.ICOM2.EQ.'EAN ')GOTO223
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MEDI'.AND.ICOM2.EQ.'AN  '.AND.IHARG(1).EQ.'ABSO'.AND.
     1IHARG(2).EQ.'DEVI')GOTO415
      IF(ICOM.EQ.'MAD '.AND.ICOM2.EQ.'    ')GOTO416
C
      IF(ICOM.EQ.'MEDI'.AND.ICOM2.EQ.'AN  ')GOTO224
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'TRIM'.AND.IHARG(1).EQ.'MEAN'.AND.
     1(IHARG(2).NE.'STAN'.AND.IHARG(3).NE.'ERRO'))GOTO225
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WIND'.AND.IHARG(1).EQ.'MEAN')GOTO226
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'MEAN')GOTO226
C
      IF(ICOM.EQ.'R   '.AND.ICOM2.EQ.'    ')GOTO241
      IF(ICOM.EQ.'RANG'.AND.ICOM2.EQ.'E   ')GOTO241
      IF(ICOM.EQ.'MINI'.AND.ICOM2.EQ.'MUM ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(ICOM.EQ.'MINI')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(ICOM.EQ.'MIN '.AND.ICOM2.EQ.'    ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(ICOM.EQ.'MAXI'.AND.ICOM2.EQ.'MUM ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
      IF(ICOM.EQ.'MAXI')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
      IF(ICOM.EQ.'MAX '.AND.ICOM2.EQ.'    ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'THE '.AND.IHARG(3).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'MEAN')GOTO253
      IF(ICOM.EQ.'VARI'.AND.ICOM2.EQ.'ANCE')GOTO254
      IF(ICOM.EQ.'VARI'.AND.ICOM2.EQ.'    ')GOTO254
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'VAR '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'THE '.AND.IHARG(3).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'VAR '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'VAR '.AND.IHARG(1).EQ.'MEAN')GOTO253
      IF(ICOM.EQ.'VAR '.AND.ICOM2.EQ.'    ')GOTO254
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'OF  '.AND.IHARG(3).EQ.'THE '.AND.
     1IHARG(4).EQ.'MEAN')GOTO261
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'OF  '.AND.IHARG(3).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'MEAN')GOTO263
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'THE '.AND.IHARG(3).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MEAN')GOTO263
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'MEAN')GOTO266
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI')GOTO264
      IF(ICOM.EQ.'SD  '.AND.ICOM2.EQ.'    ')GOTO265
      IF(ICOM.EQ.'S   '.AND.ICOM2.EQ.'    ')GOTO265
C
      IF(ICOM.EQ.'RS  '.AND.ICOM2.EQ.'    ')GOTO271
      IF(ICOM.EQ.'RSD '.AND.ICOM2.EQ.'    ')GOTO271
      IF(ICOM.EQ.'RELS'.AND.ICOM2.EQ.'    ')GOTO271
      IF(ICOM.EQ.'RELS'.AND.ICOM2.EQ.'D   ')GOTO271
      IF(ICOM.EQ.'RV  '.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RVAR'.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RELV'.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RELV'.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RELV'.AND.ICOM2.EQ.'AR  ')GOTO272
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'COEF'.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'VARI')GOTO273
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'COEF'.AND.IHARG(1).EQ.'VARI')GOTO274
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'SD  ')GOTO276
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO277
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'VAR ')GOTO278
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'VARI')GOTO278
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LOWE'.AND.IHARG(1).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'QUAR')GOTO302
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'UPPE'.AND.IHARG(1).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LOWE'.AND.IHARG(1).EQ.'HING')GOTO304
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'UPPE'.AND.IHARG(1).EQ.'HING')GOTO305
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'THIR'.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO311
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'3RD '.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO311
      IF(ICOM.EQ.'SKEW'.AND.ICOM2.EQ.'NESS')GOTO312
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'FOUR'.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO313
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'4TH '.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO313
      IF(ICOM.EQ.'KURT'.AND.ICOM2.EQ.'OSIS')GOTO314
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'COVA'.AND.
     1IHARG(1).EQ.'INFL'.AND.IHARG(2).EQ.'CURV')GOTO321
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'CORR'.AND.
     1IHARG(1).EQ.'INFL'.AND.IHARG(2).EQ.'CURV')GOTO322
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI')GOTO111
      GOTO119
  111 CONTINUE
      IF(ICOM.EQ.'FIRS')GOTO341
      IF(ICOM.EQ.'SECO')GOTO342
      IF(ICOM.EQ.'THIR')GOTO343
      IF(ICOM.EQ.'FOUR')GOTO344
      IF(ICOM.EQ.'FIFT')GOTO345
      IF(ICOM.EQ.'SIXT')GOTO346
      IF(ICOM.EQ.'SEVE')GOTO347
      IF(ICOM.EQ.'EIGH')GOTO348
      IF(ICOM.EQ.'NINT')GOTO349
  119 CONTINUE
C
      IF(ICOM.EQ.'PERC'.AND.IHARG(1).NE.'BEND'.AND.IHARG(1).NE.'DEFE')
     1   GOTO350
C
      IF(ICOM.EQ.'SN'.AND.IHARG(1).EQ.'SCAL')GOTO478
      IF(ICOM.EQ.'QN'.AND.IHARG(1).EQ.'SCAL')GOTO480
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SIN'.AND.IHARG(1).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SINE'.AND.IHARG(1).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SIN'.AND.IHARG(1).EQ.'AMP')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SINE'.AND.IHARG(1).EQ.'AMP')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SIN'.AND.IHARG(1).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SINE'.AND.IHARG(1).EQ.'AMPL')GOTO362
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'TAGU')GOTO130
      GOTO139
  130 CONTINUE
      IF(IHARG(1).EQ.'SN')GOTO371
      IF(IHARG(1).EQ.'S/N')GOTO371
      IF(IHARG(1).EQ.'SN0')GOTO371
      IF(IHARG(1).EQ.'S/N0')GOTO371
      IF(IHARG(1).EQ.'SNT')GOTO371
      IF(IHARG(1).EQ.'S/NT')GOTO371
      IF(IHARG(1).EQ.'SN+')GOTO372
      IF(IHARG(1).EQ.'S/N+')GOTO372
      IF(IHARG(1).EQ.'SNL')GOTO372
      IF(IHARG(1).EQ.'SN-')GOTO373
      IF(IHARG(1).EQ.'S/N-')GOTO373
      IF(IHARG(1).EQ.'SNS')GOTO373
      IF(IHARG(1).EQ.'SN00')GOTO374
      IF(IHARG(1).EQ.'SNT2')GOTO374
      IF(IHARG(1).EQ.'S/N2')GOTO374
      IF(IHARG(1).EQ.'SN2')GOTO374
  139 CONTINUE
C
      IF(ICOM.EQ.'SN')GOTO381
      IF(ICOM.EQ.'S/N')GOTO381
      IF(ICOM.EQ.'SN0')GOTO381
      IF(ICOM.EQ.'S/N0')GOTO381
      IF(ICOM.EQ.'SNT')GOTO381
      IF(ICOM.EQ.'S/NT')GOTO381
      IF(ICOM.EQ.'SN+')GOTO382
      IF(ICOM.EQ.'S/N+')GOTO382
      IF(ICOM.EQ.'SNL ')GOTO382
      IF(ICOM.EQ.'SN-')GOTO383
      IF(ICOM.EQ.'S/N-')GOTO383
      IF(ICOM.EQ.'SNS')GOTO383
      IF(ICOM.EQ.'SN00')GOTO384
      IF(ICOM.EQ.'SNT2')GOTO384
      IF(ICOM.EQ.'S/N2')GOTO384
      IF(ICOM.EQ.'SN2')GOTO384
C
      IF(ICOM.EQ.'CP')GOTO401
      IF(ICOM.EQ.'CPK')GOTO402
      IF(ICOM.EQ.'CNPK')GOTO398
      IF(ICOM.EQ.'CPM')GOTO400
      IF(ICOM.EQ.'CC')GOTO399
      IF(ICOM.EQ.'CPL')GOTO396
      IF(ICOM.EQ.'CPU')GOTO397
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'DEFE')GOTO403
         IF(ICOM.EQ.'EXPE'.AND.IHARG(1).EQ.'LOSS')GOTO404
      ENDIF
C
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'NORM'.AND.IHARG(1).EQ.'PPCC')GOTO411
      ENDIF
C
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'EXTR')GOTO412
      ENDIF
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'GEOM'.AND.ICOM2.EQ.'ETRI'.AND.IHARG(1).EQ.'MEAN')GOTO426
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'GEOM'.AND.ICOM2.EQ.'ETRI'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO436
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'HARM'.AND.IHARG(1).EQ.'MEAN')GOTO446
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'INTE'.AND.IHARG(1).EQ.'RANG')GOTO456
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'IQ  '.AND.IHARG(1).EQ.'RANG')GOTO456
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'LOCA')GOTO457
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'SCAL')GOTO458
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'VARI')GOTO460
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'SD')GOTO462
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI')
     1GOTO464
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'MIDV')GOTO466
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'HODG'.AND.IHARG(1).EQ.'LEHM')GOTO468
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'BEND'.AND.IHARG(2).EQ.'MIDV')
     1GOTO470
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'QUAN'.AND.IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'ERRO')
     1GOTO472
C
      IF(ICOM.EQ.'QUAN')GOTO474
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'TRIM'.AND.IHARG(1).EQ.'MEAN'.AND.
     1IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'ERRO')
     1GOTO476
C
      IFOUND='NO'
      GOTO9000
C
C               **********************
C               **  STEP 2--        **
C               **  DEFINE ICASPL.  **
C               **********************
C
  221 CONTINUE
      ICASPL='MIDR'
      GOTO701
C
  222 CONTINUE
      ICASPL='MEAN'
      GOTO701
C
  223 CONTINUE
      ICASPL='MIDM'
      GOTO701
C
  224 CONTINUE
      ICASPL='MEDI'
      GOTO701
C
  225 CONTINUE
      ICASPL='TRIM'
      GOTO702
C
  226 CONTINUE
      ICASPL='WINM'
      GOTO702
C
  241 CONTINUE
      ICASPL='RANG'
      GOTO701
C
  242 CONTINUE
      ICASPL='MINI'
      GOTO701
C
  243 CONTINUE
      ICASPL='MAXI'
      GOTO701
C
  251 CONTINUE
      ICASPL='VAME'
      GOTO704
C
  252 CONTINUE
      ICASPL='VAME'
      GOTO703
C
  253 CONTINUE
      ICASPL='VAME'
      GOTO702
C
  254 CONTINUE
      ICASPL='VARI'
      GOTO701
C
  261 CONTINUE
      ICASPL='SDME'
      GOTO705
C
  262 CONTINUE
      ICASPL='SDME'
      GOTO704
C
  263 CONTINUE
      ICASPL='SDME'
      GOTO703
C
  264 CONTINUE
      ICASPL='SD'
      GOTO702
C
  265 CONTINUE
      ICASPL='SD'
      GOTO701
C
  266 CONTINUE
      ICASPL='SDME'
      GOTO702
C
  271 CONTINUE
      ICASPL='RESD'
      GOTO701
C
  272 CONTINUE
      ICASPL='REVA'
      GOTO701
C
  273 CONTINUE
      ICASPL='CVAR'
      GOTO703
C
  274 CONTINUE
      ICASPL='CVAR'
      GOTO702
C
  276 CONTINUE
      ICASPL='RESD'
      GOTO702
C
  277 CONTINUE
      ICASPL='RESD'
      GOTO703
C
  278 CONTINUE
      ICASPL='REVA'
      GOTO702
C
  301 CONTINUE
      ICASPL='LOWQ'
      GOTO702
C
  302 CONTINUE
      ICASPL='MIDQ'
      GOTO702
C
  303 CONTINUE
      ICASPL='UPPQ'
      GOTO702
C
  304 CONTINUE
      ICASPL='LOWH'
      GOTO702
C
  305 CONTINUE
      ICASPL='UPPH'
      GOTO702
C
  311 CONTINUE
      ICASPL='SKEW'
      GOTO704
C
  312 CONTINUE
      ICASPL='SKEW'
      GOTO701
C
  313 CONTINUE
      ICASPL='KURT'
      GOTO704
C
  314 CONTINUE
      ICASPL='KURT'
      GOTO701
C
  321 CONTINUE
      ICASPL='AUCV'
      GOTO701
C
  322 CONTINUE
      ICASPL='AUCR'
      GOTO701
C
  341 CONTINUE
      ICASPL='1DEC'
      GOTO702
C
  342 CONTINUE
      ICASPL='2DEC'
      GOTO702
C
  343 CONTINUE
      ICASPL='3DEC'
      GOTO702
C
  344 CONTINUE
      ICASPL='4DEC'
      GOTO702
C
  345 CONTINUE
      ICASPL='5DEC'
      GOTO702
C
  346 CONTINUE
      ICASPL='6DEC'
      GOTO702
C
  347 CONTINUE
      ICASPL='7DEC'
      GOTO702
C
  348 CONTINUE
      ICASPL='8DEC'
      GOTO702
C
  349 CONTINUE
      ICASPL='9DEC'
      GOTO702
C
  350 CONTINUE
      ICASPL='PERC'
      GOTO701
C
  361 CONTINUE
      ICASPL='SIFR'
      GOTO702
C
  362 CONTINUE
      ICASPL='SIAM'
      GOTO702
C
  371 CONTINUE
      ICASPL='SN0'
      GOTO702
C
  372 CONTINUE
      ICASPL='SN+'
      GOTO702
C
  373 CONTINUE
      ICASPL='SN-'
      GOTO702
C
  374 CONTINUE
      ICASPL='SN00'
      GOTO702
C
  381 CONTINUE
      ICASPL='SN0'
      GOTO701
C
  382 CONTINUE
      ICASPL='SN+'
      GOTO701
C
  383 CONTINUE
      ICASPL='SN-'
      GOTO701
C
  384 CONTINUE
      ICASPL='SN00'
      GOTO701
C
  396 CONTINUE
      ICASPL='CPL'
      GOTO701
C
  397 CONTINUE
      ICASPL='CPU'
      GOTO701
C
  398 CONTINUE
      ICASPL='CNPK'
      GOTO701
C
  399 CONTINUE
      ICASPL='CC'
      GOTO701
C
  400 CONTINUE
      ICASPL='CPM'
      GOTO701
C
  401 CONTINUE
      ICASPL='CP'
      GOTO701
C
  402 CONTINUE
      ICASPL='CPK'
      GOTO701
C
  403 CONTINUE
      ICASPL='PEDE'
      GOTO702
C
  404 CONTINUE
      ICASPL='EXLO'
      GOTO702
C
  411 CONTINUE
      ICASPL='NOPP'
      GOTO702
C
  412 CONTINUE
      ICASPL='EXTR'
      GOTO701
C
  413 CONTINUE
      ICASPL='AAD '
      GOTO703
C
  414 CONTINUE
      ICASPL='AAD '
      GOTO701
C
  415 CONTINUE
      ICASPL='MAD '
      GOTO703
C
  416 CONTINUE
      ICASPL='MAD '
      GOTO701
C
  426 CONTINUE
      ICASPL='GEME'
      GOTO702
C
  436 CONTINUE
      ICASPL='GESD'
      GOTO703
C
  446 CONTINUE
      ICASPL='HAME'
      GOTO702
C
  456 CONTINUE
      ICASPL='IQRA'
      GOTO702
C
  457 CONTINUE
      ICASPL='BILO'
      GOTO702
C
  458 CONTINUE
      ICASPL='BISC'
      GOTO702
C
  460 CONTINUE
      ICASPL='WIVA'
      GOTO702
C
  462 CONTINUE
      ICASPL='WISD'
      GOTO702
C
  464 CONTINUE
      ICASPL='WISD'
      GOTO703
C
  466 CONTINUE
      ICASPL='BIMV'
      GOTO702
C
  468 CONTINUE
      ICASPL='HLEH'
      GOTO702
C
  470 CONTINUE
      ICASPL='PBMV'
      GOTO703
C
  472 CONTINUE
      ICASPL='QUSE'
      GOTO703
C
  474 CONTINUE
      ICASPL='QUAN'
      GOTO701
C
  476 CONTINUE
      ICASPL='TMSE'
      GOTO704
C
  478 CONTINUE
      ICASPL='SNSC'
      GOTO702
C
  480 CONTINUE
      ICASPL='QNSC'
      GOTO702
C
C               *****************************************************
C               **  STEP 2--                                       **
C               **  DETERMINE THE LOCATION     (IN IHARG(.))       **
C               **  OF THE WORD      INFLUENCE CURVE               **
C               **  PLACE IT IN    ILASTC                          **
C               *****************************************************
C
  701 CONTINUE
      IF(NUMARG.LT.2)GOTO780
      IF(IHARG(1).EQ.'INFL'.AND.IHARG(2).EQ.'CURV')GOTO802
      GOTO780
C
  702 CONTINUE
      IF(NUMARG.LT.3)GOTO780
      IF(IHARG(2).EQ.'INFL'.AND.IHARG(3).EQ.'CURV')GOTO803
      GOTO780
C
  703 CONTINUE
      IF(NUMARG.LT.4)GOTO780
      IF(IHARG(3).EQ.'INFL'.AND.IHARG(4).EQ.'CURV')GOTO804
      GOTO780
C
  704 CONTINUE
      IF(NUMARG.LT.5)GOTO780
      IF(IHARG(4).EQ.'INFL'.AND.IHARG(5).EQ.'CURV')GOTO805
      GOTO780
C
  705 CONTINUE
      IF(NUMARG.LT.6)GOTO780
      IF(IHARG(5).EQ.'INFL'.AND.IHARG(6).EQ.'CURV')GOTO806
      GOTO780
C
  780 CONTINUE
      IFOUND='NO'
      ICASPL='UNKN'
      GOTO9000
C
  801 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  802 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  803 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  804 CONTINUE
      ILASTC=4
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  805 CONTINUE
      ILASTC=5
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  806 CONTINUE
      ILASTC=6
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  890 CONTINUE
      IFOUND='YES'
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. **
C               ******************************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INCU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 22--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPINCU')
     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.'INCU')
     1WRITE(ICOUT,2211)IHLEFT,ICOLL,NLEFT
 2211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPINCU')
     1CALL DPWRST('XXX','BUG ')
C
C               ******************************************************
C               **  STEP 23--CHECK THAT                             **
C               **  THE INPUT NUMBER OF OBSERVATIONS (NLEFT)        **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.       **
C               ******************************************************
C
      ISTEPN='23'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INCU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO2390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('***** ERROR IN DPINCU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2321)
 2321 FORMAT('      (FOR WHICH A ... INFLUENCE CURVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)MINN2
 2315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2317)
 2317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2318)(IANS(I),I=1,MIN(80,IWIDTH))
 2318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2390 CONTINUE
C
C               *****************************************
C               **  STEP 24--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='24'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPINCU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2480
      DO2400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2420
 2400 CONTINUE
      GOTO2490
 2410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2490
 2420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2490
C
 2480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2481)
 2481 FORMAT('***** INTERNAL ERROR IN DPINCU')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2482)
 2482 FORMAT('      AT BRANCH POINT 2481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2483)
 2483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2484)
 2484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2485)NUMARG
 2485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2486)
 2486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2487)(IANS(I),I=1,IWIDTH)
 2487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2490 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'INCU')GOTO2495
      WRITE(ICOUT,2491)NUMARG,ILOCQ,ICASEQ
 2491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 2495 CONTINUE
C
C               *****************************************
C               **  STEP 24.5--                        **
C               **  DETERMINE THE NUMBER OF VARIABLES  **
C               *****************************************
C
      ISTEPN='24.5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INCU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
C
C               ******************************************************
C               **  STEP 25--                                       **
C               **  FOR A ONE VARIABLE STATISTIC (E.G., THE MEAN)   **
C               **  THE SECOND VARIABLE IS THE ARRAY OF VALUES      **
C               **  THAT ARE ADDED TO THE FIRST VARIABLE (ONE AT    **
C               **  A TIME).  TWO VARIABLE STATISTICS NOT CURRENTLY **
C               **  SUPPORTED, SO THEREFORE EXACTLY TWO VARIABLES   **
C               **  EXPECTED.                                       **
C               ******************************************************
C
      ISTEPN='25'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INCU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.2)GOTO2530
      GOTO2510
C
 2510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2511)
 2511 FORMAT('***** ERROR IN DPINCU--FOR AN ... INFLUENCE CURVE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2518)
 2518 FORMAT('      THE NUMBER OF VARIABLES MUST BE EXACTLY TWO.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2520)
 2520 FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2522)NUMV2
 2522 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2523)
 2523 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2524)(IANS(I),I=1,MIN(80,IWIDTH))
 2524 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2530 CONTINUE
      IHHOR=IHARG(2)
      IHHOR2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH=IVALUE(ILOCV)
      NHOR=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INCU')
     1WRITE(ICOUT,2531)IHHOR,ICOLH,NHOR
 2531 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INCU')
     1CALL DPWRST('XXX','BUG ')
C
C               *************************************************
C               **  STEP 26--                                  **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='26'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPINCU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2610
      IF(ICASEQ.EQ.'SUBS')GOTO2620
      IF(ICASEQ.EQ.'FOR')GOTO2630
C
 2610 CONTINUE
      DO2615I=1,NLEFT
      ISUB(I)=1
 2615 CONTINUE
      NQ=NLEFT
      GOTO2650
C
 2620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2650
C
 2630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2650
C
 2650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO2660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO2660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
 2660 CONTINUE
      NY=J
C
      J=0
      IMAX=NHOR
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO2665I=1,IMAX
      J=J+1
C
      IJ=MAXN*(ICOLH-1)+I
      IF(ICOLH.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLH.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLH.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLH.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLH.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLH.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLH.EQ.MAXCP6)X1(J)=TAGPLO(I)
C
 2665 CONTINUE
      NX=J
C
C               *******************************************************
C               **  STEP 28--                                        **
C               **  COMPUTE THE APPROPRIATE INFLUENCE CURVE --       **
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='28'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INCU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPINC2(Y1,X1,Z1,NX,NY,NUMV2,ICASPL,ISIZE,ICONT,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1Y,X,D,NPLOTP,NPLOTV,ISUBRO,IBUGG3,IERROR)
C
C
C               *************************************************
C               **  STEP 29--                                  **
C               **  SAVE DIFFERENCE BETWEEN HIGHEST VALUE AND  **
C               **  LOWEST VALUE OF STATISTIC IN INTERNAL      **
C               **  PARAMETER ALOWHIGH                         **
C               *************************************************
      AMINS=CPUMAX
      AMAXS=CPUMIN
      DO2910I=1,NPLOTP
        IF(D(I).NE.1.0)GOTO2910
        IF(Y(I).GT.AMAXS)THEN
          AMAXS=Y(I)
          IMAXIN=I
        ENDIF
        IF(Y(I).LT.AMINS)THEN
          AMINS=Y(I)
          IMININ=I
        ENDIF
 2910 CONTINUE
      ADIFF=AMAXS-AMINS
      IF(IMAXIN.GT.IMININ)ADIFF=-ADIFF
C
      ISUBN0='INCU'
C
      IH='ALOW'
      IH2='HIGH'
      VALUE0=ADIFF
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'INCU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPINCU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
 9012 FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ISIZE
 9015 FORMAT('ISIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMV2
 9016 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IHLEFT,IHLEF2,ICOLL,NLEFT
 9017 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.GE.2)WRITE(ICOUT,9018)IHHOR,IHHOR2,ICOLH,NHOR
 9018 FORMAT('IHHOR,IHHOR2,ICOLH,NHOR = ',A4,2X,A4,I8,I8)
      IF(NUMV2.GE.2)CALL DPWRST('XXX','BUG ')
      IF(NUMV2.GE.3)WRITE(ICOUT,9019)IHX,IHX2,ICOLX,NX
 9019 FORMAT('IHX,IHX2,ICOLX,NX = ',A4,2X,A4,I8,I8)
      IF(NUMV2.GE.3)CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS CHANGED SEPTEMBER 1992
CCCCC IF(NPLOTP.LE.0)GOTO9090
      IF(IFOUND.EQ.'NO'.OR.NPLOTP.LE.0)GOTO9090
      DO9025I=1,NPLOTP
      WRITE(ICOUT,9026)I,Y(I),X(I),D(I)
 9026 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPINC2(Y,X,Z,NX,NY,NUMV2,ICASPL,ISIZE,ICONT,
     1TEMP,TEMPZ,XIDTEM,XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1Y2,X2,D2,N2,NPLOTV,ISUBRO,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING INFLUENCE CURVES--
C              AN INFLUENCE CURVE IS A MEASURE OF ROBUSTNESS.
C              IT PLOTS THE VALUE OF A STATISTIC WHEN ONE ADDITIONAL
C              VALUE IS ADDED.  FOR EXAMPLE,
C                 MEAN INFLUENCE CURVE Y XSEQ
C              CYCLES THROUGH THE POINTS IN XSEQ.  THE VERTICAL
C              AXIS IS THE VALUE OF THE MEAN FOR THE POINTS IN Y
C              WITH THE SINGLE VALUE IN XSEQ ADDED TO Y.
C
C              FOR THIS PLOT, ONLY ONE VARIABLE STATISTICS ARE
C              SUPPORTED (I.E., NO CORRELATION, ETC.).
C
C                 MEAN INFLUENCE CURVE
C                 MIDM INFLUENCE CURVE
C                 MEDI INFLUENCE CURVE
C                 WINSORIZED MEAN INFLUENCE CURVE
C                 BIWEIGHT LOCATION INFLUENCE CURVE
C                 GEOMETRIC MEAN INFLUENCE CURVE
C                 HARMONIC MEAN INFLUENCE CURVE
C                 HODGES LEHMAN INFLUENCE CURVE
C                 SD INFLUENCE CURVE
C                 REL SD INFLUENCE CURVE
C                 SD MEAN INFLUENCE CURVE
C                 TRIMMED MEAN STANDARD ERROR INFLUENCE CURVE
C                 VARI INFLUENCE CURVE
C                 REL VARI INFLUENCE CURVE
C                 VARI MEAN INFLUENCE CURVE
C                 RANG INFLUENCE CURVE
C                 GEOMETRIC STANDARD DEVIATION INFLUENCE CURVE
C                 AAD INFLUENCE CURVE
C                 MAD INFLUENCE CURVE
C                 SN INFLUENCE CURVE
C                 QN INFLUENCE CURVE
C                 INTERQUARTILE RANGE INFLUENCE CURVE
C                 BIWEIGHT SCALE INFLUENCE CURVE
C                 BIWEIGHT MIDVARIANCE INFLUENCE CURVE
C                 PERCENT BEND MIDVARIANCE INFLUENCE CURVE
C                 WINSORIZED VARIANCE INFLUENCE CURVE
C                 WINSORIZED SD INFLUENCE CURVE
C                 MINI INFLUENCE CURVE
C                 MAXI INFLUENCE CURVE
C                 EXTREME INFLUENCE CURVE
C                 SKEW INFLUENCE CURVE
C                 KURT INFLUENCE CURVE
C                 AUCR INFLUENCE CURVE
C                 SDM INFLUENCE CURVE
C                 AUCV INFLUENCE CURVE
C                 RACV INFLUENCE CURVE
C                 LOWH INFLUENCE CURVE
C                 UPPH INFLUENCE CURVE
C                 LOWQ INFLUENCE CURVE
C                 UPPQ INFLUENCE CURVE
C                 TRIM INFLUENCE CURVE
C                 WINM INFLUENCE CURVE
C                 MIDQ INFLUENCE CURVE
C                 PERCENTILE INFLUENCE CURVE
C                 QUANTILE INFLUENCE CURVE
C                 QUANTILE STANDARD ERROR INFLUENCE CURVE
C                 1DEC INFLUENCE CURVE
C                 2DEC INFLUENCE CURVE
C                 3DEC INFLUENCE CURVE
C                 4DEC INFLUENCE CURVE
C                 5DEC INFLUENCE CURVE
C                 6DEC INFLUENCE CURVE
C                 7DEC INFLUENCE CURVE
C                 8DEC INFLUENCE CURVE
C                 9DEC INFLUENCE CURVE
C                 SINE FREQUENCY INFLUENCE CURVE
C                 SINE AMPLITUDE INFLUENCE CURVE
C                 TAGUCHI SIGNAL-TO-NOISE INFLUENCE CURVES
C                 CP INFLUENCE CURVE
C                 CPL INFLUENCE CURVE
C                 CPU INFLUENCE CURVE
C                 CPK INFLUENCE CURVE
C                 CPM INFLUENCE CURVE
C                 CC INFLUENCE CURVE
C                 CNPK INFLUENCE CURVE
C                 PERCENT DEFECTIVE INFLUENCE CURVE
C                 EXPECTED LOSS INFLUENCE CURVE
C                 NORM PPCC INFLUENCE CURVE
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     REFERENCE--MOSTELLER AND TUKEY, "EXPLORATORY DATA ANALYSIS".
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002/7
C     ORIGINAL VERSION--JULY      2002.
C     UPDATED         --AUGUST    2002. USE CMPSTA TO COMPUTE THE
C                                       STATISTIC.
C     UPDATED         --APRIL     2003. ADD SN AND QN.  REQUIRED
C                                       ADDITIONAL SCRATCH ARRAYS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL SUM
      EXTERNAL RANGE
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IQUAME
      CHARACTER*4 IQUASE
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION Z(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION XIDTEM(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
      DIMENSION ITEMP1(*)
      DIMENSION ITEMP2(*)
      DIMENSION ITEMP3(*)
      DIMENSION ITEMP4(*)
      DIMENSION ITEMP5(*)
      DIMENSION ITEMP6(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPIN'
      ISUBN2='C2  '
C
      IWRITE='OFF'
C
      I2=0
      ISIZE2=0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(NY.GE.2)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPINC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)NY
   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
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'INC2')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPINC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IBUGG3,ISUBRO
   71 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)NY,NX,ICASPL,NUMV2,ISIZE,ICONT
   72 FORMAT('NY,NX,ICASPL,NUMV2,ISIZE,ICONT = ',2I8,2X,A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,MAX(NY,NX)
      WRITE(ICOUT,74)I,Y(I)
   74 FORMAT('I, Y(I),X(I) = ',I8,2F15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  SORT THE HORIZONTAL AXIS VARIABLE, EXTRACT        **
C               **  THE DISTINCT VALUES.                              **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'INC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  150 CONTINUE
      IWRITE='OFF'
      CALL SORT(X,NX,X)
      CALL DISTIN(X,NX,IWRITE,X,NXDIST,IBUGG3,IERROR)
C
C               ******************************************
C               **  STEP 2--                            **
C               **  COMPUTE THE SPECIFIED STATISTIC     **
C               **  FOR EACH DISTINCT VALUE OF X ADDED  **
C               **  TO THE Y VARIABLE.                  **
C               ******************************************
C
      ISTEPN='11'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'INC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
C
      DO11000ISET=1,NXDIST
C
      ILAST=NY+1
      DO11011I=1,NY
        TEMP(I)=Y(I)
11011 CONTINUE
      TEMP(ILAST)=X(ISET)
      NS2=ILAST
C
      CALL CMPSTA(
     1TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,MAXNXT,NS2,NS2,NUMV2,ICASPL,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1RIGHT,
     1ISUBRO,IBUGG3,IERROR)
C
C     ---------------------------
C
79000 CONTINUE
      J=J+1
      Y2(J)=RIGHT
      X2(J)=X(ISET)
      D2(J)=1.0
C
11000 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'INC2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPINC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO
 9012 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,NX,NY,N2,IERROR
 9013 FORMAT('ICASPL,NX,NY,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMV2,ISIZE
 9014 FORMAT('NUMV2,ISIZE = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N2
      WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I)
 9021 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPIND2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A INDUCTOR
C              WITH ONE END AT (X1,Y1)
C              AND THE OTHER END AT (X2,Y2).
C     NOTE--THE HEIGHT OF EACH LOOP IS PTEXHE.
C           THE WIDTH  OF EACH LOOP IS PTEXWI.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      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
CCCCC CHARACTER*4 ICOLF
CCCCC CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'IND2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPIND2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE FIGURE             **
C               *********************************
C
      DELX=X2-X1
      DELY=Y2-Y1
      ALEN=0.0
      TERM=(X2-X1)**2+(Y2-Y1)**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      AJXMIN=PTEXWI
      AJXDEL=PTEXWI
      AJYDEL=PTEXHE
      AJXMAX=ALEN-2*AJXDEL
C
      XMIN=AJXMIN
      XDEL=AJXDEL
      YDEL=AJYDEL
      XMAX=AJXMAX
C
      K=0
C
      X=0
      Y=0
      K=K+1
      PX(K)=X1
      PY(K)=Y1
C
      X=XMIN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      AJX=AJXMIN-AJXDEL
CCCCC DO1450JX=JXMIN,JXMAX,JXDEL
 1440 CONTINUE
      AJX=AJX+AJXDEL
      IF(AJX.GT.AJXMAX)GOTO1460
C
      X=AJX
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX3=XP
      AJY3=YP
C
      X=AJX+AJXDEL
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX4=XP
      AJY4=YP
C
CCCCC CALL DPIND3(AJX3,AJY3,AJX4,AJY4,IBUGD2,IERROR)
      CALL DPIND3(AJX3,AJY3,AJX4,AJY4,PX,PY,K,PX3,PY3,NP3,
     1IFIG,IPATT,PTHICK,ICOL)
C
 1450 CONTINUE
      GOTO1440
C
 1460 CONTINUE
C
CCCCC X=XMAX
      X=ALEN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
CCCCC IF(IREFSW(1).EQ.'OFF')GOTO2190
CCCCC IPATT=IREPTY(1)
CCCCC PTHICK=PREPTH(1)
CCCCC PXGAP=PREPSP(1)
CCCCC PYGAP=PREPSP(1)
CCCCC ICOLF=IREFCO(1)
CCCCC ICOLP=IREPCO(1)
CCCCC CALL DPFIRE(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP)CCCCC
C2190 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.'CIR2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCIR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPIND3(X1,Y1,X2,Y2,PX,PY,K,PX3,PY3,NP3,
     1IFIG,IPATT,PTHICK,ICOL)
C
C     PURPOSE--DRAW A SEMI-CIRCLE FOR AN INDUCTOR
C              WITH ONE END OF THE DIAGONAL AT (X1,Y1)
C              AND THE OTHER END AT (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(*)
      DIMENSION PY(*)
C
CCCCC DIMENSION PX3(*)
CCCCC DIMENSION PY3(*)
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.'IND3')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPIND3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)K
   55 FORMAT('K = ',I8)
      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
      DELX=X2-X1
      DELY=Y2-Y1
      ALEN=0.0
      TERM=(X2-X1)**2+(Y2-Y1)**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      R=ALEN/2.0
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      X=0.0
      Y=0.0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO3010I=1,181,5
      IREV=181-I+1
      PHI2=IREV-1
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=R*COS(PHI2)+R
      Y=R*SIN(PHI2)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      IF(K.LE.490)GOTO3010
      NP=K
      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)
      K=0
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
 3010 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'IND3')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPIND3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)K
 9014 FORMAT('K = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,K
      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 DPINDU(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 INDUCTORS
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 2 ENDS
C           OF THE INDUCTOR.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN INDUCTOR WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN INDUCTOR WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN INDUCTOR WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     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
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
      CHARACTER*4 IDCOLO
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.'INDU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPINDU--')
      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='INDU'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPINDU--')
      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 INDUCTOR ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      FROM THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      TO THE POINT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      INDUCTOR 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      INDUCTOR ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPIND2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'INDU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPINDU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPINFU(IFUNC3,N3,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IHLEFT,IHLEF2,ILISTL,NEWNAM,MAXN3,
     1IFUNC,NUMCHF,MAXCHF,IBUGA3,IERROR)
C
C     PURPOSE--INSERT (IF NECESSARY) THE FUNCTION
C              IN IFUNC3(.) INTO THE GENERAL
C              DATAPLOT INTERNAL FUNCTION TABLE IFUNC(.).
C              ALSO, UPDATE INTERNAL DATAPLOT
C              LISTS (IF NECESSARY).
C
C     INPUT  FUNCTION--IN IFUNC3(.)
C     OUTPUT FUNCTION--SOMEWHERE IN IFUNC(.).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1978.
C     UPDATED         --JANUARY   1979.
C     UPDATED         --JULY      1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1993. FIX BUG STATEMENT
C                                       MAXCHF => 120
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IFUNC3
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IFUNC
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
C
      DIMENSION IANS(*)
C
      DIMENSION IFUNC3(*)
      DIMENSION IFUNC(*)
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='DPIN'
      ISUBN2='FU  '
C
      IERROR='NO'
C
      IDEL=0
C
C               ******************************************
C               **  INSERT A FUNCTION                   **
C               **  INTO THE GENERAL DATAPLOT FUNCTION  **
C               **  TABLE IFUNC(.).                     **
C               **  MAKE ADJUSTMENTS TO THE             **
C               **  INTERNAL DATAPLOT LISTS.            **
C               ******************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPINFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMNAM,ILISTL,NEWNAM
   53 FORMAT('NUMNAM,ILISTL,NEWNAM = ',2I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMNAM
      WRITE(ICOUT,56)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
   56 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1I8,2X,A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)N3,NUMCHF,MAXN3,MAXCHF
   57 FORMAT('N3,NUMCHF,MAXN3,MAXCHF = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(N3.GE.1)WRITE(ICOUT,59)(IFUNC3(I),I=1,MIN(N3,120))
   59 FORMAT('IFUNC3(.) = ',120A1)
      IF(N3.GE.1)CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS CHANGED     DECEMBER 1993
CCCCC WRITE(ICOUT,60)(IFUNC(I),I=1,MAXCHF)
      WRITE(ICOUT,60)(IFUNC(I),I=1,MIN(MAXCHF,120))
   60 FORMAT('IFUNC(.)  = ',120A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      NUMCH0=NUMCHF
C
C               *****************************************************
C               **  STEP 2--                                       **
C               **  DETERMINE IF THE ADDITION OF THE NEW FUNCTION  **
C               **  TO THE INTERNAL DATAPLOT TABLE                 **
C               **  WILL OVERFLOW THE TABLE (TYPICALLY             **
C               **  THERE IS A MAXCHF CHARACTER LIMIT                **
C               **  FOR THE SUM TOTAL OVER ALL FUNCTIONS).         **
C               *****************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NEWNAM.EQ.'YES')GOTO2100
      GOTO2200
C
 2100 CONTINUE
      N0TEST=NUMCHF+N3
      GOTO2300
C
 2200 CONTINUE
      IMIN=IVSTAR(ILISTL)
      IMAX=IVSTOP(ILISTL)
      N3OLD=IMAX-IMIN+1
      IDEL=N3-N3OLD
      N0TEST=NUMCHF+IDEL
      GOTO2300
C
 2300 CONTINUE
      IF(N0TEST.LE.MAXCHF)GOTO2390
      WRITE(ICOUT,2301)
 2301 FORMAT('***** ERROR IN DPINFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2302)
 2302 FORMAT('      ERROR CAUSED IN ENTERING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2303)
 2303 FORMAT('      THE FUNCTION INTO THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2304)
 2304 FORMAT('      INTERNAL DATAPLOT FUNCTION TABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2305)
 2305 FORMAT('      THE TOTAL NUMBER OF CHARACTERS IN THAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2306)MAXCHF
 2306 FORMAT('      TABLE (FOR ALL FUNCTIONS) MAY NOT EXCEED ',
     1I8,'.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2307)
 2307 FORMAT('      SUCH AN OVERFLOW CONDITION HAS JUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2308)
 2308 FORMAT('      BEEN ENCOUNTERED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2309)
 2309 FORMAT('      THE FUNCTION TABLE HAS BEEN RESET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2310)
 2310 FORMAT('      TO  ITS STATUS BEFORE THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('      LAST FUNCTION WAS ATTEMPTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      TO BE ENTERED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2313)
 2313 FORMAT('      THE TOTAL NUMBER OF CHARACTERS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      IN THE FUNCTION TABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)NUMCHF
 2315 FORMAT('      HAS BEEN RESET TO ITS PREVIOUS VALUE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('      THE NUMBER OF CHARACTERS IN THE FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2317)N3
 2317 FORMAT('      THAT WAS ATTEMPTED TO BE ENTERED = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2318)
 2318 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2319)(IANS(I),I=1,MIN(IWIDTH,100))
 2319 FORMAT('      ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2321)
 2321 FORMAT('      SUGGESTED POSSIBLE SOLUTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2322)
 2322 FORMAT('      REDEFINE SOME OF THE OTHER ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2323)
 2323 FORMAT('      ALREADY-DEFINED FUNCTIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2324)
 2324 FORMAT('      THAT MAY NO LONGER BE NEEDED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2325)
 2325 FORMAT('      SO THAT THEY ARE ONLY 1 CHARACTER LONG')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2326)
 2326 FORMAT('      EXAMPLE--LET FUNCTION F3=C')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2390 CONTINUE
C
C               ***************************************************
C               **  STEP 3--                                     **
C               **  MOVE THE SEGMENT OF THE STRING IN IFUNC(.)   **
C               **  WHICH IS BEYOND THE FUNCTION OF INTEREST     **
C               **  OVER AN APPROPRIATE NUMBER OF SPACES.        **
C               ***************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NEWNAM.EQ.'YES')GOTO3110
      GOTO3120
C
 3110 CONTINUE
      ISTART=NUMCHF+1
      ISTOP=ISTART+N3-1
      GOTO3190
C
 3120 CONTINUE
      ISTART=IVSTAR(ILISTL)
      ISTOP=ISTART+N3-1
      GOTO3190
C
 3190 CONTINUE
C
      IF(NEWNAM.EQ.'YES')GOTO3290
      KMIN=ISTOP+1
      KMAX=NUMCHF+IDEL
C
      IF(IDEL.EQ.0)GOTO3290
      IF(IDEL.GT.0)GOTO3210
      IF(IDEL.LT.0)GOTO3220
C
 3210 CONTINUE
      DO3215K=KMIN,KMAX
      KREV=KMAX-K+KMIN
      LREV=KREV-IDEL
      IFUNC(KREV)=IFUNC(LREV)
 3215 CONTINUE
      GOTO3290
C
 3220 CONTINUE
      DO3225K=KMIN,KMAX
      L=K-IDEL
      IFUNC(K)=IFUNC(L)
 3225 CONTINUE
C
 3290 CONTINUE
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  MOVE THE NEW FUNCTION INTO THE APPROPRIATE  **
C               **  PLACE IN IFUNC(.).                          **
C               **************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      L=0
      DO4200K=ISTART,ISTOP
      L=L+1
      IFUNC(K)=IFUNC3(L)
 4200 CONTINUE
 4290 CONTINUE
C
C               ************************************
C               **  STEP 5--                      **
C               **  REDEFINE NUMCHF = THE UPDATED **
C               **  LENGTH OF IFUNC(.).           **
C               ************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMCHF=N0TEST
C
C               *************************************************
C               **  STEP 6--                                   **
C               **  MAKE THE ADJUSTMENTS TO THE INTERNAL LIST  **
C               *************************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NEWNAM.EQ.'YES')GOTO6100
      GOTO6200
C
 6100 CONTINUE
      IHNAME(ILISTL)=IHLEFT
      IHNAM2(ILISTL)=IHLEF2
      IUSE(ILISTL)='F'
      IVSTAR(ILISTL)=ISTART
      IVSTOP(ILISTL)=ISTOP
      NUMNAM=NUMNAM+1
      GOTO9000
C
 6200 CONTINUE
      N3OLD=IVSTOP(ILISTL)-IVSTAR(ILISTL)+1
      IDEL=N3-N3OLD
C
      DO6210I=1,NUMNAM
      IF(IUSE(I).EQ.'F')GOTO6220
      GOTO6210
 6220 CONTINUE
      IF(IVSTAR(I).GT.ISTART)IVSTAR(I)=IVSTAR(I)+IDEL
      IF(IVSTOP(I).GE.ISTART)IVSTOP(I)=IVSTOP(I)+IDEL
 6210 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPINFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3
 9012 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NEWNAM,NUMNAM
 9013 FORMAT('NEWNAM,NUMNAM = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMNAM
      WRITE(ICOUT,9016)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
 9016 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1I8,2X,A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)NUMCH0
 9017 FORMAT('NUMCH0 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)N3,NUMCHF,MAXN3,MAXCHF
 9018 FORMAT('N3,NUMCHF,MAXN3,MAXCHF = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)(IFUNC3(I),I=1,MIN(N3,120))
 9019 FORMAT('IFUNC3(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS CHANGED     DECEMBER 1993
CCCCC WRITE(ICOUT,9020)(IFUNC(I),I=1,MAXCHF)
      WRITE(ICOUT,9020)(IFUNC(I),I=1,MIN(MAXCHF,120))
 9020 FORMAT('IFUNC(.)  = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IERROR
 9021 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPINLE(ILEGN2,ISTH,N2,ILEGNA,ILEGST,ILEGSP,
     1NUMLEG,MAXLEG,ILEGTE,NCLEG,MXCLEG,IANS,IWIDTH,IBUGIL,IERROR)
C
C     PURPOSE--INSERT(IF NECESSARY) THE HOLLERITH LEGEND
C              IN ISTH(.)
C              INTO (RESPECTIVELY) THE PACKED
C              INTERNAL DATAPLOT TABLES ILEGTE(.)
C              ALSO, UPDATE INTERNAL DATAPLOT LISTS
C              ILEGNA(.), ILEGST(.), AND ILEGSP(.).
C              A CHECK FOR N2 BEING POSITIVE IS DONE HEREIN.
C
C     NOTE--IT IS ASSUMED IN ALL CASES (EVEN FOR
C           A BLANKED-OUT LEGEND) THAT THE NUMBER
C           OF CHARACTERS IN THE LEGEND IS AT LEAST 1;
C           (THAT IS, THE INPUT N2 IS 1 OR LARGER).
C
C     INPUT  LEGENDS --IN ISTH(.)
C     OUTPUT LEGENDS --SOMEWHERE IN ILEGTE(.)
C
C     ILEGN2 = NAME FOR THE INPUT LEGEND.
C     ISTH   = VECTOR CONTAINING INPUT LEGEND STRING (IN HOLLERITH)
C     N2     = LENGTH OF INPUT LEGEND STRING.
C     ILEGNA = TABLE OF EXISTING LEGEND NAMES.
C     ILEGST = TABLE OF EXISTING START POSITIONS IN ILEGTE.
C     ILEGSP = TABLE OF EXISTING STOP  POSITIONS IN ILEGTE.
C     NUMLEG = NUMBER OF EXISTING LEGENDS.
C     MAXLEG = MAXIMUM NUMBER OF ALLOWABLE LEGENDS.
C     ILEGTE  = VECTOR OF PACKED LEGENDS (HOLLERITH) WHERE FINAL STORAGE IS DONE
C     NCLEG = NUMBER OF PACKED CHARACTERS IN ILEGTE(.)
C     MXCLEG = MAX NUMBER OF ALLOWABLE CHARACTERS IN ILEGTE(.)
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--MARCH     1979.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1994.  BUG FIX
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ILEGN2
      CHARACTER*4 ISTH
      CHARACTER*4 ILEGNA
      CHARACTER*4 ILEGTE
      CHARACTER*4 IANS
      CHARACTER*4 IBUGIL
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION ISTH(*)
      DIMENSION ILEGNA(*)
      DIMENSION ILEGST(*)
      DIMENSION ILEGSP(*)
      DIMENSION ILEGTE(*)
      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='DPIN'
      ISUBN2='LE  '
C
      ILISTL=0
      IDEL=0
C
      NEWNAM='UNKN'
C
C               ******************************************
C               **  INSERT A LEGEND                     **
C               **  INTO THE GENERAL DATAPLOT LEGEND    **
C               **  TABLES ILEGTE(.)        **
C               **  MAKE ADJUSTMENTS TO THE             **
C               **  INTERNAL DATAPLOT LISTS.            **
C               ******************************************
C
      IF(IBUGIL.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPINLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ILEGN2,N2
   72 FORMAT('ILEGN2,N2 = ',A4,3X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)(ISTH(I),I=1,N2)
   73 FORMAT('ISTH(.) = ',55A2)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)NCLEG,MXCLEG
   75 FORMAT('NCLEG,MXCLEG = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)(ILEGTE(I),I=1,NCLEG)
   76 FORMAT('ILEGTE(.) = ',55A2)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)NUMLEG,MAXLEG
   81 FORMAT('NUMLEG,MAXLEG = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO82I=1,NUMLEG
      WRITE(ICOUT,83)I,ILEGNA(I),ILEGST(I),ILEGSP(I)
   83 FORMAT('I,ILEGNA(I),ILEGST(I),ILEGSP(I) = ',I4,3X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
   82 CONTINUE
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGIL.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      NUMCH0=NCLEG
C
      IF(N2.GE.1)GOTO190
C
      WRITE(ICOUT,111)
  111 FORMAT('***** INTERNAL ERROR IN DPLEG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('      THE INPUT LENGTH N2 OF THE STRING IS ',
     1'NON-POSITIVE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)N2
  113 FORMAT('      N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  190 CONTINUE
C
C               ************************************
C               **  STEP 2--                      **
C               **  DETERMINE IF THE LEGEND NAME  **
C               **  ALREADY EXISTS IN THE TABLE.  **
C               ************************************
C
      ISTEPN='2'
      IF(IBUGIL.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='YES'
      IF(NUMLEG.LE.0)GOTO250
      DO210I=1,NUMLEG
      I2=I
      IF(ILEGN2.EQ.ILEGNA(I))GOTO220
  210 CONTINUE
      GOTO250
C
  220 CONTINUE
      NEWNAM='NO'
      ILISTL=I2
      GOTO290
C
  250 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMLEG+1
      GOTO290
C
  290 CONTINUE
C
C               ***********************************************************
C               **  STEP 3--                                             **
C               **  FOR THE CASE WHEN HAVE A NEW NAME,                   **
C               **  DETERMINE IF THIS NEW NAME                           **
C               **  WILL OVERFLOW THE ALLOWABLE NUMBER OF LEGEND NAMES   **
C               **   IN TABLE ILEGNA(.).                                 **
C               ***********************************************************
C
      ISTEPN='3'
      IF(IBUGIL.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NEWNAM.EQ.'NO')GOTO390
      IF(ILISTL.LE.MAXLEG)GOTO390
C
      WRITE(ICOUT,301)
  301 FORMAT('***** ERROR IN DPINLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,302)
  302 FORMAT('      ERROR CAUSED IN ENTERING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,303)
  303 FORMAT('      THE LEGEND   INTO THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,304)
  304 FORMAT('      INTERNAL DATAPLOT LEGEND   TABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,305)
  305 FORMAT('      THE TOTAL NUMBER OF LEGENDS IN THAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,306)MAXLEG
  306 FORMAT('      TABLE (FOR ALL LEGENDS) MAY NOT EXCEED ',
     1I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,307)
  307 FORMAT('      SUCH AN OVERFLOW CONDITION HAS JUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,308)
  308 FORMAT('      BEEN ENCOUNTERED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,309)
  309 FORMAT('      THE LEGEND   TABLE HAS JUST BEEN RESET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,310)
  310 FORMAT('      TO  ITS STATUS BEFORE THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('      LAST LEGEND   WAS ATTEMPTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      TO BE ENTERED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      THE TOTAL NUMBER OF LEGENDS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      IN THE LEGEND   TABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)NUMLEG
  315 FORMAT('      HAS JUST BEEN RESET TO ITS PREVIOUS VALUE =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,318)
  318 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,319)(IANS(I),I=1,IWIDTH)
  319 FORMAT('      ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('      SUGGESTED POSSIBLE SOLUTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      REDEFINE SOME OF THE OTHER ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)
  323 FORMAT('      ALREADY-DEFINED LEGENDS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      THAT MAY NO LONGER BE NEEDED.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  390 CONTINUE
C
C               *****************************************************
C               **  STEP 4--                                       **
C               **  DETERMINE IF THE ADDITION OF THE NEW LEGEND    **
C               **  STRING TO THE INTERNAL DATAPLOT TABLES         **
C               **  ILEGTE(.)                                  **
C               **  WILL OVERFLOW THE TABLE (TYPICALLY             **
C               **  THERE IS A 500 CHARACTER LIMIT                 **
C               **  FOR THE SUM TOTAL OVER ALL LEGENDS).           **
C               *****************************************************
C
      ISTEPN='4'
      IF(IBUGIL.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NEWNAM.EQ.'YES')GOTO2100
      GOTO2200
C
 2100 CONTINUE
      N0TEST=NCLEG+N2
      GOTO2300
C
 2200 CONTINUE
      IMIN=ILEGST(ILISTL)
      IMAX=ILEGSP(ILISTL)
      N2OLD=IMAX-IMIN+1
      IDEL=N2-N2OLD
      N0TEST=NCLEG+IDEL
      GOTO2300
C
 2300 CONTINUE
      IF(N0TEST.LE.MXCLEG)GOTO2390
      WRITE(ICOUT,2301)
 2301 FORMAT('***** ERROR IN DPINLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2302)
 2302 FORMAT('      ERROR CAUSED IN ENTERING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2303)
 2303 FORMAT('      THE LEGEND   INTO THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2304)
 2304 FORMAT('      INTERNAL DATAPLOT LEGEND   TABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2305)
 2305 FORMAT('      THE TOTAL NUMBER OF CHARACTERS IN THAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2306)MXCLEG
 2306 FORMAT('      TABLE (FOR ALL LEGEND  S) MAY NOT EXCEED ',
     1I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2307)
 2307 FORMAT('      SUCH AN OVERFLOW CONDITION HAS JUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2308)
 2308 FORMAT('      BEEN ENCOUNTERED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2309)
 2309 FORMAT('      THE LEGEND   TABLE HAS JUST BEEN RESET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2310)
 2310 FORMAT('      TO  ITS STATUS BEFORE THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('      LAST LEGEND   WAS ATTEMPTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      TO BE ENTERED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2313)
 2313 FORMAT('      THE TOTAL NUMBER OF CHARACTERS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      IN THE LEGEND   TABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)NCLEG
 2315 FORMAT('      HAS JUST BEEN RESET TO ITS PREVIOUS VALUE =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('      THE NUMBER OF CHARACTERS IN THE LEGEND  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2317)N2
 2317 FORMAT('      THAT WAS ATTEMPTED TO BE ENTERED = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2318)
 2318 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2319)(IANS(I),I=1,IWIDTH)
 2319 FORMAT('      ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2321)
 2321 FORMAT('      SUGGESTED POSSIBLE SOLUTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2322)
 2322 FORMAT('      REDEFINE (SHORTEN) SOME OF THE OTHER ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2323)
 2323 FORMAT('      ALREADY-DEFINED LEGENDS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2324)
 2324 FORMAT('      THAT MAY NO LONGER BE NEEDED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2325)
 2325 FORMAT('      SO THAT THEY ARE ONLY 1 CHARACTER LONG')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2326)
 2326 FORMAT('      EXAMPLE--LEGEND 4    ')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2390 CONTINUE
C
C               ***************************************************
C               **  STEP 5--                                     **
C               **  MOVE THE SEGMENT OF THE STRING IN ILEGTE(.)   **
C               **  WHICH IS BEYOND THE LEGEND   OF INTEREST     **
C               **  OVER AN APPROPRIATE NUMBER OF SPACES.        **
C               ***************************************************
C
      ISTEPN='5'
      IF(IBUGIL.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NEWNAM.EQ.'YES')GOTO3110
      GOTO3120
C
 3110 CONTINUE
      ISTART=NCLEG+1
      ISTOP=ISTART+N2-1
      GOTO3190
C
 3120 CONTINUE
      ISTART=ILEGST(ILISTL)
      ISTOP=ISTART+N2-1
      GOTO3190
C
 3190 CONTINUE
C
      IF(NEWNAM.EQ.'YES')GOTO3290
      KMIN=ISTOP+1
      KMAX=NCLEG+IDEL
CCCCC JUNE 1994.  FOLLOWING LINE CAUSED SPURIOUS CHARACTERS IF 
CCCCC HIGHER LEGENDS BLANKED OUT, EARLIER LEGEND LONGER THAN THE
CCCCC ORIGINAL.
CCCCC IF(KMIN.GT.NCLEG)GOTO3290
      IF(IDEL.LE.0)GOTO3210
      GOTO3220
C
 3210 CONTINUE
      NCLEGP=NCLEG+1
      DO3211K=KMIN,KMAX
      L=K-IDEL
      IF(L.GE.NCLEGP)GOTO3211
      ILEGTE(K)=ILEGTE(L)
 3211 CONTINUE
      GOTO3290
C
 3220 CONTINUE
      DO3221K=KMIN,KMAX
      KREV=KMAX-K+KMIN
      L=KREV-IDEL
      IF(L.LE.0)GOTO3221
      ILEGTE(KREV)=ILEGTE(L)
 3221 CONTINUE
      GOTO3290
C
 3290 CONTINUE
C
C               **************************************************
C               **  STEP 6--                                    **
C               **  MOVE THE NEW LEGEND   INTO THE APPROPRIATE  **
C               **  PLACE IN ILEGTE(.).                          **
C               **************************************************
C
      ISTEPN='6'
      IF(IBUGIL.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      L=0
      DO4200K=ISTART,ISTOP
      L=L+1
      ILEGTE(K)=ISTH(L)
 4200 CONTINUE
 4290 CONTINUE
C
C               ************************************
C               **  STEP 7--                      **
C               **  REDEFINE NCLEG = THE UPDATED **
C               **  LENGTH OF ILEGTE(.).           **
C               ************************************
C
      ISTEPN='7'
      IF(IBUGIL.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NCLEG=N0TEST
C
C               *************************************************
C               **  STEP 8--                                   **
C               **  MAKE THE ADJUSTMENTS TO THE INTERNAL LIST  **
C               *************************************************
C
      ISTEPN='8'
      IF(IBUGIL.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NEWNAM.EQ.'YES')GOTO6100
      GOTO6200
C
 6100 CONTINUE
      ILEGNA(ILISTL)=ILEGN2
      ILEGST(ILISTL)=ISTART
      ILEGSP(ILISTL)=ISTOP
      NUMLEG=NUMLEG+1
      GOTO9000
C
 6200 CONTINUE
      N2OLD=ILEGSP(ILISTL)-ILEGST(ILISTL)+1
      IDEL=N2-N2OLD
C
      DO6210I=1,NUMLEG
      IF(ILEGST(I).GT.ISTART)ILEGST(I)=ILEGST(I)+IDEL
      IF(ILEGSP(I).GE.ISTART)ILEGSP(I)=ILEGSP(I)+IDEL
 6210 CONTINUE
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
C
      ISTEPN='9'
      IF(IBUGIL.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGIL.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF DPINLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N2,N2OLD,IDEL,KMIN,KMAX
 9012 FORMAT('N2,N2OLD,IDEL,KMIN,KMAX = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NCLEG,MXCLEG,NUMCH0
 9013 FORMAT('NCLEG,MXCLEG,NUMCH0 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(ILEGTE(I),I=1,NCLEG)
 9014 FORMAT('ILEGTE(.) = ',55A2)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NEWNAM,ILISTL,NUMLEG
 9015 FORMAT('NEWNAM,ILISTL,NUMLEG = ',A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NEWNAM,NUMLEG
 9021 FORMAT('NEWNAM,NUMLEG = ',A4,3X,I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,NUMLEG
      WRITE(ICOUT,9023)I,ILEGNA(I),ILEGST(I),ILEGSP(I)
 9023 FORMAT('I,ILEGNA(I),ILEGST(I),ILEGSP(I) = ',I4,3X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPINPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1MAXNPP,
     1IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--FORM AN INTERACTION PLOT, I.E.
C              INTERACTION PLOT Y X1 X2 
C              IS A PLOT OF Y VERSUS X1*X2
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/10
C     ORIGINAL VERSION--OCTOBER   1999.
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 ICASEQ
      CHARACTER*4 IERRO4
C
      PARAMETER(MAXY=25)
C
      DIMENSION IVARN1(MAXY)
      DIMENSION IVARN2(MAXY)
      DIMENSION ILIS(MAXY)
      DIMENSION ICOL(MAXY)
C
CCCCC CHARACTER*4 IH11
CCCCC CHARACTER*4 IH12
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
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='DPIN'
      ISUBN2='PL  '
      IFOUND='YES'
      IAND2='NO'
      ICASPL='INTE'
      IBUGG2=IBUGG3
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
 1000 CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'INPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPINPL--')
      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'.OR.ISUBRO.EQ.'INPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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.'INPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINN2=2
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 11--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INPL')
     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.'ON'.OR.ISUBRO.EQ.'INPL')THEN
        WRITE(ICOUT,1191)NUMARG,ILOCQ,ICASEQ
 1191   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **  IF THE   TO   FEATURE IS USED IN THE        **
C               **  ARGUMENT LIST, TRANSLATE THE   TO   TO      **
C               **  EXPLICIT VARIABLE NAMES                     **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=ILOCQ-1
      IF(JMAX.GT.NUMARG)JMAX=NUMARG
      CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXY,
     1IHNAME,IHNAM2,IUSE,NUMNAM,
     1IVARN1,IVARN2,NUMVAR,IBUGG3,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
 1290 CONTINUE
C
C               ***************************************
C               **  STEP 13--                        **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               **  ALSO CHECK TO ASSURE THAT EACH   **
C               **  OF THE VARIABLES HAS AT LEAST    **
C               **  2 OBSERVATIONS.                  **
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFLAG=0
      DO1300I=1,NUMVAR
C
      IHRIGH=IVARN1(I)
      IHRIG2=IVARN2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      NRIGHT=IN(ILOCV)
      IF(I.EQ.1)THEN
        NTEMP=NRIGHT
      ELSE
        IF(NRIGHT.NE.NTEMP)IFLAG=1
      ENDIF
      ILIS(I)=ILOCV
      ICOL(I)=IVALUE(ILOCV)
      IF(NRIGHT.GE.MINN2)GOTO1390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPSPMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH AN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('      INTERACTION PLOT WAS TO HAVE BEEN FORMED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)MINN2
 1326 FORMAT('      MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE CASE',
     1' HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1328)
 1328 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1329)(IANS(J),J=1,MIN(IWIDTH,100))
 1329 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1390 CONTINUE
C
 1300 CONTINUE
C
C
C               ******************************************************
C               **  STEP 1.4--                                      **
C               **  CHECK THAT VARIABLES HAVE THE SAME NUMBER OF    **
C               **  ELEMENTS.                                       **
C               ******************************************************
C
 1400 CONTINUE
      ISTEPN='1.4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'INPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFLAG.EQ.0)GOTO1490
C
 1410 CONTINUE
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPINPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      THE NUMBER OF OBSERVATIONS IN ALL VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
 1414 FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      DO1417I=1,NUMVAR
      I2=ILIS(I)
      WRITE(ICOUT,1416)IVARN1(I2),IVARN2(I2),IN(I2)
 1416 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
 1417 CONTINUE
      WRITE(ICOUT,1420)
 1420 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1421)(IANS(I),I=1,MIN(IWIDTH,100))
 1421 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               *********************************************
C               **  STEP 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'.OR.ISUBRO.EQ.'INPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NRIGHT
      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
      NS=1
      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
      IF(NS.GT.NIOLD)NS=NIOLD
      GOTO1350
C
 1350 CONTINUE
C
C               *******************************************************
C               **  STEP 16--                                        **
C               **  FORM THE PLOT COORIDINATES                       **
C               *******************************************************
C
      ISTEPN='15.2'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 1519 CONTINUE
C
      L=0
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 DPINPL--')
      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
      IVAV=ICOL(1)
      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)=1.0
C
      IF(NUMVAR.LT.2)GOTO1520
      DO1530K=2,NUMVAR
      IVAV=ICOL(K)
      IJ=MAXN*(IVAV-1)+I
      IF(IVAV.LE.MAXCOL)ATEMP=V(IJ)
      IF(IVAV.EQ.MAXCP1)ATEMP=PRED(I)
      IF(IVAV.EQ.MAXCP2)ATEMP=RES(I)
      IF(IVAV.EQ.MAXCP3)ATEMP=YPLOT(I)
      IF(IVAV.EQ.MAXCP4)ATEMP=XPLOT(I)
      IF(IVAV.EQ.MAXCP5)ATEMP=X2PLOT(I)
      IF(IVAV.EQ.MAXCP6)ATEMP=TAGPLO(I)
      X(L)=X(L)*ATEMP
 1530 CONTINUE
C
      D(L)=1.0
      NPLOTP=L
C
 1520 CONTINUE
      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 DPINPL--')
      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,NLOCAL,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NLOCAL,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 DPINT2(MODEL,NUMCHA,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IVARN,IVARN2,NUMVAR,XMIN,XMAX,XINT,
     1IBUGA3,IBUGCO,IBUGEV,IERROR)
C
C     PURPOSE--COMPUTE THE INTEGRAL OF A FUNCTION
C              FROM THE LIMITS XMIN TO XMAX.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-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--NOVEMBER  1978.
C     UPDATED         --JULY      1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 MODEL
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IVARN
      CHARACTER*4 IVARN2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION W,Z
      DOUBLE PRECISION DMIN,DMAX,DNUMSE,DINT,DJ,DELTA2,DMIN2,DMAX2
      DOUBLE PRECISION DB0,DB1,DSUM2,DX,DY,DINT2
C
      DIMENSION MODEL(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
      DIMENSION IVARN(*)
      DIMENSION IVARN2(*)
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION ILOCV(10)
C
      DIMENSION W(16)
      DIMENSION Z(16)
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 Z(1),Z(2),Z(3),Z(4),Z(5),Z(6),Z(7),Z(8)
     1                   /-0.98940093499165D0,-0.944575023073233D0,
     1-0.865631202387832D0,-0.755404408355003D0,-0.617876244402644D0,
     1-0.458016777657227D0,-0.281603550779259D0,-0.095012509837637D0/
      DATA Z(9),Z(10),Z(11),Z(12),Z(13),Z(14),Z(15),Z(16)
     1/0.095012509837637D0,0.281603550779259D0,0.458016777657227D0,
     10.617876244402644D0,0.755404408355003D0,0.865631202387832D0,
     10.944575023073233D0,0.989400934991650D0/
      DATA W(1),W(2),W(3),W(4),W(5),W(6),W(7),W(8)
     1                  /0.027152459411754D0,0.062253523938648D0,
     10.095158511682493D0,0.124628971255534D0,0.149595988816577D0,
     10.169156519395003D0,0.182603415044924D0,0.189450610455069D0/
      DATA W(9),W(10),W(11),W(12),W(13),W(14),W(15),W(16)
     1/0.189450610455069D0,0.182603415044924D0,0.169156519395003D0,
     10.149595988816577D0,0.124628971255534D0,0.095158511682493D0,
     10.062253523938648D0,0.027152459411754D0/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPIN'
      ISUBN2='T2  '
C
      CUTOFF=0.001
      ACCUR=0.0000001
      MAXSEG=20
      IPASS=2
C
      J2=0
C
      ABSXIN=0.0
      XINT2=0.0
      DIFF=0.0
      RATIO=0.0
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPINT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGCO,IBUGEV
   52 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMCHA,NUMPV,NUMVAR
   53 FORMAT('NUMCHA,NUMPV,NUMVAR, = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(MODEL(J),J=1,NUMCHA)
   54 FORMAT('MODEL(I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMPV
      WRITE(ICOUT,56)I,PARAM(I),IPARN(I),IPARN2(I)
   56 FORMAT('I,PARAM(I),IPARN(I),IPARN2(I) = ',I8,E15.7,A4,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)IANGLU
   57 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO60I=1,NUMVAR
      WRITE(ICOUT,61)I,IVARN(I),IVARN2(I)
   61 FORMAT('I, IVARN(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
      WRITE(ICOUT,62)XMIN,XMAX
   62 FORMAT('XMIN, XMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************************************
C               **  STEP 1--                                     **
C               **  DETERMINE THE LOCATIONS (IN THE LIST IPARN)  **
C               **  OF THE VARIABLES OF INTEGRATION.             **
C               ***************************************************
C
      DO100I=1,NUMVAR
      IH=IVARN(I)
      IH2=IVARN2(I)
      DO200J=1,NUMPV
      J2=J
      IF(IH.EQ.IPARN(J).AND.IH2.EQ.IPARN2(J))GOTO210
  200 CONTINUE
  210 CONTINUE
      ILOCV(I)=J2
  100 CONTINUE
C
C               **************************************************
C               **  STEP 2--                                    **
C               **  WRITE OUT  PRELIMINARY SUMMARY INFORMATION  **
C               **************************************************
C
      IF(IPRINT.EQ.'OFF')GOTO409
      IF(IFEEDB.EQ.'OFF')GOTO409
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,401)
  401 FORMAT('INTEGRAL EVALUATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,402)(MODEL(I),I=1,NUMCHA)
  402 FORMAT('      FUNCTION--',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,403)XMIN
  403 FORMAT('      SPECIFIED LOWER LIMIT OF INTEGRAL  = ',F20.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,404)XMAX
  404 FORMAT('      SPECIFIED UPPER LIMIT OF INTEGRAL  = ',F20.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,405)NUMVAR
  405 FORMAT('      NUMBER OF VARIABLES OF INTEGRATION = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,406)
  406 FORMAT('NUMBER OF    *       VALUE OF        ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,407)
  407 FORMAT('PARTITIONS   *       INTEGRAL      ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,408)
  408 FORMAT('-------------*--------------------')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
  409 CONTINUE
C
C               ***********************************************
C               **  STEP 3--                                 **
C               **  STEP THROUGH 10 DIFFERENT SEGMENTATIONS  **
C               **  OF THE DOMAIN OF THE INTEGRAL.           **
C               ***********************************************
C
 3000 CONTINUE
      DMIN=XMIN
      DMAX=XMAX
      DO3100NUMSEG=1,MAXSEG
C
C               ****************************************************
C               **  STEP 4--                                      **
C               **  WITHIN A GIVEN SEGMENTATION,                  **
C               **  APPLY THE 16-POINT GAUSSIAN QUADRATURE RULE.  **
C               ****************************************************
C
      DNUMSE=NUMSEG
      DELTA2=(DMAX-DMIN)/DNUMSE
      DINT=0.0D0
      DO3200J=1,NUMSEG
      DJ=J
      DMIN2=DMIN+(DJ-1.0D0)*DELTA2
      DMAX2=DMIN+DJ*DELTA2
      DB1=(DMAX2-DMIN2)/2.0D0
      DB0=(DMAX2+DMIN2)/2.0D0
C
      DSUM2=0.0D0
      DO3300I=1,16
      DX=DB0+DB1*Z(I)
      X=DX
      DO3400K=1,NUMVAR
      JLOC=ILOCV(K)
      PARAM(JLOC)=X
 3400 CONTINUE
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,Y,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3402)X,Y
 3402 FORMAT('X,Y = ',2E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      DY=Y
      DSUM2=DSUM2+W(I)*DY
 3300 CONTINUE
      DINT2=DB1*DSUM2
      DINT=DINT+DINT2
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3311)NUMSEG,J,DSUM2,DB0,DB1,DINT2
 3311 FORMAT('NUMSEG,J,DSUM2,DB0,DB1,DINT2=',2I3,4D12.5)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ******************************
C               **  STEP 5--                **
C               **  WRITE OUT THE INTEGRAL  **
C               ******************************
C
 3200 CONTINUE
      XINT=DINT
      IF(IPRINT.EQ.'OFF')GOTO3109
      IF(IFEEDB.EQ.'OFF')GOTO3109
      WRITE(ICOUT,3103)NUMSEG,XINT
 3103 FORMAT(I8,'     * ',E15.7)
      CALL DPWRST('XXX','BUG ')
 3109 CONTINUE
C
      IF(NUMSEG.EQ.1)GOTO3150
      ABSXIN=ABS(XINT)
      DIFF=ABS(XINT-XINT2)
      IF(ABSXIN.LE.CUTOFF.AND.DIFF.LE.ACCUR)GOTO3500
      IF(ABSXIN.LE.CUTOFF.AND.DIFF.GT.ACCUR)GOTO3150
      RATIO=ABS(DIFF/XINT)
      IF(ABSXIN.GT.CUTOFF.AND.RATIO.LE.ACCUR)GOTO3500
      IF(ABSXIN.GT.CUTOFF.AND.RATIO.GT.ACCUR)GOTO3150
 3150 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3155)CUTOFF,ACCUR,DIFF,RATIO,ABSXIN
 3155 FORMAT('CUTOFF,ACCUR,DIFF,RATIO,ABSXIN = ',5E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      XINT2=XINT
C
 3100 CONTINUE
C
 3500 CONTINUE
      IF(IPRINT.EQ.'OFF')GOTO3519
      IF(IFEEDB.EQ.'OFF')GOTO3519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3511)XINT
 3511 FORMAT('INTEGRAL VALUE        = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 3519 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPINT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)CUTOFF,ACCUR,DIFF,RATIO,ABSXIN
 9012 FORMAT('CUTOFF,ACCUR,DIFF,RATIO,ABSXIN = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)XMIN,XMAX,XINT
 9013 FORMAT('XMIN,XMAX,XINT = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IERROR
 9014 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPINTE(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IERROR)
C
C     PURPOSE--TREAT THE LET CASE FOR
C              FINDING THE DEFINITE INTEGRAL OF AN FUNCTION.
C     EXAMPLE--LET A = INTEGRAL X**3+2*X**2-4*X+5 FOR X = 1 3
C            --LET X = INTEGRAL F1 FOR X = 0 B
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-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--NOVEMBER  1978.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1989.  FIX AJUNK & BJUNK DIMENSIONS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 IHOUT
      CHARACTER*4 IHOUT2
      CHARACTER*4 IUOUT
      CHARACTER*4 IDUMV
      CHARACTER*4 IDUMV2
      CHARACTER*4 IHPARN
      CHARACTER*4 IHPAR2
      CHARACTER*4 IHL
      CHARACTER*4 IHL2
      CHARACTER*4 IWD1
      CHARACTER*4 IWD2
      CHARACTER*4 IWD12
      CHARACTER*4 IWD22
      CHARACTER*4 ILAB
      CHARACTER*4 IKEY
      CHARACTER*4 IKEY2
      CHARACTER*4 INCLUN
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEL
      CHARACTER*4 IFOUND
      CHARACTER*4 IFOUN1
      CHARACTER*4 IFOUN2
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IOLD
      CHARACTER*4 IOLD2
      CHARACTER*4 INEW
      CHARACTER*4 INEW2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IA(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
C
      DIMENSION IDUMV(100)
      DIMENSION IDUMV2(100)
C
      DIMENSION ILAB(10)
      DIMENSION IOLD(10)
      DIMENSION IOLD2(10)
      DIMENSION INEW(10)
      DIMENSION INEW2(10)
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1989
      DIMENSION BJUNK(1)
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='DPIN'
      ISUBN2='TE  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      ILOCMX=0
      NUMLIM=0
      ILOC3=0
      IP=0
      IV=0
      LOCDUM=0
C
      IHLEFT='UNKN'
      IHLEF2='UNKN'
C
C               *******************************************
C               **  TREAT THE DEFINITE INTEGRAL SUBCASE  **
C               **  OF THE LET COMMAND                   **
C               *******************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGCO,IBUGEV
   53 FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGQ
   54 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
CCCCC MAXN4=MAXCHF
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 2--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE NAME     NAME TO LEFT OF = SIGN                     *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               ****************************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      DO2000I=1,NUMNAM
      I2=I
      IF(IHLEFT.EQ.IHNAME(I).AND.IHLEF2.EQ.IHNAM2(I))GOTO2100
 2000 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO2200
      GOTO2900
 2200 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2201)
 2201 FORMAT('***** ERROR IN DPINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2202)
 2202 FORMAT('      THE NUMBER OF VARIABLE, PARAMETER, & FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2203)MAXNAM
 2203 FORMAT('      NAMES HAS JUST EXCEEDED THE ALLOWABLE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2204)
 2204 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2205)
 2205 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2206)
 2206 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2207)
 2207 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2100 CONTINUE
      ILISTL=I2
 2900 CONTINUE
C
C               ***************************************************************
C               **  STEP 3.1--                                               **
C               **  EXTRACT THE RIGHT-SIDE FUNCTIONAL
C               **  EXPRESSION FROM THE INPUT COMMAND LINE                   **
C               **  (STARTING WITH THE FIRST NON-BLANK LOCATION AFTER THE    **
C               **  EQUAL SIGN AND ENDING WITH THE END OF THE LINE           **
C               **  OR WITH THE LAST NON-BLANK CHARACTER BEFORE     WRT  .   **
C               **  PLACE THE FUNCTION IN IFUNC2(.)  .                       **
C               ***************************************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWD1=IHARG(3)
      IWD12=IHARG2(3)
      IWD2='WRT '
      IWD22='    '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3500
C
      IWD1=IHARG(3)
      IWD12=IHARG2(3)
      IWD2='FOR '
      IWD22='    '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3500
C
CCCCC IWD1=IHARG(3)
CCCCC IWD12=IHARG2(3)
CCCCC IWD2='SUBS'
CCCCC IWD22='ET  '
CCCCC CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
CCCCC1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
CCCCC IF(IERROR.EQ.'YES')GOTO9000
CCCCC IF(IFOUND.EQ.'YES')GOTO3500
C
CCCCC IWD1=IHARG(3)
CCCCC IWD12=IHARG2(3)
CCCCC IWD2='EXCE'
CCCCC IWD22='PT  '
CCCCC CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
CCCCC1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
CCCCC IF(IERROR.EQ.'YES')GOTO9000
CCCCC IF(IFOUND.EQ.'YES')GOTO3500
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3101)
 3101 FORMAT('***** ERROR IN DPINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3102)
 3102 FORMAT('      INVALID COMMAND FORM FOR INTEGRATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3103)
 3103 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3104)
 3104 FORMAT('      LET ... = INTEGRAL ... WRT  ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3105)
 3105 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3106)(IANS(I),I=1,IWIDTH)
 3106 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3500 CONTINUE
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  DETERMINE IF THE EXPRESSION HAS ANY FUNCTION NAMES   **
C               **  INBEDDED.  IF SO, REPLACE THE FUNCTION NAMES         **
C               **  BY EACH FUNCTION'S DEFINITION.  DO SO REPEATEDLY     **
C               **  UNTIL ALL FUNCTION REFERENCES HAVE BEEN ANNIHILATED  **
C               **  AND THE EXPRESSION IS LEFT ONLY WITH                 **
C               **  CONSTANTS, PARAMETERS, AND VARIABLES--NO FUNCTIONS.  **
C               **  PLACE THE RESULTING FUNCTIONAL EXPRESSION INTO IFUNC3(.) **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(IBUGA3.EQ.'OFF')GOTO5090
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='INPU'
      ILAB(2)='T FU'
      ILAB(3)='NCTI'
      ILAB(4)='ON  '
      ILAB(5)='    '
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      WRITE(ICOUT,5081)IDUMV(1),IDUMV2(1)
 5081 FORMAT('INTEGRATION VARIABLE  = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
C
 5090 CONTINUE
C
C               *************************************
C               **  STEP 5--                       **
C               **  EXTRACT QUALIFIER INFORMATION. **
C               *************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************************************
C               **  STEP 5.1--                                         **
C               **  DETERMINE THE DUMMY VARIABLE FOR THE INTEGRATION.  **
C               *********************************************************
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IKEY='WRT '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5119
      IDUMV(1)=IHOUT
      IDUMV2(1)=IHOUT2
      NUMDV=1
      GOTO5190
 5119 CONTINUE
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5129
      IDUMV(1)=IHOUT
      IDUMV2(1)=IHOUT2
      NUMDV=1
      GOTO5190
 5129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5181)
 5181 FORMAT('***** ERROR IN DPINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5182)
 5182 FORMAT('      INVALID COMMAND FORM FOR INTEGRATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5183)
 5183 FORMAT('      NO VARIABLE OF INTEGRATION DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5185)
 5185 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5186)
 5186 FORMAT('      LET ... = INTEGRAL ... WRT ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5187)
 5187 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5189)(IANS(I),I=1,IWIDTH)
 5189 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5190 CONTINUE
C
C               **************************************************
C               **  STEP 5.2--                                  **
C               **  DETERMINE THE LIMITS FOR   THE INTEGRATION. **
C               **************************************************
C
      ISTEPN='5.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLIM=0
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=3
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5219
      XMIN=VOUT
      NUMLIM=NUMLIM+1
 5219 CONTINUE
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=4
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5229
      IF(IHOUT.EQ.'TO  '.AND.IHOUT2.EQ.'    ')GOTO5229
      XMAX=VOUT
      ILOCMX=ILOC2
      NUMLIM=NUMLIM+1
 5229 CONTINUE
C
      IF(NUMLIM.GE.2)GOTO5239
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=5
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5239
      XMAX=VOUT
      ILOCMX=ILOC2
      NUMLIM=NUMLIM+1
 5239 CONTINUE
C
      IF(NUMLIM.GE.2)GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5281)
 5281 FORMAT('***** ERROR IN DPINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5282)
 5282 FORMAT('      INVALID COMMAND FORM FOR INTEGRATION.')
      CALL DPWRST('XXX','BUG ')
      IF(NUMLIM.EQ.0)WRITE(ICOUT,5283)
 5283 FORMAT('      NO LIMITS OF INTEGRATION DEFINED.')
      IF(NUMLIM.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NUMLIM.EQ.1)WRITE(ICOUT,5284)
 5284 FORMAT('      ONLY ONE LIMIT OF INTEGRATION DEFINED.')
      IF(NUMLIM.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(NUMLIM.NE.0.AND.NUMLIM.NE.1)WRITE(ICOUT,5285)NUMLIM
 5285 FORMAT('      NUMBER OF LIMITS DEFINED = ',I8)
      IF(NUMLIM.NE.0.AND.NUMLIM.NE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5286)
 5286 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5287)
 5287 FORMAT('      LET ... = INTEGRAL ... WRT ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5288)
 5288 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5289)(IANS(I),I=1,IWIDTH)
 5289 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5290 CONTINUE
C
C               **********************************************
C               **  STEP 6.3--                              **
C               **  SCAN THE QUALIFIERS FOR VARIABLE,       **
C               **  PARAMETER, FUNCTION, AND VALUE CHANGES  **
C               **  IN THE FUNCTION.                        **
C               **********************************************
C
      ISTEPN='6.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NCHANG=0
      DO6300IFORI=1,10
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=1
      IF(IFORI.EQ.1)ILOCA=ILOCMX
      IF(IFORI.NE.1)ILOCA=ILOC3
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO6380
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO6350
C
      ILOC3=ILOC2+2
      IF(ILOC3.GT.NUMARG)GOTO6380
      NCHANG=NCHANG+1
      IOLD(NCHANG)=IHARG(ILOC2)
      IOLD2(NCHANG)=IHARG2(ILOC2)
      INEW(NCHANG)=IHARG(ILOC3)
      INEW2(NCHANG)=IHARG2(ILOC3)
C
 6300 CONTINUE
 6350 CONTINUE
      GOTO6390
C
 6380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6301)
 6301 FORMAT('***** ERROR IN DPINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6302)
 6302 FORMAT('      INVALID COMMAND FORM FOR INTEGRATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6303)
 6303 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6304)
 6304 FORMAT('      LET FUNCTION ... = INTEGRAL ... WRT ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6305)
 6305 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,6306)(IANS(I),I=1,IWIDTH)
 6306 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 6390 CONTINUE
C
C               **********************************************
C               **  STEP 6.4--                              **
C               **  CARRY OUT THE VARIABLE,                 **
C               **  PARAMETER, AND FUNCTION CHANGES         **
C               **  AND THEN PRINT OUT A BRIEF MESSAGE      **
C               **  INDICATING THAT THE CHANGES             **
C               **  HAVE BEEN MADE.                         **
C               **********************************************
C
      ISTEPN='6.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO6490
      IF(IFEEDB.EQ.'OFF')GOTO6490
      IF(NCHANG.LE.0)GOTO6490
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='PRE '
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      CALL COMPIC(IFUNC3,N3,IOLD,IOLD2,INEW,INEW2,NCHANG,IFUNC3,N3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      ILAB(1)='POST'
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
 6490 CONTINUE
C
C               **********************************************************
C               **  STEP 6.7--                                          **
C               **  MAKE A NON-CALCULATING PASS AT THE FUNCTION         **
C               **  SO AS TO EXTRACT ALL PARAMETER AND VARIABLE NAMES.  **
C               **********************************************************
C
      ISTEPN='6.8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      IPASS=1
      CALL COMPIM(IFUNC3,N3,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,AJUNK,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***********************************************
C               **  STEP 7--                                 **
C               **  CHECK THAT ALL PARAMETERS                **
C               **  IN THE FUNCTION ARE ALREADY PRESENT      **
C               **  IN THE AVAILABLE NAME LIST IHNAME(.).    **
C               ***********************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IP=0
      IV=0
      IF(NUMPV.LE.0)GOTO7650
      DO7600J=1,NUMPV
      IHPARN=IPARN(J)
      IHPAR2=IPARN2(J)
      IF(IHPARN.EQ.IDUMV(1).AND.IHPAR2.EQ.IDUMV2(1))GOTO7630
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHPARN,IHPAR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IF(IERRO2.EQ.'YES')GOTO7610
      GOTO7620
C
 7610 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7611)
 7611 FORMAT('***** ERROR IN DPINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7612)
 7612 FORMAT('      A PARAMETER/FUNCTION HAS BEEN ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7613)
 7613 FORMAT('      IN THE FUNCTION TO BE INTEGRATED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7614)
 7614 FORMAT('      WHICH HAS NOT YET BEEN DEFINED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7615)
 7615 FORMAT('      THE UNKNOWN PARAMETER/FUNCTION = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7616)
 7616 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7617)(IANS(I),I=1,IWIDTH)
 7617 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 7620 CONTINUE
      IP=IP+1
      PARAM(J)=VALUE(ILOCP)
      GOTO7600
C
 7630 CONTINUE
      IV=IV+1
      LOCDUM=J
 7600 CONTINUE
 7650 CONTINUE
C
C               ******************************
C               **  STEP 8--                **
C               **  DETERMINE THE INTEGRAL  **
C               ******************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO7719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7711)
 7711 FORMAT('***** FROM DPINTE, IMMEDIATELY BEFORE CALLING ',
     1'INTEGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7712)N3,NUMPV
 7712 FORMAT('N3,NUMPV = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7713)NUMDV,XMIN,XMAX,XINT
 7713 FORMAT('NUMDV,XMIN,XMAX,XINT = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
      DO7714I=1,NUMDV
      WRITE(ICOUT,7715)I,IDUMV(I),IDUMV2(I)
 7715 FORMAT('I,IDUMV(I),IDUMV2(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
 7714 CONTINUE
      WRITE(ICOUT,7716)IBUGA3,IBUGCO,IBUGEV
 7716 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 7719 CONTINUE
C
      CALL DPINT2(IFUNC3,N3,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IDUMV,IDUMV2,NUMDV,XMIN,XMAX,XINT,
     1IBUGA3,IBUGCO,IBUGEV,IERROR)
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  ENTER THE INTEGRATION VALUE INTO THE DATAPLOT  **
C               **  HOUSEKEEPING ARRAY                             **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHL=IHLEFT
      IHL2=IHLEF2
      ICASEL='P'
      IXINT=XINT+0.5
CCCCC THE FOLLOWING 2 LINES WERE ADDED NOVEMBER 1989
      BJUNK(1)=AJUNK
      NJUNK=1
CCCCC THE FOLLOWING LINE WAS CHANGED NOVEMBER 1989
CCCCC CALL DPINVP(IHL,IHL2,ICASEL,AJUNK,NJUNK,XINT,IXINT,
      CALL DPINVP(IHL,IHL2,ICASEL,BJUNK,NJUNK,XINT,IXINT,
     1ISUBN1,ISUBN2,IBUGA3,IERROR)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT      **
C               ****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF DPINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3
 9012 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGCO,IBUGEV
 9013 FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IBUGQ
 9014 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMNAM
      WRITE(ICOUT,9016)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
 9016 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1I8,2X,A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)NUMCHF,MAXCHF,IWIDTH,N2
 9017 FORMAT('NUMCHF,MAXCHF,IWIDTH,N2 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)(IFUNC(I),I=1,IWIDTH)
 9018 FORMAT('IFUNC(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)(IFUNC2(I),I=1,N2)
 9019 FORMAT('IFUNC2(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)N3
 9020 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)(IFUNC3(I),I=1,N3)
 9021 FORMAT('IFUNC3(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)NUMPV
 9022 FORMAT('NUMPV = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IP,IV,IDUMV(1),IDUMV2(1),LOCDUM
 9023 FORMAT('IP,IV,IDUMV(1),IDUMV2(1),LOCDUM = ',I8,I8,2X,A4,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IHLEFT,IHLEF2
 9024 FORMAT('IHLEFT,IHLEF2 = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)ICASEL,IFOUND,IERROR
 9025 FORMAT('ICASEL,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)XMIN,XMAX,XINT
 9026 FORMAT('XMIN,XMAX,XINT = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPINVP(IHLEFT,IHLEF2,ICASEL,VLEFT,NLEFT,PLEFT,ILEFT,
     1ISUBN3,ISUBN4,IBUGA3,IERROR)
C
C     PURPOSE--INSERT THE VARIABLE OR PARAMETER
C              WITH NAME   IHLEFT
C              INTO THE INTERNAL DATAPLOT TABLE.
C              ALSO, UPDATE INTERNAL DATAPLOT
C              LISTS (IF NECESSARY).
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--JANUARY   1979.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --JULY      1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 ICASEL
      CHARACTER*4 ISUBN3
      CHARACTER*4 ISUBN4
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION VLEFT(*)
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='DPIN'
      ISUBN2='VP  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
C
      IERROR='NO'
C
      ICOLL=0
C
C               ******************************************
C               **  INSERT A VARIABLE                   **
C               **  INTO THE GENERAL DATAPLOT           **
C               **  ARRAY V(.)  ; OR                    **
C               **  INSERT A PARAMETER VALUE            **
C               **  INTO THE INTERNAL DATAPLOT TABLE.   **
C               **  MAKE ADJUSTMENTS TO THE             **
C               **  INTERNAL DATAPLOT LISTS.            **
C               ******************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPINVP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IHLEFT,IHLEF2,ICASEL,NLEFT,PLEFT
   52 FORMAT('IHLEFT,IHLEF2,ICASEL,NLEFT,PLEFT = ',
     1A4,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)VLEFT(1),VLEFT(NLEFT)
   53 FORMAT('VLEFT(1),VLEFT(NLEFT) = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMNAM,MAXNAM,NUMCOL,MAXN,MAXCOL
   54 FORMAT('NUMNAM,MAXNAM,NUMCOL,MAXN,MAXCOL = ',5I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
      NEWCOL='NO'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  DETERMINE WHETHER OR NOT THE NAME IN IHLEFT      **
C               **  ALREADY EXISTS IN THE INTERNAL IHNAME(.) TABLE.  **
C               **  THE 'YES' OR 'NO' RESULT IS PLACED IN    NEWNAM. **
C               **  THE LINE IN THE TABLE IS PLACED INTO ILISTL.     **
C               **  DETERMINE ALSO IF THE NUMBER OF NAMES            **
C               **  IN THE IHNAME(.) TABLE EXCEEDS THE               **
C               **  MAXIMUM ALLOWABLE NUMBER (MAXNAM).               **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2000I=1,NUMNAM
      I2=I
      IF(IHLEFT.EQ.IHNAME(I).AND.IHLEF2.EQ.IHNAM2(I))GOTO2030
 2000 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      GOTO2050
 2030 CONTINUE
      NEWNAM='NO'
      ILISTL=I2
 2050 CONTINUE
C
      IF(ILISTL.LE.MAXNAM)GOTO2090
      WRITE(ICOUT,2051)ISUBN1,ISUBN2,ISUBN3,ISUBN4
 2051 FORMAT('***** ERROR IN ',A4,A4,'AS CALLED FROM ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2052)
 2052 FORMAT('      THE NUMBER OF VARIABLE/PARAMETER',
     1'/FUNCTION NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2053)MAXNAM
 2053 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE (= ',
     1I8,')   .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2054)
 2054 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2055)
 2055 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2056)
 2056 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2057)
 2057 FORMAT('      AND THEN REUSE SOME NAME.   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2058)
 2058 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2059)(IANS(I),I=1,IWIDTH)
 2059 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2090 CONTINUE
C
C               ***************************************
C               **  STEP 3--                         **
C               **  IF OUTPUT IS TO BE A VARIABLE,   **
C               **  DETERMINE WHAT COLUMN IN V(.)    **
C               **  THE OUTPUT WILL GO.              **
C               **  THE RESULT WILL BE PLACED        **
C               **  INTO  ICOLL    .                 **
C               ***************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEL.NE.'V')GOTO3099
C
      IF(NEWNAM.EQ.'YES')NEWCOL='YES'
      IF(NEWNAM.EQ.'YES')ICOLL=NUMCOL+1
C
      IF(NEWNAM.EQ.'NO'.AND.IUSE(ILISTL).NE.'V')NEWCOL='YES'
      IF(NEWNAM.EQ.'NO'.AND.IUSE(ILISTL).NE.'V')ICOLL=NUMCOL+1
C
      IF(NEWNAM.EQ.'NO'.AND.IUSE(ILISTL).EQ.'V')NEWCOL='NO'
      IF(NEWNAM.EQ.'NO'.AND.IUSE(ILISTL).EQ.'V')ICOLL=IVALUE(ILISTL)
C
 3099 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  DETERMINE IF THE COLUMN IN V(.)    **
C               **  WOULD EXCEED THE MAX ALLOWABLE     **
C               **  NUMBER OF COLUMNS.                 **
C               *****************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEL.NE.'V')GOTO4099
      IF(ICASEL.EQ.'V'.AND.ICOLL.LE.MAXCOL)GOTO4099
C
      WRITE(ICOUT,4051)ISUBN1,ISUBN2,ISUBN3,ISUBN4
 4051 FORMAT('***** ERROR IN ',A4,A4,'AS CALLED FROM ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4052)
 4052 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4053)MAXCOL
 4053 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4054)
 4054 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4055)
 4055 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4056)
 4056 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4057)
 4057 FORMAT('      AND THEN OVERWRITE SOME COLUMN.   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4058)
 4058 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4059)(IANS(I),I=1,IWIDTH)
 4059 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4099 CONTINUE
C
C               *******************************************
C               **  STEP 5--                             **
C               **  IF OUTPUT IS TO BE A VARIABLE,       **
C               **  ENTER THE CONTENTS OF VLEFT(.)       **
C               **  (ALL NLEFT ELEMENTS OF VLEFT(.))     **
C               **  INTO COLUMN     ICOLL    OF V(.)  .  **
C               *******************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEL.NE.'V')GOTO5099
      IF(NLEFT.LE.0)GOTO5099
      IF(NLEFT.LE.MAXN)GOTO5039
C
      WRITE(ICOUT,5021)ISUBN1,ISUBN2,ISUBN3,ISUBN4
 5021 FORMAT('***** ERROR IN ',A4,A4,'AS CALLED FROM ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5022)NLEFT
 5022 FORMAT('      THE NUMBER (= ',I8,') OF ELEMENTS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5023)IHLEFT,IHLEF2
 5023 FORMAT('      FOR VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5024)MAXN
 5024 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5025)
 5025 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5026)
 5026 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5027)
 5027 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5028)
 5028 FORMAT('      AND THEN OVERWRITE SOME COLUMN.   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5029)
 5029 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5030)(IANS(I),I=1,IWIDTH)
 5030 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5039 CONTINUE
C
      DO5070I=1,NLEFT
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=VLEFT(I)
      IF(ICOLL.EQ.MAXCP1)PRED(I)=VLEFT(I)
      IF(ICOLL.EQ.MAXCP2)RES(I)=VLEFT(I)
 5070 CONTINUE
C
 5099 CONTINUE
C
C               *******************************************
C               **  STEP 7--                             **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING    **
C               *******************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEL.EQ.'P')GOTO7010
      IF(ICASEL.EQ.'V')GOTO7020
      GOTO9000
C
 7010 CONTINUE
      IHNAME(ILISTL)=IHLEFT
      IHNAM2(ILISTL)=IHLEF2
      VALUE(ILISTL)=PLEFT
      IVALUE(ILISTL)=ILEFT
      IN(ILISTL)=ILEFT
      IUSE(ILISTL)='P'
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
C
      IF(IFEEDB.EQ.'OFF')GOTO7019
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7011)IHLEFT,IHLEF2,VALUE(ILISTL)
 7011 FORMAT('THE COMPUTED VALUE OF THE CONSTANT   ',A4,A4,
     1' = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 7019 CONTINUE
      GOTO7190
C
 7020 CONTINUE
      IHNAME(ILISTL)=IHLEFT
      IHNAM2(ILISTL)=IHLEF2
      IUSE(ILISTL)='V'
      IVALUE(ILISTL)=ICOLL
      VALUE(ILISTL)=ICOLL
      IN(ILISTL)=NLEFT
C
CCCCC IUSE(ICOLL)='V'
CCCCC IVALUE(ICOLL)=ICOLL
CCCCC VALUE(ICOLL)=ICOLL
CCCCC IN(ICOLL)=NLEFT
C
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWCOL.EQ.'YES')NUMCOL=NUMCOL+1
C
      DO7100I=1,NUMNAM
      I2=I
      IF(IUSE(I).EQ.'V'.AND.IVALUE(I).EQ.ICOLL)GOTO7105
      GOTO7100
 7105 CONTINUE
      IUSE(I2)='V'
      IVALUE(I2)=ICOLL
      VALUE(I2)=ICOLL
      IN(I2)=NLEFT
 7100 CONTINUE
C
      NS=NLEFT
      IF(IFEEDB.EQ.'OFF')GOTO7119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7111)IHLEFT,IHLEF2,NS
 7111 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
 7119 CONTINUE
C
      IROW1=1
      IROWN=NLEFT
C
      IF(IFEEDB.EQ.'OFF')GOTO7149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IJ1=MAXN*(ICOLL-1)+IROW1
      IF(ICOLL.LE.MAXCOL)WRITE(ICOUT,7121)IHLEFT,IHLEF2,V(IJ1),
     1IROW1
 7121 FORMAT('THE FIRST          COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,' (ROW ',I5,')')
      IF(ICOLL.LE.MAXCOL)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1)WRITE(ICOUT,7121)IHLEFT,IHLEF2,PRED(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2)WRITE(ICOUT,7121)IHLEFT,IHLEF2,RES(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
      IJN=MAXN*(ICOLL-1)+IROWN
      IF(ICOLL.LE.MAXCOL.AND.
     1NS.NE.1)WRITE(ICOUT,7131)NS,IHLEFT,IHLEF2,V(IJN),IROWN
      IF(ICOLL.LE.MAXCOL.AND.
     1NS.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS.NE.1)WRITE(ICOUT,7131)NS,IHLEFT,IHLEF2,PRED(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS.NE.1)WRITE(ICOUT,7131)NS,IHLEFT,IHLEF2,RES(IROWN),IROWN
 7131 FORMAT('THE LAST (',I5,'TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,' (ROW ',I5,')')
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS.NE.1)CALL DPWRST('XXX','BUG ')
      IF(NS.NE.1)GOTO7180
C
      WRITE(ICOUT,7142)
 7142 FORMAT('NOTE--THE ABOVE VALUE WAS THE ONLY VALUE COMPUTED ',
     1'FOR THIS VARIABLE.')
      CALL DPWRST('XXX','BUG ')
 7149 CONTINUE
 7180 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO7189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7182)IHLEFT,IHLEF2,ICOLL
 7182 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,'  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7183)IHLEFT,IHLEF2,NLEFT
 7183 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,'  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 7189 CONTINUE
C
 7190 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT      **
C               ****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPINVP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IHLEFT,IHLEF2,ICASEL,NLEFT,PLEFT,ILEFT
 9012 FORMAT('IHLEFT,IHLEF2,ICASEL,NLEFT,PLEFT,ILEFT = ',
     1A4,A4,2X,A4,I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)VLEFT(1),VLEFT(NLEFT)
 9013 FORMAT('VLEFT(1),VLEFT(NLEFT) = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NEWNAM,ILISTL,ICOLL,NUMNAM
 9015 FORMAT('NEWNAM,ILISTL,ICOLL,NUMNAM = ',A4,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IHNAME(ILISTL),IHNAM2(ILISTL),IVALUE(ILISTL),
     1VALUE(ILISTL)
 9016 FORMAT('IHNAME(ILISTL),IHNAM2(ILISTL),IVALUE(ILISTL),',
     1'VALUE(ILISTL) = ',A4,A4,2X,I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IUSE(ILISTL),IN(ILISTL)
 9017 FORMAT('IUSE(ILISTL),IN(ILISTL) = ',A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
      IJ1=MAXN*(ICOLL-1)+1
      IJN=MAXN*(ICOLL-1)+NLEFT
      WRITE(ICOUT,9018)IJ1,IJN,V(IJ1),V(IJN)
 9018 FORMAT('IJ1,IJN,V(IJ1),V(IJN) = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPISP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ISEED,
     1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING INTERACTION STATISTIC
C              PLOTS (THESE DIFFER FROM THE STATISTIC PLOT CASE
C              IN THAT THERE CAN BE MORE THAN 1 X VARIABLE, THESE
C              ARE MULTIPLIED TO GET THE INTERACTION X TERM, MAIN
C              APPLICATION IS IN DESIGN OF EXPERIMENTS)--
C                 MEAN INTERACTION STATISTIC PLOT
C                 MIDM INTERACTION STATISTIC PLOT
C                 MEDI INTERACTION STATISTIC PLOT
C                 SD INTERACTION STATISTIC PLOT
C                 REL SD INTERACTION STATISTIC PLOT
C                 SD MEAN INTERACTION STATISTIC PLOT
C                 VARI INTERACTION STATISTIC PLOT
C                 REL VARI INTERACTION STATISTIC PLOT
C                 VARI MEAN INTERACTION STATISTIC PLOT
C                 RANG INTERACTION STATISTIC PLOT
C                 MINI INTERACTION STATISTIC PLOT
C                 MAXI INTERACTION STATISTIC PLOT
C                 EXTREME INTERACTION STATISTIC PLOT
C                 SKEW INTERACTION STATISTIC PLOT
C                 KURT INTERACTION STATISTIC PLOT
C                 AUCR INTERACTION STATISTIC PLOT
C                 SDM INTERACTION STATISTIC PLOT
C                 AUCV INTERACTION STATISTIC PLOT
C                 LOWH INTERACTION STATISTIC PLOT
C                 UPPH INTERACTION STATISTIC PLOT
C                 LOWQ INTERACTION STATISTIC PLOT
C                 UPPQ INTERACTION STATISTIC PLOT
C                 TRIM INTERACTION STATISTIC PLOT
C                 WINM INTERACTION STATISTIC PLOT
C                 MIDQ INTERACTION STATISTIC PLOT
C                 1DEC INTERACTION STATISTIC PLOT
C                 2DEC INTERACTION STATISTIC PLOT
C                 3DEC INTERACTION STATISTIC PLOT
C                 4DEC INTERACTION STATISTIC PLOT
C                 5DEC INTERACTION STATISTIC PLOT
C                 6DEC INTERACTION STATISTIC PLOT
C                 7DEC INTERACTION STATISTIC PLOT
C                 8DEC INTERACTION STATISTIC PLOT
C                 9DEC INTERACTION STATISTIC PLOT
C                 SINE FREQUENCY INTERACTION STATISTIC PLOT
C                 SINE AMPLITUDE INTERACTION STATISTIC PLOT
C                 LINEAR INTERCEPT INTERACTION STATISTIC PLOT
C                 LINEAR SLOPE INTERACTION STATISTIC PLOT
C                 LINEAR RESSD INTERACTION STATISTIC PLOT
C                 LINEAR CORRELATION INTERACTION STATISTIC PLOT
C                 TAGUCHI SIGNAL-TO-NOISE PLOTS
C                 CP PLOT
C                 CPK PLOT
C                 CPM PLOT
C                 CC PLOT
C                 CNPK PLOT
C                 PERCENT DEFECTIVE PLOT
C                 EXPECTED LOSS PLOT
C                 NORM PPCC INTERACTION STATISTIC PLOT
C                 AAD PLOT
C                 MAD PLOT
C                 SN SCALE PLOT
C                 QN SCALE PLOT
C                 PERCENTILE PLOT
C                 GEOMETRIC MEAN PLOT
C                 GEOMETRIC STANDARD DEVIATION PLOT
C                 BIWEIGHT LOCATION PLOT
C                 BIWEIGHT SCALE PLOT
C                 WINSORIZED VARIANCE PLOT
C                 WINSORIZED SD PLOT
C                 CORRELATION INTERACTION STATISTIC PLOT
C                 COVARIANCE INTERACTION STATISTIC PLOT
C                 RANK CORRELATION INTERACTION STATISTIC PLOT
C                 RANK COVARIANCE INTERACTION STATISTIC PLOT
C                 KENDELLS TAU INTERACTION STATISTIC PLOT
C                 WINSORIZED COVARIANCE PLOT
C                 WINSORIZED CORRELATION PLOT
C                 BIWEIGHT MIDVARIANCE PLOT
C                 BIWEIGHT MIDCOVARIANCE PLOT
C                 BIWEIGHT MIDCORRELATION PLOT
C                 PERCENTAGE BEND MIDVARIANCE PLOT
C                 PERCENTAGE BEND CORRELATION PLOT
C                 HODGES LEHMAN PLOT
C                 QUANTILE PLOT
C                 QUANTILE STANDARD ERROR PLOT
C                 TRIMMED MEAN STANDARD ERROR 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--99/10
C     ORIGINAL VERSION--OCTOBER   1999.
C     UPDATED         --JULY      2002. BIWEIGHT LOCATION
C     UPDATED         --JULY      2002. BIWEIGHT SCALE
C     UPDATED         --JULY      2002. WINSORIZED VARIANCE
C     UPDATED         --JULY      2002. WINSORIZED SD
C     UPDATED         --JULY      2002. ADD WINSORIZED COVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD WINSORIZED CORRELATION PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCOVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCORRELATION PLOT
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND MIDVARIANCE
C                                           PLOT
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND CORRELATION
C                                           PLOT
C     UPDATED         --JULY      2002. ADD HODGES LEHMAN PLOT
C     UPDATED         --JULY      2002. ADD QUANTILE PLOT
C     UPDATED         --JULY      2002. ADD QUANTILE STANDARD ERROR PLOT
C     UPDATED         --JULY      2002. ADD TRIMMED MEAN STANDARD
C                                       ERROR PLOT
C     UPDATED         --APRIL     2003. ADD SN AND QN, REQUIRED
C                                       ADDITIONAL SCRATCH ARRAYS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
C
      CHARACTER*4 ICASV
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      PARAMETER (MAXV2=25)
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION ICOLH(MAXV2)
      DIMENSION NHOR(MAXV2)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Z1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),Z1(1))
      EQUIVALENCE (GARBAG(IGARB4),XTEMP3(1))
CCCCC END CHANGE
C
CCCCC JULY 2002. ADD INTEGER ARRAYS FOR HODGES-LEHMAN PLOT.
      INCLUDE 'DPCOZI.INC'
C
      INTEGER ITEMP1(MAXOBV)
      INTEGER ITEMP2(MAXOBV)
      INTEGER ITEMP3(MAXOBV)
      INTEGER ITEMP4(MAXOBV)
      INTEGER ITEMP5(MAXOBV)
      INTEGER ITEMP6(MAXOBV)
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5(1))
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='PISP'
      ISUBN2='    '
      ICASV='ON'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      ICOLL=0
      DO20I=1,MAXV2
        ICOLH(I)=0
        NHOR(I)=0
   20 CONTINUE
C
C               *************************************************
C               **  TREAT THE INTERACTION STATISTIC PLOT CASE  **
C               *************************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PISP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPISP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
   52 FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE IF OF THIS TYPE  **
C               **  AND BRANCH ACCORDINGLY.    **
C               *********************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO9000
C
      IF(ICOM.EQ.'NUMB'.AND.ICOM2.EQ.'ER  ')GOTO201
      IF(ICOM.EQ.'COUN'.AND.ICOM2.EQ.'T   ')GOTO201
      IF(ICOM.EQ.'COUN'.AND.ICOM2.EQ.'TS  ')GOTO201
      IF(ICOM.EQ.'SIZE'.AND.ICOM2.EQ.'    ')GOTO201
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SAMP'.AND.IHARG(1).EQ.'SIZE')GOTO202
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SUBS'.AND.IHARG(1).EQ.'SIZE')GOTO202
C
      IF(ICOM.EQ.'SUM '.AND.ICOM2.EQ.'    ')GOTO211
      IF(ICOM.EQ.'PROD'.AND.ICOM2.EQ.'UCT ')GOTO212
      IF(ICOM.EQ.'INTE'.AND.ICOM2.EQ.'GRAL')GOTO213
C
      IF(ICOM.EQ.'MIDR'.AND.ICOM2.EQ.'ANGE')GOTO221
      IF(ICOM.EQ.'MEAN'.AND.ICOM2.EQ.'    ')GOTO222
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AVER'.AND.ICOM2.EQ.'AGE '.AND.IHARG(1).EQ.'ABSO'.AND.
     1IHARG(2).EQ.'DEVI')GOTO413
      IF(ICOM.EQ.'AAD '.AND.ICOM2.EQ.'    ')GOTO414
C
      IF(ICOM.EQ.'AVER'.AND.ICOM2.EQ.'AGE ')GOTO222
      IF(ICOM.EQ.'MIDM'.AND.ICOM2.EQ.'EAN ')GOTO223
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MEDI'.AND.ICOM2.EQ.'AN  '.AND.IHARG(1).EQ.'ABSO'.AND.
     1IHARG(2).EQ.'DEVI')GOTO415
      IF(ICOM.EQ.'MAD '.AND.ICOM2.EQ.'    ')GOTO416
C
      IF(ICOM.EQ.'MEDI'.AND.ICOM2.EQ.'AN  ')GOTO224
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'TRIM'.AND.IHARG(1).EQ.'MEAN'.AND.
     1(IHARG(2).NE.'STAN'.AND.IHARG(3).NE.'ERRO'))GOTO225
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WIND'.AND.IHARG(1).EQ.'MEAN')GOTO226
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'MEAN')GOTO226
C
      IF(ICOM.EQ.'R   '.AND.ICOM2.EQ.'    ')GOTO241
      IF(ICOM.EQ.'RANG'.AND.ICOM2.EQ.'E   ')GOTO241
      IF(ICOM.EQ.'MINI'.AND.ICOM2.EQ.'MUM ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(ICOM.EQ.'MIN '.AND.ICOM2.EQ.'    ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(ICOM.EQ.'MAXI'.AND.ICOM2.EQ.'MUM ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
      IF(ICOM.EQ.'MAX '.AND.ICOM2.EQ.'    ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'THE '.AND.IHARG(3).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'MEAN')GOTO253
      IF(ICOM.EQ.'VARI'.AND.ICOM2.EQ.'ANCE')GOTO254
      IF(ICOM.EQ.'VARI'.AND.ICOM2.EQ.'    ')GOTO254
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'VAR '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'THE '.AND.IHARG(3).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'VAR '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'VAR '.AND.IHARG(1).EQ.'MEAN')GOTO253
      IF(ICOM.EQ.'VAR '.AND.ICOM2.EQ.'    ')GOTO254
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'OF  '.AND.IHARG(3).EQ.'THE '.AND.
     1IHARG(4).EQ.'MEAN')GOTO261
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'OF  '.AND.IHARG(3).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'MEAN')GOTO263
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'THE '.AND.IHARG(3).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MEAN')GOTO263
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'MEAN')GOTO266
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI')GOTO264
      IF(ICOM.EQ.'SD  '.AND.ICOM2.EQ.'    ')GOTO265
      IF(ICOM.EQ.'S   '.AND.ICOM2.EQ.'    ')GOTO265
C
      IF(ICOM.EQ.'RS  '.AND.ICOM2.EQ.'    ')GOTO271
      IF(ICOM.EQ.'RSD '.AND.ICOM2.EQ.'    ')GOTO271
      IF(ICOM.EQ.'RELS'.AND.ICOM2.EQ.'    ')GOTO271
      IF(ICOM.EQ.'RELS'.AND.ICOM2.EQ.'D   ')GOTO271
      IF(ICOM.EQ.'RV  '.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RVAR'.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RELV'.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RELV'.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RELV'.AND.ICOM2.EQ.'AR  ')GOTO272
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'COEF'.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'VARI')GOTO273
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'COEF'.AND.IHARG(1).EQ.'VARI')GOTO274
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'SD  ')GOTO276
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO277
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'VAR ')GOTO278
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'VARI')GOTO278
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LOWE'.AND.IHARG(1).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'QUAR')GOTO302
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'UPPE'.AND.IHARG(1).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LOWE'.AND.IHARG(1).EQ.'HING')GOTO304
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'UPPE'.AND.IHARG(1).EQ.'HING')GOTO305
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'THIR'.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO311
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'3RD '.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO311
      IF(ICOM.EQ.'SKEW'.AND.ICOM2.EQ.'NESS')GOTO312
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'FOUR'.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO313
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'4TH '.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO313
      IF(ICOM.EQ.'KURT'.AND.ICOM2.EQ.'OSIS')GOTO314
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'COVA'.AND.
     1IHARG(1).EQ.'STAT'.AND.IHARG(2).EQ.'PLOT')GOTO321
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'CORR'.AND.
     1IHARG(1).EQ.'STAT'.AND.IHARG(2).EQ.'PLOT')GOTO322
C
      IF(ICOM.EQ.'COVA'.AND.ICOM2.EQ.'RIAN')GOTO331
      IF(ICOM.EQ.'CORR'.AND.ICOM2.EQ.'ELAT')GOTO332
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RANK'.AND.IHARG(1).EQ.'COVA')GOTO333
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RANK'.AND.IHARG(1).EQ.'CORR')GOTO334
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'KEND'.AND.IHARG(1).EQ.'TAU ')GOTO337
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI')GOTO111
      GOTO119
  111 CONTINUE
      IF(ICOM.EQ.'FIRS')GOTO341
      IF(ICOM.EQ.'SECO')GOTO342
      IF(ICOM.EQ.'THIR')GOTO343
      IF(ICOM.EQ.'FOUR')GOTO344
      IF(ICOM.EQ.'FIFT')GOTO345
      IF(ICOM.EQ.'SIXT')GOTO346
      IF(ICOM.EQ.'SEVE')GOTO347
      IF(ICOM.EQ.'EIGH')GOTO348
      IF(ICOM.EQ.'NINT')GOTO349
  119 CONTINUE
C
      IF(ICOM.EQ.'PERC'.AND.IHARG(1).NE.'BEND'.AND.IHARG(1).NE.'DEFE')
     1   GOTO350
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SIN'.AND.IHARG(1).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SINE'.AND.IHARG(1).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SIN'.AND.IHARG(1).EQ.'AMP')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SINE'.AND.IHARG(1).EQ.'AMP')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SIN'.AND.IHARG(1).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SINE'.AND.IHARG(1).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'INTE')GOTO363
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'SLOP')GOTO364
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'RESS')GOTO365
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'CORR')GOTO366
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SN  '.AND.IHARG(1).EQ.'SCAL')GOTO500
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QN  '.AND.IHARG(1).EQ.'SCAL')GOTO502
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'TAGU')GOTO130
      GOTO139
  130 CONTINUE
      IF(IHARG(1).EQ.'SN')GOTO371
      IF(IHARG(1).EQ.'S/N')GOTO371
      IF(IHARG(1).EQ.'SN0')GOTO371
      IF(IHARG(1).EQ.'S/N0')GOTO371
      IF(IHARG(1).EQ.'SNT')GOTO371
      IF(IHARG(1).EQ.'S/NT')GOTO371
      IF(IHARG(1).EQ.'SN+')GOTO372
      IF(IHARG(1).EQ.'S/N+')GOTO372
      IF(IHARG(1).EQ.'SNL')GOTO372
      IF(IHARG(1).EQ.'SN-')GOTO373
      IF(IHARG(1).EQ.'S/N-')GOTO373
      IF(IHARG(1).EQ.'SNS')GOTO373
      IF(IHARG(1).EQ.'SN00')GOTO374
      IF(IHARG(1).EQ.'SNT2')GOTO374
      IF(IHARG(1).EQ.'S/N2')GOTO374
      IF(IHARG(1).EQ.'SN2')GOTO374
  139 CONTINUE
C
      IF(ICOM.EQ.'SN')GOTO381
      IF(ICOM.EQ.'S/N')GOTO381
      IF(ICOM.EQ.'SN0')GOTO381
      IF(ICOM.EQ.'S/N0')GOTO381
      IF(ICOM.EQ.'SNT')GOTO381
      IF(ICOM.EQ.'S/NT')GOTO381
      IF(ICOM.EQ.'SN+')GOTO382
      IF(ICOM.EQ.'S/N+')GOTO382
      IF(ICOM.EQ.'SNL ')GOTO382
      IF(ICOM.EQ.'SN-')GOTO383
      IF(ICOM.EQ.'S/N-')GOTO383
      IF(ICOM.EQ.'SNS')GOTO383
      IF(ICOM.EQ.'SN00')GOTO384
      IF(ICOM.EQ.'SNT2')GOTO384
      IF(ICOM.EQ.'S/N2')GOTO384
      IF(ICOM.EQ.'SN2')GOTO384
C
      IF(ICOM.EQ.'CP')GOTO401
      IF(ICOM.EQ.'CPK')GOTO402
      IF(ICOM.EQ.'CNPK')GOTO398
      IF(ICOM.EQ.'CPM')GOTO400
      IF(ICOM.EQ.'CC')GOTO399
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'DEFE')GOTO403
         IF(ICOM.EQ.'EXPE'.AND.IHARG(1).EQ.'LOSS')GOTO404
      ENDIF
C
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'NORM'.AND.IHARG(1).EQ.'PPCC')GOTO411
      ENDIF
C
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'EXTR')GOTO412
      ENDIF
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'GEOM'.AND.ICOM2.EQ.'ETRI'.AND.IHARG(1).EQ.'MEAN')GOTO426
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'GEOM'.AND.ICOM2.EQ.'ETRI'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO436
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'LOCA')GOTO446
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'SCAL')GOTO456
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'VARI')GOTO466
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'SD')GOTO476
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO478
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'COVA')GOTO480
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'CORR')GOTO482
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'MIDV')GOTO484
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.
     1IHARG(1).EQ.'MIDC'.AND.IHARG2(1).EQ.'ORRE')GOTO487
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'MIDC')GOTO486
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'BEND'.AND.
     1IHARG(2).EQ.'MIDV')GOTO488
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'HODG'.AND.IHARG(1).EQ.'LEHM')GOTO490
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'QUAN'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'ERRO')GOTO492
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAN')GOTO494
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'TRIM'.AND.IHARG(1).EQ.'MEAN'.AND.
     1IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'ERRO')GOTO496
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'BEND'.AND.
     1IHARG(2).EQ.'CORR')GOTO498
C
      IFOUND='NO'
      GOTO9000
C
C               **********************
C               **  STEP 2--        **
C               **  DEFINE ICASPL.  **
C               **********************
C
  201 CONTINUE
      ICASPL='NUMB'
      GOTO701
C
  202 CONTINUE
      ICASPL='NUMB'
      GOTO702
C
  211 CONTINUE
      ICASPL='SUM'
      GOTO701
C
  212 CONTINUE
      ICASPL='PROD'
      GOTO701
C
  213 CONTINUE
      ICASPL='INTE'
      GOTO701
C
  221 CONTINUE
      ICASPL='MIDR'
      GOTO701
C
  222 CONTINUE
      ICASPL='MEAN'
      GOTO701
C
  223 CONTINUE
      ICASPL='MIDM'
      GOTO701
C
  224 CONTINUE
      ICASPL='MEDI'
      GOTO701
C
  225 CONTINUE
      ICASPL='TRIM'
      GOTO702
C
  226 CONTINUE
      ICASPL='WINM'
      GOTO702
C
  241 CONTINUE
      ICASPL='RANG'
      GOTO701
C
  242 CONTINUE
      ICASPL='MINI'
      GOTO701
C
  243 CONTINUE
      ICASPL='MAXI'
      GOTO701
C
  251 CONTINUE
      ICASPL='VAME'
      GOTO704
C
  252 CONTINUE
      ICASPL='VAME'
      GOTO703
C
  253 CONTINUE
      ICASPL='VAME'
      GOTO702
C
  254 CONTINUE
      ICASPL='VARI'
      GOTO701
C
  261 CONTINUE
      ICASPL='SDME'
      GOTO705
C
  262 CONTINUE
      ICASPL='SDME'
      GOTO704
C
  263 CONTINUE
      ICASPL='SDME'
      GOTO703
C
  264 CONTINUE
      ICASPL='SD'
      GOTO702
C
  265 CONTINUE
      ICASPL='SD'
      GOTO701
C
  266 CONTINUE
      ICASPL='SDME'
      GOTO702
C
  271 CONTINUE
      ICASPL='RESD'
      GOTO701
C
  272 CONTINUE
      ICASPL='REVA'
      GOTO701
C
  273 CONTINUE
      ICASPL='REVA'
      GOTO703
C
  274 CONTINUE
      ICASPL='REVA'
      GOTO702
C
  276 CONTINUE
      ICASPL='RESD'
      GOTO702
C
  277 CONTINUE
      ICASPL='RESD'
      GOTO703
C
  278 CONTINUE
      ICASPL='REVA'
      GOTO702
C
  301 CONTINUE
      ICASPL='LOWQ'
      GOTO702
C
  302 CONTINUE
      ICASPL='MIDQ'
      GOTO702
C
  303 CONTINUE
      ICASPL='UPPQ'
      GOTO702
C
  304 CONTINUE
      ICASPL='LOWH'
      GOTO702
C
  305 CONTINUE
      ICASPL='UPPH'
      GOTO702
C
  311 CONTINUE
      ICASPL='SKEW'
      GOTO704
C
  312 CONTINUE
      ICASPL='SKEW'
      GOTO701
C
  313 CONTINUE
      ICASPL='KURT'
      GOTO704
C
  314 CONTINUE
      ICASPL='KURT'
      GOTO701
C
  321 CONTINUE
      ICASPL='AUCV'
      GOTO701
C
  322 CONTINUE
      ICASPL='AUCR'
      GOTO701
C
  331 CONTINUE
      ICASPL='COVA'
      ICASV='TWO'
      GOTO701
C
  332 CONTINUE
      ICASPL='CORR'
      ICASV='TWO'
      GOTO701
C
  333 CONTINUE
      ICASPL='RACV'
      ICASV='TWO'
      GOTO702
C
  334 CONTINUE
      ICASPL='RACR'
      ICASV='TWO'
      GOTO702
C
  337 CONTINUE
      ICASPL='KTAU'
      ICASV='TWO'
      GOTO702
C
  341 CONTINUE
      ICASPL='1DEC'
      GOTO702
C
  342 CONTINUE
      ICASPL='2DEC'
      GOTO702
C
  343 CONTINUE
      ICASPL='3DEC'
      GOTO702
C
  344 CONTINUE
      ICASPL='4DEC'
      GOTO702
C
  345 CONTINUE
      ICASPL='5DEC'
      GOTO702
C
  346 CONTINUE
      ICASPL='6DEC'
      GOTO702
C
  347 CONTINUE
      ICASPL='7DEC'
      GOTO702
C
  348 CONTINUE
      ICASPL='8DEC'
      GOTO702
C
  349 CONTINUE
      ICASPL='9DEC'
      GOTO702
C
  350 CONTINUE
      ICASPL='PERC'
      GOTO701
C
  361 CONTINUE
      ICASPL='SIFR'
      GOTO702
C
  362 CONTINUE
      ICASPL='SIAM'
      GOTO702
C
  363 CONTINUE
      ICASPL='LIIN'
      ICASV='TWO'
      GOTO702
C
  364 CONTINUE
      ICASPL='LISL'
      ICASV='TWO'
      GOTO702
C
  365 CONTINUE
      ICASPL='LIRE'
      ICASV='TWO'
      GOTO702
C
  366 CONTINUE
      ICASPL='LICO'
      ICASV='TWO'
      GOTO702
C
  371 CONTINUE
      ICASPL='SN0'
      GOTO702
C
  372 CONTINUE
      ICASPL='SN+'
      GOTO702
C
  373 CONTINUE
      ICASPL='SN-'
      GOTO702
C
  374 CONTINUE
      ICASPL='SN00'
      GOTO702
C
  381 CONTINUE
      ICASPL='SN0'
      GOTO701
C
  382 CONTINUE
      ICASPL='SN+'
      GOTO701
C
  383 CONTINUE
      ICASPL='SN-'
      GOTO701
C
  384 CONTINUE
      ICASPL='SN00'
      GOTO701
C
  398 CONTINUE
      ICASPL='CNPK'
      GOTO701
C
  399 CONTINUE
      ICASPL='CC'
      GOTO701
C
  400 CONTINUE
      ICASPL='CPM'
      GOTO701
C
  401 CONTINUE
      ICASPL='CP'
      GOTO701
C
  402 CONTINUE
      ICASPL='CPK'
      GOTO701
C
  403 CONTINUE
      ICASPL='PEDE'
      GOTO702
C
  404 CONTINUE
      ICASPL='EXLO'
      GOTO702
C
  411 CONTINUE
      ICASPL='NOPP'
      GOTO702
C
  412 CONTINUE
      ICASPL='EXTR'
      GOTO701
C
  413 CONTINUE
      ICASPL='AAD '
      GOTO703
C
  414 CONTINUE
      ICASPL='AAD '
      GOTO701
C
  415 CONTINUE
      ICASPL='MAD '
      GOTO703
C
  416 CONTINUE
      ICASPL='MAD '
      GOTO701
C
  426 CONTINUE
      ICASPL='GEME'
      GOTO702
C
  436 CONTINUE
      ICASPL='GESD'
      GOTO703
C
  446 CONTINUE
      ICASPL='BILO'
      GOTO702
C
  456 CONTINUE
      ICASPL='BISC'
      GOTO702
C
  466 CONTINUE
      ICASPL='WIVA'
      GOTO702
C
  476 CONTINUE
      ICASPL='WISD'
      GOTO702
C
  478 CONTINUE
      ICASPL='WISD'
      GOTO703
C
  480 CONTINUE
      ICASPL='WICV'
      ICASV='TWO'
      GOTO702
C
  482 CONTINUE
      ICASPL='WICR'
      ICASV='TWO'
      GOTO702
C
  484 CONTINUE
      ICASPL='BIMV'
      GOTO702
C
  486 CONTINUE
      ICASPL='BIMC'
      ICASV='TWO'
      GOTO702
C
  487 CONTINUE
      ICASPL='BICR'
      ICASV='TWO'
      GOTO702
C
  488 CONTINUE
      ICASPL='PBMV'
      GOTO703
C
  490 CONTINUE
      ICASPL='HLEH'
      GOTO702
C
  492 CONTINUE
      ICASPL='QUSE'
      GOTO703
C
  494 CONTINUE
      ICASPL='QUAN'
      GOTO701
C
  496 CONTINUE
      ICASPL='TMSE'
      GOTO704
C
  498 CONTINUE
      ICASPL='PBCR'
      ICASV='TWO'
      GOTO703
C
  500 CONTINUE
      ICASPL='SNSC'
      ICASV='TWO'
      GOTO702
C
  502 CONTINUE
      ICASPL='QNSC'
      ICASV='TWO'
      GOTO702
C
C               *****************************************************
C               **  STEP 2--                                       **
C               **  DETERMINE THE LOCATION     (IN IHARG(.))       **
C               **  OF THE WORD      PLOT                          **
C               **  PLACE IT IN    ILASTC                          **
C               *****************************************************
C
  701 CONTINUE
      IF(NUMARG.LT.2)GOTO780
      IF(IHARG(1).EQ.'INTE'.AND.IHARG(2).EQ.'PLOT')GOTO801
      IF(NUMARG.LT.3)GOTO780
      IF(IHARG(1).EQ.'INTE'.AND.IHARG(2).EQ.'STAT'.AND.
     1   IHARG(3).EQ.'PLOT')GOTO802
      GOTO780
C
  702 CONTINUE
      IF(NUMARG.LT.3)GOTO780
      IF(IHARG(2).EQ.'INTE'.AND.IHARG(3).EQ.'PLOT')GOTO802
      IF(NUMARG.LT.4)GOTO780
      IF(IHARG(2).EQ.'INTE'.AND.IHARG(3).EQ.'STAT'.AND.
     1   IHARG(4).EQ.'PLOT')GOTO803
      GOTO780
C
  703 CONTINUE
      IF(NUMARG.LT.4)GOTO780
      IF(IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'PLOT')GOTO803
      IF(NUMARG.LT.5)GOTO780
      IF(IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'STAT'.AND.
     1   IHARG(5).EQ.'PLOT')GOTO804
      GOTO780
C
  704 CONTINUE
      IF(NUMARG.LT.5)GOTO780
      IF(IHARG(4).EQ.'INTE'.AND.IHARG(5).EQ.'PLOT')GOTO804
      IF(NUMARG.LT.6)GOTO780
      IF(IHARG(4).EQ.'INTE'.AND.IHARG(5).EQ.'STAT'.AND.
     1   IHARG(6).EQ.'PLOT')GOTO805
      GOTO780
C
  705 CONTINUE
      IF(NUMARG.LT.6)GOTO780
      IF(IHARG(5).EQ.'INTE'.AND.IHARG(6).EQ.'PLOT')GOTO805
      IF(NUMARG.LT.7)GOTO780
      IF(IHARG(5).EQ.'INTE'.AND.IHARG(6).EQ.'STAT'.AND.
     1IHARG(7).EQ.'PLOT')GOTO806
      GOTO780
C
  780 CONTINUE
      IFOUND='NO'
      ICASPL='UNKN'
      GOTO9000
C
  801 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  802 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  803 CONTINUE
      ILASTC=4
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  804 CONTINUE
      ILASTC=5
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  805 CONTINUE
      ILASTC=6
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  806 CONTINUE
      ILASTC=7
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  890 CONTINUE
      IFOUND='YES'
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. **
C               ******************************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 22--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     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.'PISP')
     1WRITE(ICOUT,2211)IHLEFT,ICOLL,NLEFT
 2211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL DPWRST('XXX','BUG ')
C
C               *******************************************************
C               **  STEP 23--                                        **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.        **
C               *******************************************************
C
      ISTEPN='23'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO2390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('***** ERROR IN DPISP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2321)
 2321 FORMAT('      (FOR WHICH AN ... INTERACTION STATISTIC PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)MINN2
 2315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2317)
 2317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2318)(IANS(I),I=1,MIN(IWIDTH,80))
 2318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2390 CONTINUE
C
C               *****************************************
C               **  STEP 24--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='24'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2460
      DO2400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2420
 2400 CONTINUE
      GOTO2490
 2410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2490
 2420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2490
C
 2460 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2461)
 2461 FORMAT('***** INTERNAL ERROR IN DPISP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2462)
 2462 FORMAT('      AT BRANCH POINT 2481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2463)
 2463 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2464)
 2464 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2465)NUMARG
 2465 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2466)
 2466 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2467)(IANS(I),I=1,MIN(IWIDTH,80))
 2467 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2490 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PISP')GOTO2495
      WRITE(ICOUT,2491)NUMARG,ILOCQ,ICASEQ
 2491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 2495 CONTINUE
C
C               *****************************************
C               **  STEP 24.5--                        **
C               **  DETERMINE THE NUMBER OF VARIABLES  **
C               *****************************************
C
      ISTEPN='24.5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.LT.1.OR.NUMV2.GT.MAXV2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2481)
 2481   FORMAT('***** ERROR IN DPISP')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2482)
 2482 FORMAT('      FOR AN INTERACTION STATISTIC PLOT, THE NUMBER OF ',
     1       'VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2484)
 2484 FORMAT('      MUST BE BETWEEN 1 AND ',I8,'.  THERE WERE ',I8,
     1       'VARIABLES ENTERED.')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,2467)(IANS(I),I=1,MIN(IWIDTH,80))
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ******************************************************
C               **  STEP 25--                                       **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS          **
C               **  INDICATES THAT THE VALUES IN THE                **
C               **  FIRST VARIABLE ARE TO BE GROUPED                **
C               **  BASED ON VALUES OF THE SECOND VARIABLE;         **
C               **  THAT IS, THE SECOND VARAIBLE DEFINES THE        **
C               **  GROUP NUMBERS WITHIN WHICH THE MEANS,           **
C               **  STANDARD DEVIATIONS, RANGES, AND                **
C               **  CUMULATIVE SUMS ARE TO BE COMPUTED.             **
C               **  THE VALUES IN THE SECOND VARIABLE               **
C               **  ARE THE X VALUES FOR EACH MEAN, STANDARD        **
C               **  DEVIATION, ETC.                                 **
C               **  IN THE RESULTING INTERACTION STATISTIC PLOT.    **
C               **  THE VALUES IN THE SECOND VARIABLE               **
C               **  NEED NOT HAVE BEEN PREVIOUSLY                   **
C               **  SORTED OR HAVE COMMON VALUES ADJACENT.          **
C               **  IF WE HAVE THE 2-VARIABLE CASE,                 **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.  **
C               **  NOTE: FOR INTERACTION CASE, AS OPPOSSED TO      **
C               **        STANDARD STATISTIC PLOT, THERE CAN BE MORE**
C               **        THAN ONE X VARIABLE, IF SO THEY ARE       **
C               **        MULTIPLIED TOGETHER TO GET AN X           **
C               **        INTERACTION TERM.                         **
C               ******************************************************
C
 2501 CONTINUE
      ISTEPN='25'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 2530 CONTINUE
C
      DO2539J=2,NUMV2
        IHHOR=IHARG(J)
        IHHOR2=IHARG2(J)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLH(J-1)=IVALUE(ILOCV)
        NHOR(J)=IN(ILOCV)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1  WRITE(ICOUT,2531)IHHOR,ICOLH(J),NHOR(J)
 2531   FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1  CALL DPWRST('XXX','BUG ')
        IF(NHOR(J).NE.NLEFT)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2571)
 2571     FORMAT('***** ERROR IN DPISP--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2572)
 2572     FORMAT('      FOR AN ... INTERACTION STATISTIC PLOT, ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2579)
 2579 FORMAT('      THE NUMBER OF ELEMENTS IN EACH VARIABLE MUST BE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2581)
 2581 FORMAT('      THE SAME; SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2583)IHLEFT,IHLEF2,NLEFT
 2583     FORMAT('        VARIABLE 1 ',A4,A4,' HAS ',I8,' ELEMENTS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2584)J,IHHOR,IHHOR2,NHOR
 2584 FORMAT('        VARIABLE ',I4, ',',A4,A4,' HAS ',I8,' ELEMENTS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2587)
 2587     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)WRITE(ICOUT,2588)(IANS(I),I=1,MIN(IWIDTH,80))
 2588     FORMAT('      ',80A1)
          IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
 2539 CONTINUE
C
C               *************************************************
C               **  STEP 26--                                  **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='26'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2610
      IF(ICASEQ.EQ.'SUBS')GOTO2620
      IF(ICASEQ.EQ.'FOR')GOTO2630
C
 2610 CONTINUE
      DO2615I=1,NLEFT
      ISUB(I)=1
 2615 CONTINUE
      NQ=NLEFT
      GOTO2650
C
 2620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2650
C
 2630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2650
C
 2650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      IF(ICASV.EQ.'TWO')THEN
        JSTART=2
      ELSE
        JSTART=1
      ENDIF
      DO2660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO2660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
      IF(NUMV2.LE.1)GOTO2660
C
      IF(ICASV.EQ.'TWO')THEN
        IJ=MAXN*(ICOLH(1)-1)+I
        IF(ICOLH(1).LE.MAXCOL)Z1(J)=V(IJ)
        IF(ICOLH(1).EQ.MAXCP1)Z1(J)=PRED(I)
        IF(ICOLH(1).EQ.MAXCP2)Z1(J)=RES(I)
        IF(ICOLH(1).EQ.MAXCP3)Z1(J)=YPLOT(I)
        IF(ICOLH(1).EQ.MAXCP4)Z1(J)=XPLOT(I)
        IF(ICOLH(1).EQ.MAXCP5)Z1(J)=X2PLOT(I)
        IF(ICOLH(1).EQ.MAXCP6)Z1(J)=TAGPLO(I)
      ENDIF
C
      IF(NUMV2-1.LT.JSTART)GOTO2660
      X1(J)=1.0
      DO2665ITEMP=JSTART,NUMV2-1
        IJ=MAXN*(ICOLH(ITEMP)-1)+I
        IF(ICOLH(ITEMP).LE.MAXCOL)X1(J)=X1(J)*V(IJ)
        IF(ICOLH(ITEMP).EQ.MAXCP1)X1(J)=X1(J)*PRED(I)
        IF(ICOLH(ITEMP).EQ.MAXCP2)X1(J)=X1(J)*RES(I)
        IF(ICOLH(ITEMP).EQ.MAXCP3)X1(J)=X1(J)*YPLOT(I)
        IF(ICOLH(ITEMP).EQ.MAXCP4)X1(J)=X1(J)*XPLOT(I)
        IF(ICOLH(ITEMP).EQ.MAXCP5)X1(J)=X1(J)*X2PLOT(I)
        IF(ICOLH(ITEMP).EQ.MAXCP6)X1(J)=X1(J)*TAGPLO(I)
 2665 CONTINUE
C
 2660 CONTINUE
      NLOCAL=J
C
C               ******************************************************
C               **  STEP 27--                                       **
C               **  FOR THE 1-VARIABLE CASE ONLY,                   **
C               **  DETERMINE IF THE ANALYST                        **
C               **  HAS SPECIFIED    THE GROUP SIZE,                **
C               **  FOR THE INTERACTION STATISTIC PLOT ANALYSIS.    **
C               **  THE GROUP SIZE SETTING IS DEFINED BY SEARCHING THE
C               **  INTERNAL TABLE FOR THE PARAMETER NAME      NI   ;*
C               **  IF FOUND, USE THE SPECIFIED VALUE.              **
C               **  IF NOT FOUND, GENERATE AN ERROR MESSAGE.        **
C               ******************************************************
C
      ISTEPN='27'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.GE.2)GOTO2790
C
      IH='NI  '
      IH2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IERROR=IERRO2
      IF(IERRO2.EQ.'YES')GOTO9000
      ISIZE=VALUE(ILOCP)+0.5
 2790 CONTINUE
C
C               *****************************************************
C               **  STEP 28--                                      **
C               **  COMPUTE THE APPROPRIATE INTERACTION STATISTIC  **
C               **  PLOT STATISTIC--                               **
C               **  (MEAN, STANDARD DEVIATION, RANGE, OR CUSUM).   **
C               **  COMPUTE CONFIDENCE LINES.                      **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
C               **  DEFINE THE VECTOR D(.) TO 1'S, 2'S, AND 3'S    **
C               **  FOR THE PLOTTED VALUE, THE LOWER CONFIDENCE    **
C               **  LINE, AND THE UPPER CONFIDENCE LINE.           **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
C               *****************************************************
C
      ISTEPN='28'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PISP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC JULY 2002.  ALL VALUES OF X1 SHOULD BE "-1" OR "+1".
CCCCC IF NOT, PRINT AN ERROR MESSAGE.
C
       EPS=1.0E-7
       DO2710I=1,NLOCAL
         IF(ABS(X1(I)).LE.EPS)GOTO2710
         IF(ABS(X1(I)-1.0).LE.EPS)GOTO2710
         IF(ABS(X1(I)+1.0).LE.EPS)GOTO2710
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,2711)
 2711      FORMAT('***** ERROR IN <STAT> INTERACTION PLOT--')
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,2713)
 2713      FORMAT('      A PRODUCT OF THE INDEPENDENT VARIABLES IS ',
     1            'NOT EQUAL TO -1, 0, +1')
           CALL DPWRST('XXX','BUG ')
           IERROR='YES'
           GOTO9000
 2710  CONTINUE
C
      NUMV2=2
      IF(ICASV.EQ.'TWO')NUMV2=3
      CALL DPSP2(Y1,Z1,X1,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1Y,X,D,NPLOTP,NPLOTV,ISUBRO,IBUGG3,IERROR)
C
C
C               *************************************************
C               **  STEP 29--                                  **
C               **  SAVE DIFFERENCE BETWEEN HIGHEST VALUE AND  **
C               **  LOWEST VALUE OF STATISTIC IN INTERNAL      **
C               **  PARAMETER ALOWHIGH                         **
C               *************************************************
      AMINS=CPUMAX
      AMAXS=CPUMIN
      DO2910I=1,NPLOTP
        IF(D(I).NE.1.0)GOTO2910
        IF(Y(I).GT.AMAXS)THEN
          AMAXS=Y(I)
          IMAXIN=I
        ENDIF
        IF(Y(I).LT.AMINS)THEN
          AMINS=Y(I)
          IMININ=I
        ENDIF
 2910 CONTINUE
      ADIFF=AMAXS-AMINS
      IF(IMAXIN.GT.IMININ)ADIFF=-ADIFF
C
      ISUBN0='DPSP'
C
      IH='ALOW'
      IH2='HIGH'
      VALUE0=ADIFF
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PISP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPISP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
 9012 FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ISIZE
 9015 FORMAT('ISIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMV2
 9016 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IHLEFT,IHLEF2,ICOLL,NLEFT
 9017 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(IFOUND.EQ.'NO'.OR.NPLOTP.LE.0)GOTO9090
      DO9025I=1,NPLOTP
      WRITE(ICOUT,9026)I,Y(I),X(I),D(I)
 9026 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBSP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBOOSS,ISEED,IBCABT,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING
C              JACKNIFE OR BOOTSTRAP STATISTIC PLOTS--
C
C              FOLLOWING FOR A SINGLE RESPONSE VARIABLE
C                 JACKNIFE/BOOTSTRAP MEAN PLOT
C                 JACKNIFE/BOOTSTRAP MIDM PLOT
C                 JACKNIFE/BOOTSTRAP MEDI PLOT
C                 JACKNIFE/BOOTSTRAP GEOMETRIC MEAN PLOT
C                 JACKNIFE/BOOTSTRAP GEOMETRIC SD PLOT
C                 JACKNIFE/BOOTSTRAP MAD PLOT
C                 JACKNIFE/BOOTSTRAP AAD PLOT
C                 JACKNIFE/BOOTSTRAP SN PLOT
C                 JACKNIFE/BOOTSTRAP QN PLOT
C                 JACKNIFE/BOOTSTRAP VARI PLOT
C                 JACKNIFE/BOOTSTRAP RSD PLOT
C                 JACKNIFE/BOOTSTRAP RANG PLOT
C                 JACKNIFE/BOOTSTRAP MINI PLOT
C                 JACKNIFE/BOOTSTRAP MAXI PLOT
C                 JACKNIFE/BOOTSTRAP SKEW PLOT
C                 JACKNIFE/BOOTSTRAP KURT PLOT
C                 JACKNIFE/BOOTSTRAP AUCR PLOT
C                 JACKNIFE/BOOTSTRAP SDM PLOT
C                 JACKNIFE/BOOTSTRAP AUCV PLOT
C                 JACKNIFE/BOOTSTRAP RACV PLOT
C                 JACKNIFE/BOOTSTRAP SIN FREQUENCY PLOT
C                 JACKNIFE/BOOTSTRAP SIN AMPLITUDE PLOT
C                 JACKNIFE/BOOTSTRAP LOWH PLOT
C                 JACKNIFE/BOOTSTRAP UPPH PLOT
C                 JACKNIFE/BOOTSTRAP LOWQ PLOT
C                 JACKNIFE/BOOTSTRAP UPPQ PLOT
C                 JACKNIFE/BOOTSTRAP TRIM PLOT
C                 JACKNIFE/BOOTSTRAP WINM PLOT
C                 JACKNIFE/BOOTSTRAP MIDQ PLOT
C                 JACKNIFE/BOOTSTRAP 1DEC PLOT
C                 JACKNIFE/BOOTSTRAP 2DEC PLOT
C                 JACKNIFE/BOOTSTRAP 3DEC PLOT
C                 JACKNIFE/BOOTSTRAP 4DEC PLOT
C                 JACKNIFE/BOOTSTRAP 5DEC PLOT
C                 JACKNIFE/BOOTSTRAP 6DEC PLOT
C                 JACKNIFE/BOOTSTRAP 7DEC PLOT
C                 JACKNIFE/BOOTSTRAP 8DEC PLOT
C                 JACKNIFE/BOOTSTRAP 9DEC PLOT
C                 JACKNIFE/BOOTSTRAP PERCENTILE PLOT
C                 JACKNIFE/BOOTSTRAP TAGUCHI SIGNAL-TO-NOISE PLOTS
C                 JACKNIFE/BOOTSTRAP GEOMETRIC MEAN PLOT
C                 JACKNIFE/BOOTSTRAP GEOMETRIC SD PLOT
C                 JACKNIFE/BOOTSTRAP HARMONIC MEAN PLOT
C                 JACKNIFE/BOOTSTRAP IQ RANGE PLOT
C                 JACKNIFE/BOOTSTRAP BIWEIGHT LOCATION PLOT
C                 JACKNIFE/BOOTSTRAP BIWEIGHT SCALE PLOT
C                 JACKNIFE/BOOTSTRAP WINSORIZED VARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP WINSORIZED SD PLOT
C                 JACKNIFE/BOOTSTRAP BIWEIGHT MIDVARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP PERCENTAGE BEND MIDVARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP HODGES LEHMAN PLOT
C                 JACKNIFE/BOOTSTRAP QUANTILE PLOT
C                 JACKNIFE/BOOTSTRAP QUANTILE STANDARD ERROR PLOT
C                 JACKNIFE/BOOTSTRAP TRIMMED MEAN STANDARD ERROR PLOT
C                 JACKNIFE/BOOTSTRAP LINEAR CALIBRATION PLOT
C                 JACKNIFE/BOOTSTRAP QUADRATIC CALIBRATION PLOT
C
C              FOLLOWING FOR TWO RESPONSE VARIABLES
C                 JACKNIFE/BOOTSTRAP LINEAR INTERCEPT PLOT
C                 JACKNIFE/BOOTSTRAP LINEAR SLOPE PLOT
C                 JACKNIFE/BOOTSTRAP LINEAR RESSD PLOT
C                 JACKNIFE/BOOTSTRAP LINEAR CORRELATION PLOT
C                 JACKNIFE/BOOTSTRAP WINSORIZED COVARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP WINSORIZED CORRELATION PLOT
C                 JACKNIFE/BOOTSTRAP BIWEIGHT COVARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP BIWEIGHT CORRELATION PLOT
C                 JACKNIFE/BOOTSTRAP PERCENTAGE BEND CORRELATION PLOT
C                 JACKNIFE/BOOTSTRAP CORRELATION PLOT
C                 JACKNIFE/BOOTSTRAP RANK CORRELATION PLOT
C                 JACKNIFE/BOOTSTRAP COVARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP RANK COVARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP KENDELLS TAU PLOT
C                 JACKNIFE/BOOTSTRAP RATIO PLOT
C
C              FOLLOWING STATISTICS COMPUTE DIFFERENCE IN
C              STATISTIC FOR TWO RESPONSE VARIABLES (USED FOR
C              LOCATION AND SCALE STATISTICS):
C   
C              LOCATION:
C                 JACKNIFE/BOOTSTRAP DIFF OF MEANS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF MIDMEANS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF MEDIANS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF TRIMMED MEANS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF WINSORIZED MEANS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF GEOMETRIC MEANS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF HARMONIC MEANS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF HODGES-LEHMAN PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF BIWEIGHT LOCATION PLOT
C   
C              SCALE:
C                 JACKNIFE/BOOTSTRAP DIFF OF STANDARD DEVIATIONS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF VARIANCES PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF AAD PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF MAD PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF SN PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF QN PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF INTERQUARTILE RANGE PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF WINSORIZED SD PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF WINSORIZED VARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF BIWEIGHT MIDVARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF BIWEIGHT SCALE PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF PERCENTAGE BEND PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF GEOMETRIC SD PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF RANGE PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF MIDRANGE PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF QUANTILE PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF SKEWNESS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF KURTOSIS PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF RELATIVE SD PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF SD OF MEAN PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF RELATIVE VARIANCE PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF VARIANCE OF THE MEAN PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF MINIMUM PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF MAXIMUM PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF EXTREMES PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF COEFFICENT OF VARI PLOT
C                 JACKNIFE/BOOTSTRAP DIFF OF SUM PLOT
C
C              FOLLOWING FOR DISTRIBUTION:
C              LOCATION AND SCALE
C                 JACKNIFE/BOOTSTRAP UNIFORM <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP UNIFORM MLE PLOT
C                 JACKNIFE/BOOTSTRAP NORMAL <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP NORMAL MLE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP LOGISTIC <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP LOGISTIC MLE PLOT
C                 JACKNIFE/BOOTSTRAP LAPLACE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP LAPLACE MLE PLOT
C                 JACKNIFE/BOOTSTRAP CAUCHY <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP CAUCHY MLE PLOT
C                 JACKNIFE/BOOTSTRAP HALFNORMAL <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP EXPONENTIAL <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP EXPONENTIAL MLE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GUMBEL <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GUMBEL MLE PLOT
C                 JACKNIFE/BOOTSTRAP SEMICIRCULAR <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP COSINE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP ANGLIT <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP ARCSINE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP HYPERBOLIC SECANT <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP SLASH <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP RAYLEIGH <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP RAYLEIGH MLE PLOT
C              ONE SHAPE PARAMETER, LOCATION AND SCALE
C                 JACKNIFE/BOOTSTRAP WEIBULL <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP INVERTED WEIBULL <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP LOGNORMAL <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GAMMA <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP INVERTED GAMMA <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP LOG GAMMA <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED PARETO <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP T <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP CHI SQUARE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP CHI <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GEOMETRIC EXTR EXPO <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP FATIGUE LIFE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP WALD <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP PARETO <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP FRECHET <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP TUKEY LAMBDA <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP BRADFORD <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP RECIPROCAL <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP ERROR <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP TRIANGULAR <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP LOG LOGISTIC <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP DOUBLE WEIBULL <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP FOLDED T <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP SKEW LAPLACE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP ASYMETRIC LAPLACE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP ASYMETRIC LAPLACE MLE PLOT
C                 JACKNIFE/BOOTSTRAP LOG LAPLACE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED EXTREME VALUE
C                                    <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED LOGISTIC
C                                    <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED LOGISTIC TYPE 2
C                                    <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED LOGISTIC TYPE 3
C                                    <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED LOGISTIC TYPE 5
C                                    <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP WEIBULL KS PLOT
C                 JACKNIFE/BOOTSTRAP INVERTED WEIBULL KS PLOT
C                 JACKNIFE/BOOTSTRAP LOGNORMAL KS PLOT
C                 JACKNIFE/BOOTSTRAP GAMMA KS PLOT
C                 JACKNIFE/BOOTSTRAP INVERTED GAMMA KS PLOT
C                 JACKNIFE/BOOTSTRAP LOG GAMMA KS PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED PARETO KS PLOT
C                 JACKNIFE/BOOTSTRAP T KS PLOT
C                 JACKNIFE/BOOTSTRAP CHI SQUARE KS PLOT
C                 JACKNIFE/BOOTSTRAP GEOM EXTR EXPO SQUARE KS PLOT
C                 JACKNIFE/BOOTSTRAP FATIGUE LIFE SQUARE KS PLOT
C                 JACKNIFE/BOOTSTRAP WALD SQUARE KS PLOT
C                 JACKNIFE/BOOTSTRAP PARETO SQUARE KS PLOT
C                 JACKNIFE/BOOTSTRAP FRECHET SQUARE KS PLOT
C                 JACKNIFE/BOOTSTRAP TUKEY LAMBDA SQUARE KS PLOT
C                 JACKNIFE/BOOTSTRAP POWER KS PLOT
C                 JACKNIFE/BOOTSTRAP VON MISES KS PLOT
C                 JACKNIFE/BOOTSTRAP WRAPPED CAUCHY KS PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED LOGISTIC KS PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED LOGISTIC TYPE 2
C                                    KS PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED LOGISTIC TYPE 3
C                                    KS PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED LOGISTIC TYPE 5
C                                    KS PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED HALF LOGISTIC
C                                    KS PLOT
C                 JACKNIFE/BOOTSTRAP PARETO SECOND KIND KS PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED LOGISTIC KS PLOT
C              ONE SHAPE PARAMETER AND SCALE
C                 JACKNIFE/BOOTSTRAP WEIBULL MLE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP LOGNORMAL MLE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GAMMA MLE <CENSORED> PLOT
C                 JACKNIFE/BOOTSTRAP GEOM EXTR EXPO MLE PLOT
C                 JACKNIFE/BOOTSTRAP FATIGUE LIFE MLE PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED PARETO MLE PLOT
C                 JACKNIFE/BOOTSTRAP GENERALIZED PARETO MOME PLOT
C                 JACKNIFE/BOOTSTRAP FRECHET MLE PLOT
C                 JACKNIFE/BOOTSTRAP INVERTED WEIBULL MLE <CENSORED> PLOT
C              TWO SHAPE PARAMETERS
C                 JACKNIFE/BOOTSTRAP INVERSE GAUSSIAN MLE PLOT
C                 JACKNIFE/BOOTSTRAP PARETO MLE PLOT
C                 JACKNIFE/BOOTSTRAP FOLDED NORMAL MLE PLOT
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --FEBRUARY  1994. SYNONYMS FOR TAGUCHI
C     UPDATED         --MARCH     1995. MAD AND AAD PLOTS
C     UPDATED         --MARCH     1998. SAVE CERTAIN PERCENTILE PARAMETERS
C                                       AUTOMATICALLY
C     UPDATED         --MARCH     1998. ACTIVATE RELATIVE VARIANCE AND
C                                       COEFFICENT OF VARIATION
C     UPDATED         --NOVEMBER  1998. ADD PERCENTILE PLOTS
C     UPDATED         --MARCH     1999. ADD GEOMETRIC MEAN
C     UPDATED         --MARCH     1999. ADD GEOMETRIC STAND DEVIATION
C     UPDATED         --MARCH     1999. ADD HARMONIC MEAN
C     UPDATED         --SEPTEMBER 2001. ADD IQ RANGE
C     UPDATED         --NOVEMBER  2001. ADD BIWEIGHT LOCATION
C     UPDATED         --NOVEMBER  2001. ADD BIWEIGHT SCALE
C     UPDATED         --JULY      2002. ADD WINSORIZED VARIANCE
C     UPDATED         --JULY      2002. ADD WINSORIZED SD
C     UPDATED         --JULY      2002. ADD WINSORIZED COVARIANCE
C     UPDATED         --JULY      2002. ADD WINSORIZED CORRELATION
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDVARIANCE
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCOVARIANCE
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCORRELATION
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND MIDVARIANCE
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND CORRELATION
C     UPDATED         --JULY      2002. ADD HODGES LEHMAN
C     UPDATED         --JULY      2002. ADD QUANTILE
C     UPDATED         --JULY      2002. ADD QUANTILE STANDARD ERROR
C     UPDATED         --JULY      2002. ADD TRIMMED MEAN STANDARD ERROR
C     UPDATED         --JULY      2002. ADD LINEAR CALIBRATION
C     UPDATED         --JULY      2002. ADD QUADRATIC CALIBRATION
C     UPDATED         --MARCH     2003. ADD 34 "DIFFERENCE OF" STATS
C     UPDATED         --MARCH     2003. FOR "DIFFERENCE OF" STATS,
C                                       DISTINGUISH BETWEEN INDEPENDENT
C                                       AND DEPENDENT GROUPS
C     UPDATED         --APRIL     2003. ADD SN AND QN (AND DIFFERENCE
C                                       OF).  REQUIRED ADDITIONAL
C                                       SCRATCH ARRAYS.
C     UPDATED         --JULY      2003. SUPPORT FOR TWO GROUP VARIABLES
C     UPDATED         --SEPTEMBER 2003. SUPPORT FOR BCA CONFIDENCE INTERVAL
C     UPDATED         --JANUARY   2005. MAKE COMMAND SEARCH TABLE
C                                       DRIVEN
C     UPDATED         --JANUARY   2005. SUPPORT FOR BOOTSTRAPPING OF
C                                       DISTRIBUTIONAL MODELS
C     UPDATED         --MARCH     2005. ADD GENERALIZED PARETO MLE
C                                       AND MOMENTS
C     UPDATED         --MAY       2005. ADD FRECHET MLE
C     UPDATED         --AUGUST    2005. ADD INVERTED WEIBULL MLE
C     UPDATED         --SEPTEMBER 2005. ADD RATIO
C     UPDATED         --MARCH     2006. UNIFORM MLE PLOT AS SYNONYM
C                                       FOR UNIFORM MAXI LIKE
C     UPDATED         --MARCH     2006. ADD GENERALIZIED LOGISTIC
C                                       TYPE 2 - TYPE 5
C     UPDATED         --MARCH     2006. ADD BETA NORMAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASJB
      CHARACTER*4 IFLAGD
      CHARACTER*4 IFLAGV
      CHARACTER*4 IBCABT
      CHARACTER*4 ICENSO
      CHARACTER*4 IMETHD
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IHX
      CHARACTER*4 IHX2
      CHARACTER*4 IHXG
      CHARACTER*4 IHXG2
      CHARACTER*4 IH41
      CHARACTER*4 IH42
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ISTATN(17)
      CHARACTER*4 ISTAT2(17)
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMCHS=513)
      CHARACTER*4 INAME(NUMCHS,6)
      CHARACTER*4 INCASE(NUMCHS)
      CHARACTER*4 INFLAV(NUMCHS)
      CHARACTER*4 INFLAD(NUMCHS)
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Z1(MAXOBV)
      DIMENSION X1(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      DIMENSION TEMP0(MAXOBV)
      DIMENSION TEMPZ0(MAXOBV)
      DIMENSION RES1(MAXOBV)
      DIMENSION RES2(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      DIMENSION TEMP4(MAXOBV)
      DIMENSION TEMP5(MAXOBV)
      DIMENSION XGRP2(MAXOBV)
      DIMENSION TEMPTH(MAXOBV)
      DIMENSION TEMPT2(MAXOBV)
      DIMENSION TEMP6(MAXOBV)
      DIMENSION TEMP7(MAXOBV)
      DIMENSION TEMP8(MAXOBV)
      DIMENSION QP(MAXOBV)
      DIMENSION XPERC(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Z1(1))
      EQUIVALENCE (GARBAG(IGARB3),X1(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP0(1))
      EQUIVALENCE (GARBAG(IGARB5),TEMPZ0(1))
      EQUIVALENCE (GARBAG(IGARB6),RES1(1))
      EQUIVALENCE (GARBAG(IGARB7),RES2(1))
      EQUIVALENCE (GARBAG(IGARB8),XTEMP3(1))
      EQUIVALENCE (GARBAG(IGARB9),TEMP4(1))
      EQUIVALENCE (GARBAG(IGAR10),TEMP5(1))
      EQUIVALENCE (GARBAG(JGAR11),XGRP2(1))
      EQUIVALENCE (GARBAG(JGAR12),TEMPTH(1))
      EQUIVALENCE (GARBAG(JGAR13),TEMP6(1))
      EQUIVALENCE (GARBAG(JGAR14),TEMP7(1))
      EQUIVALENCE (GARBAG(JGAR15),TEMP8(1))
      EQUIVALENCE (GARBAG(JGAR16),TEMPT2(1))
      EQUIVALENCE (GARBAG(JGAR17),QP(1))
      EQUIVALENCE (GARBAG(JGAR18),XPERC(1))
C
      INCLUDE 'DPCOZI.INC'
C
      INTEGER ITEMP1(MAXOBV)
      INTEGER ITEMP2(MAXOBV)
      INTEGER ITEMP3(MAXOBV)
      INTEGER ITEMP4(MAXOBV)
      INTEGER ITEMP5(MAXOBV)
      INTEGER ITEMP6(MAXOBV)
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5(1))
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6(1))
C
      INCLUDE 'DPCOZD.INC'
C
      DOUBLE PRECISION DTEMP1(MAXOBV)
      DOUBLE PRECISION DTEMP2(MAXOBV)
      DOUBLE PRECISION DTEMP3(MAXOBV)
      DOUBLE PRECISION DTEMP4(MAXOBV)
      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1(1))
      EQUIVALENCE (DGARBG(IDGAR2),DTEMP2(1))
      EQUIVALENCE (DGARBG(IDGAR3),DTEMP3(1))
      EQUIVALENCE (DGARBG(IDGAR4),DTEMP4(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOS2.INC'
      INCLUDE 'DPCOMC.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
      DATA (ISTATN(I),I=1,17)/
     1'BSD ',
     1'BMEA',
     1'B975',
     1'B025',
     1'B001',
     1'B005',
     1'B01 ',
     1'B05 ',
     1'B10 ',
     1'B20 ',
     1'B50 ',
     1'B80 ',
     1'B90 ',
     1'B95 ',
     1'B99 ',
     1'B995',
     1'B999'/
      DATA (ISTAT2(I),I=1,17)/
     1'    ',
     1'N   ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    ',
     1'    '/
C
      DATA INCASE(1)/'NUMB'/
      DATA (INAME(1,J),J=1,6)/
     1'NUMB','    ','    ','    ','    ','    '/
      DATA INFLAV(1)/'ONE '/
      DATA INFLAD(1)/'OFF '/
C
      DATA INCASE(2)/'NUMB'/
      DATA (INAME(2,J),J=1,6)/
     1 'SIZE','    ','    ','    ','    ','    '/
      DATA INFLAV(2)/'ONE '/
      DATA INFLAD(2)/'OFF '/
C
      DATA INCASE(3)/'NUMB'/
      DATA (INAME(3,J),J=1,6)/
     1'COUN','    ','    ','    ','    ','    '/
      DATA INFLAV(3)/'ONE '/
      DATA INFLAD(3)/'OFF '/
C
      DATA INCASE(4)/'NUMB'/
      DATA (INAME(4,J),J=1,6)/
     1'SAMP','SIZE','    ','    ','    ','    '/
      DATA INFLAV(4)/'ONE '/
      DATA INFLAD(4)/'OFF '/
C
      DATA INCASE(5)/'NUMB'/
      DATA (INAME(5,J),J=1,6)/
     1'SUBS','SIZE','    ','    ','    ','    '/
      DATA INFLAV(5)/'ONE '/
      DATA INFLAD(5)/'OFF '/
C
      DATA INCASE(6)/'SUM '/
      DATA (INAME(6,J),J=1,6)/
     1'SUM ','    ','    ','    ','    ','    '/
      DATA INFLAV(6)/'ONE '/
      DATA INFLAD(6)/'OFF '/
C
      DATA INCASE(7)/'PROD'/
      DATA (INAME(7,J),J=1,6)/
     1'PROD','    ','    ','    ','    ','    '/
      DATA INFLAV(7)/'ONE '/
      DATA INFLAD(7)/'OFF '/
C
      DATA INCASE(8)/'MIDR'/
      DATA (INAME(8,J),J=1,6)/
     1'MIDR','    ','    ','    ','    ','    '/
      DATA INFLAV(8)/'ONE '/
      DATA INFLAD(8)/'OFF '/
C
      DATA INCASE(9)/'MEAN'/
      DATA (INAME(9,J),J=1,6)/
     1'MEAN','    ','    ','    ','    ','    '/
      DATA INFLAV(9)/'ONE '/
      DATA INFLAD(9)/'OFF '/
C
      DATA INCASE(10)/'AAD '/
      DATA (INAME(10,J),J=1,6)/
     1'AAD ','    ','    ','    ','    ','    '/
      DATA INFLAV(10)/'ONE '/
      DATA INFLAD(10)/'OFF '/
C
      DATA INCASE(11)/'AAD '/
      DATA (INAME(11,J),J=1,6)/
     1'AVER','ABSO','DEVI','    ','    ','    '/
      DATA INFLAV(11)/'ONE '/
      DATA INFLAD(11)/'OFF '/
C
      DATA INCASE(12)/'MEAN'/
      DATA (INAME(12,J),J=1,6)/
     1'AVER','    ','    ','    ','    ','    '/
      DATA INFLAV(12)/'ONE '/
      DATA INFLAD(12)/'OFF '/
C
      DATA INCASE(13)/'MIDM'/
      DATA (INAME(13,J),J=1,6)/
     1'MIDM','    ','    ','    ','    ','    '/
      DATA INFLAV(13)/'ONE '/
      DATA INFLAD(13)/'OFF '/
C
      DATA INCASE(15)/'MAD '/
      DATA (INAME(15,J),J=1,6)/
     1'MAD ','    ','    ','    ','    ','    '/
      DATA INFLAV(15)/'ONE '/
      DATA INFLAD(15)/'OFF '/
C
      DATA INCASE(16)/'MAD '/
      DATA (INAME(16,J),J=1,6)/
     1'MEDI','ABSO','DEVI','    ','    ','    '/
      DATA INFLAV(16)/'ONE '/
      DATA INFLAD(16)/'OFF '/
C
      DATA INCASE(17)/'MEDI'/
      DATA (INAME(17,J),J=1,6)/
     1'MEDI','    ','    ','    ','    ','    '/
      DATA INFLAV(17)/'ONE '/
      DATA INFLAD(17)/'OFF '/
C
      DATA INCASE(18)/'TRIM'/
      DATA (INAME(18,J),J=1,6)/
     1'TRIM','MEAN','    ','    ','    ','    '/
      DATA INFLAV(18)/'ONE '/
      DATA INFLAD(18)/'OFF '/
C
      DATA INCASE(19)/'WINM'/
      DATA (INAME(19,J),J=1,6)/
     1'WINS','MEAN','    ','    ','    ','    '/
      DATA INFLAV(19)/'ONE '/
      DATA INFLAD(19)/'OFF '/
C
      DATA INCASE(20)/'WINM'/
      DATA (INAME(20,J),J=1,6)/
     1'WIND','MEAN','    ','    ','    ','    '/
      DATA INFLAV(20)/'ONE '/
      DATA INFLAD(20)/'OFF '/
C
      DATA INCASE(21)/'RANG'/
      DATA (INAME(21,J),J=1,6)/
     1'RANG','    ','    ','    ','    ','    '/
      DATA INFLAV(21)/'ONE '/
      DATA INFLAD(21)/'OFF '/
C
      DATA INCASE(22)/'RANG'/
      DATA (INAME(22,J),J=1,6)/
     1'R   ','    ','    ','    ','    ','    '/
      DATA INFLAV(22)/'ONE '/
      DATA INFLAD(22)/'OFF '/
C
      DATA INCASE(23)/'MINI'/
      DATA (INAME(23,J),J=1,6)/
     1'MINI','    ','    ','    ','    ','    '/
      DATA INFLAV(23)/'ONE '/
      DATA INFLAD(23)/'OFF '/
C
      DATA INCASE(24)/'MAXI'/
      DATA (INAME(24,J),J=1,6)/
     1'MAXI','    ','    ','    ','    ','    '/
      DATA INFLAV(24)/'ONE '/
      DATA INFLAD(24)/'OFF '/
C
      DATA INCASE(25)/'EXTR'/
      DATA (INAME(25,J),J=1,6)/
     1'EXTR','    ','    ','    ','    ','    '/
      DATA INFLAV(25)/'ONE '/
      DATA INFLAD(25)/'OFF '/
C
      DATA INCASE(26)/'VM  '/
      DATA (INAME(26,J),J=1,6)/
     1'VARI','OF  ','THE ','MEAN','    ','    '/
      DATA INFLAV(26)/'ONE '/
      DATA INFLAD(26)/'OFF '/
C
      DATA INCASE(27)/'VM  '/
      DATA (INAME(27,J),J=1,6)/
     1'VARI','OF  ','MEAN','    ','    ','    '/
      DATA INFLAV(27)/'ONE '/
      DATA INFLAD(27)/'OFF '/
C
      DATA INCASE(28)/'VM  '/
      DATA (INAME(28,J),J=1,6)/
     1'VARI','MEAN','    ','    ','    ','    '/
      DATA INFLAV(28)/'ONE '/
      DATA INFLAD(28)/'OFF '/
C
      DATA INCASE(29)/'VARI'/
      DATA (INAME(29,J),J=1,6)/
     1'VARI','    ','    ','    ','    ','    '/
      DATA INFLAV(29)/'ONE '/
      DATA INFLAD(29)/'OFF '/
C
      DATA INCASE(30)/'VARI'/
      DATA (INAME(30,J),J=1,6)/
     1'VARI','    ','    ','    ','    ','    '/
      DATA INFLAV(30)/'ONE '/
      DATA INFLAD(30)/'OFF '/
C
      DATA INCASE(31)/'SDM '/
      DATA (INAME(31,J),J=1,6)/
     1'STAN','DEVI','OF  ','THE ','MEAN','    '/
      DATA INFLAV(31)/'ONE '/
      DATA INFLAD(31)/'OFF '/
C
      DATA INCASE(32)/'SDM '/
      DATA (INAME(32,J),J=1,6)/
     1'STAN','DEVI','OF  ','MEAN','    ','    '/
      DATA INFLAV(32)/'ONE '/
      DATA INFLAD(32)/'OFF '/
C
      DATA INCASE(33)/'SDM '/
      DATA (INAME(33,J),J=1,6)/
     1'STAN','DEVI','MEAN','    ','    ','    '/
      DATA INFLAV(33)/'ONE '/
      DATA INFLAD(33)/'OFF '/
C
      DATA INCASE(34)/'SD  '/
      DATA (INAME(34,J),J=1,6)/
     1'STAN','DEVI','    ','    ','    ','    '/
      DATA INFLAV(34)/'ONE '/
      DATA INFLAD(34)/'OFF '/
C
      DATA INCASE(35)/'SD  '/
      DATA (INAME(35,J),J=1,6)/
     1'SD  ','    ','    ','    ','    ','    '/
      DATA INFLAV(35)/'ONE '/
      DATA INFLAD(35)/'OFF '/
C
      DATA INCASE(36)/'SD  '/
      DATA (INAME(36,J),J=1,6)/
     1'S   ','    ','    ','    ','    ','    '/
      DATA INFLAV(36)/'ONE '/
      DATA INFLAD(36)/'OFF '/
C
      DATA INCASE(37)/'RSD '/
      DATA (INAME(37,J),J=1,6)/
     1'RS  ','    ','    ','    ','    ','    '/
      DATA INFLAV(37)/'ONE '/
      DATA INFLAD(37)/'OFF '/
C
      DATA INCASE(38)/'RSD '/
      DATA (INAME(38,J),J=1,6)/
     1'RSD ','    ','    ','    ','    ','    '/
      DATA INFLAV(38)/'ONE '/
      DATA INFLAD(38)/'OFF '/
C
      DATA INCASE(39)/'RSD '/
      DATA (INAME(39,J),J=1,6)/
     1'RELS','    ','    ','    ','    ','    '/
      DATA INFLAV(39)/'ONE '/
      DATA INFLAD(39)/'OFF '/
C
      DATA INCASE(40)/'RSD '/
      DATA (INAME(40,J),J=1,6)/
     1'RELA','STAN','DEVI','    ','    ','    '/
      DATA INFLAV(40)/'ONE '/
      DATA INFLAD(40)/'OFF '/
C
      DATA INCASE(41)/'RSD '/
      DATA (INAME(41,J),J=1,6)/
     1'RELA','SD  ','    ','    ','    ','    '/
      DATA INFLAV(41)/'ONE '/
      DATA INFLAD(41)/'OFF '/
C
      DATA INCASE(42)/'RVAR'/
      DATA (INAME(42,J),J=1,6)/
     1'RELA','VARI','    ','    ','    ','    '/
      DATA INFLAV(42)/'ONE '/
      DATA INFLAD(42)/'OFF '/
C
      DATA INCASE(43)/'RVAR'/
      DATA (INAME(43,J),J=1,6)/
     1'RV  ','    ','    ','    ','    ','    '/
      DATA INFLAV(43)/'ONE '/
      DATA INFLAD(43)/'OFF '/
C
      DATA INCASE(44)/'RVAR'/
      DATA (INAME(44,J),J=1,6)/
     1'RELV','    ','    ','    ','    ','    '/
      DATA INFLAV(44)/'ONE '/
      DATA INFLAD(44)/'OFF '/
C
      DATA INCASE(45)/'RVAR'/
      DATA (INAME(45,J),J=1,6)/
     1'RVAR','    ','    ','    ','    ','    '/
      DATA INFLAV(45)/'ONE '/
      DATA INFLAD(45)/'OFF '/
C
      DATA INCASE(46)/'CVAR'/
      DATA (INAME(46,J),J=1,6)/
     1'COEF','VARI','    ','    ','    ','    '/
      DATA INFLAV(46)/'ONE '/
      DATA INFLAD(46)/'OFF '/
C
      DATA INCASE(47)/'CVAR'/
      DATA (INAME(47,J),J=1,6)/
     1'COEF','OF  ','VARI','    ','    ','    '/
      DATA INFLAV(47)/'ONE '/
      DATA INFLAD(47)/'OFF '/
C
      DATA INCASE(48)/'CVAR'/
      DATA (INAME(48,J),J=1,6)/
     1'COEF','OF  ','VARI','    ','    ','    '/
      DATA INFLAV(48)/'ONE '/
      DATA INFLAD(48)/'OFF '/
C
      DATA INCASE(49)/'LOWQ'/
      DATA (INAME(49,J),J=1,6)/
     1'LOWE','QUAR','    ','    ','    ','    '/
      DATA INFLAV(49)/'ONE '/
      DATA INFLAD(49)/'OFF '/
C
      DATA INCASE(50)/'LOWQ'/
      DATA (INAME(50,J),J=1,6)/
     1'FIRS','QUAR','    ','    ','    ','    '/
      DATA INFLAV(50)/'ONE '/
      DATA INFLAD(50)/'OFF '/
C
      DATA INCASE(51)/'MIDQ'/
      DATA (INAME(51,J),J=1,6)/
     1'SECO','QUAR','    ','    ','    ','    '/
      DATA INFLAV(51)/'ONE '/
      DATA INFLAD(51)/'OFF '/
C
      DATA INCASE(52)/'UPPQ'/
      DATA (INAME(52,J),J=1,6)/
     1'THIR','QUAR','    ','    ','    ','    '/
      DATA INFLAV(52)/'ONE '/
      DATA INFLAD(52)/'OFF '/
C
      DATA INCASE(53)/'UPPQ'/
      DATA (INAME(53,J),J=1,6)/
     1'UPPE','QUAR','    ','    ','    ','    '/
      DATA INFLAV(53)/'ONE '/
      DATA INFLAD(53)/'OFF '/
C
      DATA INCASE(54)/'UPPH'/
      DATA (INAME(54,J),J=1,6)/
     1'UPPE','HING','    ','    ','    ','    '/
      DATA INFLAV(54)/'ONE '/
      DATA INFLAD(54)/'OFF '/
C
      DATA INCASE(55)/'LOWH'/
      DATA (INAME(55,J),J=1,6)/
     1'LOWE','HING','    ','    ','    ','    '/
      DATA INFLAV(55)/'ONE '/
      DATA INFLAD(55)/'OFF '/
C
      DATA INCASE(56)/'SKEW'/
      DATA (INAME(56,J),J=1,6)/
     1'STAN','THIR','CENT','MOME','    ','    '/
      DATA INFLAV(56)/'ONE '/
      DATA INFLAD(56)/'OFF '/
C
      DATA INCASE(57)/'SKEW'/
      DATA (INAME(57,J),J=1,6)/
     1'STAN','3RD ','CENT','MOME','    ','    '/
      DATA INFLAV(57)/'ONE '/
      DATA INFLAD(57)/'OFF '/
C
      DATA INCASE(58)/'SKEW'/
      DATA (INAME(58,J),J=1,6)/
     1'SKEW','    ','    ','    ','    ','    '/
      DATA INFLAV(58)/'ONE '/
      DATA INFLAD(58)/'OFF '/
C
      DATA INCASE(59)/'KURT'/
      DATA (INAME(59,J),J=1,6)/
     1'STAN','FOUR','CENT','MOME','    ','    '/
      DATA INFLAV(59)/'ONE '/
      DATA INFLAD(59)/'OFF '/
C
      DATA INCASE(60)/'KURT'/
      DATA (INAME(60,J),J=1,6)/
     1'STAN','4TH ','CENT','MOME','    ','    '/
      DATA INFLAV(60)/'ONE '/
      DATA INFLAD(60)/'OFF '/
C
      DATA INCASE(61)/'KURT'/
      DATA (INAME(61,J),J=1,6)/
     1'KURT','    ','    ','    ','    ','    '/
      DATA INFLAV(61)/'ONE '/
      DATA INFLAD(61)/'OFF '/
C
      DATA INCASE(62)/'AUCV'/
      DATA (INAME(62,J),J=1,6)/
     1'AUTO','STAT','PLOT','    ','    ','    '/
      DATA INFLAV(62)/'ONE '/
      DATA INFLAD(62)/'OFF '/
C
      DATA INCASE(63)/'AUCR'/
      DATA (INAME(63,J),J=1,6)/
     1'AUTO','STAT','PLOT','    ','    ','    '/
      DATA INFLAV(63)/'ONE '/
      DATA INFLAD(63)/'OFF '/
C
      DATA INCASE(64)/'AUCR'/
      DATA (INAME(64,J),J=1,6)/
     1'AUTO','    ','    ','    ','    ','    '/
      DATA INFLAV(64)/'ONE '/
      DATA INFLAD(64)/'OFF '/
C
      DATA INCASE(65)/'AUCV'/
      DATA (INAME(65,J),J=1,6)/
     1'AUTO','    ','    ','    ','    ','    '/
      DATA INFLAV(65)/'ONE '/
      DATA INFLAD(65)/'OFF '/
C
      DATA INCASE(66)/'RACV'/
      DATA (INAME(66,J),J=1,6)/
     1'RANK','COVA','    ','    ','    ','    '/
      DATA INFLAV(66)/'TWO '/
      DATA INFLAD(66)/'OFF '/
C
      DATA INCASE(67)/'RACR'/
      DATA (INAME(67,J),J=1,6)/
     1'RANK','CORR','    ','    ','    ','    '/
      DATA INFLAV(67)/'TWO '/
      DATA INFLAD(67)/'OFF '/
C
      DATA INCASE(68)/'KTAU'/
      DATA (INAME(68,J),J=1,6)/
     1'KEND','TAU ','    ','    ','    ','    '/
      DATA INFLAV(68)/'TWO '/
      DATA INFLAD(68)/'OFF '/
C
      DATA INCASE(69)/'KTAU'/
      DATA (INAME(69,J),J=1,6)/
     1'KEND','TAU ','    ','    ','    ','    '/
      DATA INFLAV(69)/'TWO '/
      DATA INFLAD(69)/'OFF '/
C
      DATA INCASE(70)/'1DEC'/
      DATA (INAME(70,J),J=1,6)/
     1'FIRS','DECI','    ','    ','    ','    '/
      DATA INFLAV(70)/'ONE '/
      DATA INFLAD(70)/'OFF '/
C
      DATA INCASE(71)/'2DEC'/
      DATA (INAME(71,J),J=1,6)/
     1'SECO','DECI','    ','    ','    ','    '/
      DATA INFLAV(71)/'ONE '/
      DATA INFLAD(71)/'OFF '/
C
      DATA INCASE(72)/'3DEC'/
      DATA (INAME(72,J),J=1,6)/
     1'THIR','DECI','    ','    ','    ','    '/
      DATA INFLAV(72)/'ONE '/
      DATA INFLAD(72)/'OFF '/
C
      DATA INCASE(73)/'4DEC'/
      DATA (INAME(73,J),J=1,6)/
     1'FOUR','DECI','    ','    ','    ','    '/
      DATA INFLAV(73)/'ONE '/
      DATA INFLAD(73)/'OFF '/
C
      DATA INCASE(74)/'5DEC'/
      DATA (INAME(74,J),J=1,6)/
     1'FIFT','DECI','    ','    ','    ','    '/
      DATA INFLAV(74)/'ONE '/
      DATA INFLAD(74)/'OFF '/
C
      DATA INCASE(75)/'6DEC'/
      DATA (INAME(75,J),J=1,6)/
     1'SIXT','DECI','    ','    ','    ','    '/
      DATA INFLAV(75)/'ONE '/
      DATA INFLAD(75)/'OFF '/
C
      DATA INCASE(76)/'7DEC'/
      DATA (INAME(76,J),J=1,6)/
     1'SEVE','DECI','    ','    ','    ','    '/
      DATA INFLAV(76)/'ONE '/
      DATA INFLAD(76)/'OFF '/
C
      DATA INCASE(77)/'8DEC'/
      DATA (INAME(77,J),J=1,6)/
     1'EIGH','DECI','    ','    ','    ','    '/
      DATA INFLAV(77)/'ONE '/
      DATA INFLAD(77)/'OFF '/
C
      DATA INCASE(78)/'9DEC'/
      DATA (INAME(78,J),J=1,6)/
     1'NINT','DECI','    ','    ','    ','    '/
      DATA INFLAV(78)/'ONE '/
      DATA INFLAD(78)/'OFF '/
C
      DATA INCASE(79)/'PERC'/
      DATA (INAME(79,J),J=1,6)/
     1'PERC','    ','    ','    ','    ','    '/
      DATA INFLAV(79)/'ONE '/
      DATA INFLAD(79)/'OFF '/
C
      DATA INCASE(80)/'SIFR'/
      DATA (INAME(80,J),J=1,6)/
     1'SIN ','FREQ','    ','    ','    ','    '/
      DATA INFLAV(80)/'TWO '/
      DATA INFLAD(80)/'OFF '/
C
      DATA INCASE(81)/'SIFR'/
      DATA (INAME(81,J),J=1,6)/
     1'SINE','FREQ','    ','    ','    ','    '/
      DATA INFLAV(81)/'TWO '/
      DATA INFLAD(81)/'OFF '/
C
      DATA INCASE(82)/'SIAM'/
      DATA (INAME(82,J),J=1,6)/
     1'SIN ','AMPL','    ','    ','    ','    '/
      DATA INFLAV(82)/'TWO '/
      DATA INFLAD(82)/'OFF '/
C
      DATA INCASE(83)/'SIAM'/
      DATA (INAME(83,J),J=1,6)/
     1'SINE','AMPL','    ','    ','    ','    '/
      DATA INFLAV(83)/'TWO '/
      DATA INFLAD(83)/'OFF '/
C
      DATA INCASE(84)/'LIIN'/
      DATA (INAME(84,J),J=1,6)/
     1'LINE','INTE','    ','    ','    ','    '/
      DATA INFLAV(84)/'TWO '/
      DATA INFLAD(84)/'OFF '/
C
      DATA INCASE(85)/'LISL'/
      DATA (INAME(85,J),J=1,6)/
     1'LINE','SLOP','    ','    ','    ','    '/
      DATA INFLAV(85)/'TWO '/
      DATA INFLAD(85)/'OFF '/
C
      DATA INCASE(86)/'LIRE'/
      DATA (INAME(86,J),J=1,6)/
     1'LINE','RESS','    ','    ','    ','    '/
      DATA INFLAV(86)/'TWO '/
      DATA INFLAD(86)/'OFF '/
C
      DATA INCASE(87)/'LIRE'/
      DATA (INAME(87,J),J=1,6)/
     1'LINE','RESI','SD  ','    ','    ','    '/
      DATA INFLAV(87)/'TWO '/
      DATA INFLAD(87)/'OFF '/
C
      DATA INCASE(88)/'LIRE'/
      DATA (INAME(88,J),J=1,6)/
     1'LINE','RESI','STAN','DEVI','    ','    '/
      DATA INFLAV(88)/'TWO '/
      DATA INFLAD(88)/'OFF '/
C
      DATA INCASE(89)/'LICO'/
      DATA (INAME(89,J),J=1,6)/
     1'LINE','CORR','    ','    ','    ','    '/
      DATA INFLAV(89)/'TWO '/
      DATA INFLAD(89)/'OFF '/
C
      DATA INCASE(90)/'SNSC'/
      DATA (INAME(90,J),J=1,6)/
     1'SN  ','SCAL','    ','    ','    ','    '/
      DATA INFLAV(90)/'ONE '/
      DATA INFLAD(90)/'OFF '/
C
      DATA INCASE(91)/'QNSC'/
      DATA (INAME(91,J),J=1,6)/
     1'QN  ','SCAL','    ','    ','    ','    '/
      DATA INFLAV(91)/'ONE '/
      DATA INFLAD(91)/'OFF '/
C
      DATA INCASE(92)/'SN0 '/
      DATA (INAME(92,J),J=1,6)/
     1'TAGU','SN  ','    ','    ','    ','    '/
      DATA INFLAV(92)/'ONE '/
      DATA INFLAD(92)/'OFF '/
C
      DATA INCASE(93)/'SN0 '/
      DATA (INAME(93,J),J=1,6)/
     1'TAGU','SN0 ','    ','    ','    ','    '/
      DATA INFLAV(93)/'ONE '/
      DATA INFLAD(93)/'OFF '/
C
      DATA INCASE(94)/'SN0 '/
      DATA (INAME(94,J),J=1,6)/
     1'TAGU','SNT ','    ','    ','    ','    '/
      DATA INFLAV(94)/'ONE '/
      DATA INFLAD(94)/'OFF '/
C
      DATA INCASE(95)/'SN0 '/
      DATA (INAME(95,J),J=1,6)/
     1'TAGU','SNN ','    ','    ','    ','    '/
      DATA INFLAV(95)/'ONE '/
      DATA INFLAD(95)/'OFF '/
C
      DATA INCASE(96)/'SN0 '/
      DATA (INAME(96,J),J=1,6)/
     1'TAGU','SNT1','    ','    ','    ','    '/
      DATA INFLAV(96)/'ONE '/
      DATA INFLAD(96)/'OFF '/
C
      DATA INCASE(97)/'SN0 '/
      DATA (INAME(97,J),J=1,6)/
     1'TAGU','SNN1','    ','    ','    ','    '/
      DATA INFLAV(97)/'ONE '/
      DATA INFLAD(97)/'OFF '/
C
      DATA INCASE(98)/'SN0 '/
      DATA (INAME(98,J),J=1,6)/
     1'TAGU','SN1 ','    ','    ','    ','    '/
      DATA INFLAV(98)/'ONE '/
      DATA INFLAD(98)/'OFF '/
C
      DATA INCASE(99)/'SN+ '/
      DATA (INAME(99,J),J=1,6)/
     1'TAGU','SNL ','    ','    ','    ','    '/
      DATA INFLAV(99)/'ONE '/
      DATA INFLAD(99)/'OFF '/
C
      DATA INCASE(100)/'SN+ '/
      DATA (INAME(100,J),J=1,6)/
     1'TAGU','SNB ','    ','    ','    ','    '/
      DATA INFLAV(100)/'ONE '/
      DATA INFLAD(100)/'OFF '/
C
      DATA INCASE(101)/'SN+ '/
      DATA (INAME(101,J),J=1,6)/
     1'TAGU','SN+ ','    ','    ','    ','    '/
      DATA INFLAV(101)/'ONE '/
      DATA INFLAD(101)/'OFF '/
C
      DATA INCASE(102)/'SN- '/
      DATA (INAME(102,J),J=1,6)/
     1'TAGU','SNS ','    ','    ','    ','    '/
      DATA INFLAV(102)/'ONE '/
      DATA INFLAD(102)/'OFF '/
C
      DATA INCASE(103)/'SN- '/
      DATA (INAME(103,J),J=1,6)/
     1'TAGU','SN- ','    ','    ','    ','    '/
      DATA INFLAV(103)/'ONE '/
      DATA INFLAD(103)/'OFF '/
C
      DATA INCASE(104)/'SN00'/
      DATA (INAME(104,J),J=1,6)/
     1'TAGU','SN2 ','    ','    ','    ','    '/
      DATA INFLAV(104)/'ONE '/
      DATA INFLAD(104)/'OFF '/
C
      DATA INCASE(105)/'SN00'/
      DATA (INAME(105,J),J=1,6)/
     1'TAGU','SNT2','    ','    ','    ','    '/
      DATA INFLAV(105)/'ONE '/
      DATA INFLAD(105)/'OFF '/
C
      DATA INCASE(106)/'SN00'/
      DATA (INAME(106,J),J=1,6)/
     1'TAGU','SNN2','    ','    ','    ','    '/
      DATA INFLAV(106)/'ONE '/
      DATA INFLAD(106)/'OFF '/
C
      DATA INCASE(107)/'SN00'/
      DATA (INAME(107,J),J=1,6)/
     1'TAGU','SN00','    ','    ','    ','    '/
      DATA INFLAV(107)/'ONE '/
      DATA INFLAD(107)/'OFF '/
C
      DATA INCASE(108)/'SN0 '/
      DATA (INAME(108,J),J=1,6)/
     1'SN0 ','    ','    ','    ','    ','    '/
      DATA INFLAV(108)/'ONE '/
      DATA INFLAD(108)/'OFF '/
C
      DATA INCASE(109)/'SN0 '/
      DATA (INAME(109,J),J=1,6)/
     1'SN  ','    ','    ','    ','    ','    '/
      DATA INFLAV(109)/'ONE '/
      DATA INFLAD(109)/'OFF '/
C
      DATA INCASE(110)/'SN0 '/
      DATA (INAME(110,J),J=1,6)/
     1'SNT ','    ','    ','    ','    ','    '/
      DATA INFLAV(110)/'ONE '/
      DATA INFLAD(110)/'OFF '/
C
      DATA INCASE(111)/'SN0 '/
      DATA (INAME(111,J),J=1,6)/
     1'SNN ','    ','    ','    ','    ','    '/
      DATA INFLAV(111)/'ONE '/
      DATA INFLAD(111)/'OFF '/
C
      DATA INCASE(112)/'SN0 '/
      DATA (INAME(112,J),J=1,6)/
     1'SNT1','    ','    ','    ','    ','    '/
      DATA INFLAV(112)/'ONE '/
      DATA INFLAD(112)/'OFF '/
C
      DATA INCASE(113)/'SN0 '/
      DATA (INAME(113,J),J=1,6)/
     1'SNN1','    ','    ','    ','    ','    '/
      DATA INFLAV(113)/'ONE '/
      DATA INFLAD(113)/'OFF '/
C
      DATA INCASE(114)/'SN0 '/
      DATA (INAME(114,J),J=1,6)/
     1'SNN1','    ','    ','    ','    ','    '/
      DATA INFLAV(114)/'ONE '/
      DATA INFLAD(114)/'OFF '/
C
      DATA INCASE(115)/'SN0 '/
      DATA (INAME(115,J),J=1,6)/
     1'SN1 ','    ','    ','    ','    ','    '/
      DATA INFLAV(115)/'ONE '/
      DATA INFLAD(115)/'OFF '/
C
      DATA INCASE(116)/'SN+ '/
      DATA (INAME(116,J),J=1,6)/
     1'SNL ','    ','    ','    ','    ','    '/
      DATA INFLAV(116)/'ONE '/
      DATA INFLAD(116)/'OFF '/
C
      DATA INCASE(117)/'SN+ '/
      DATA (INAME(117,J),J=1,6)/
     1'SNB ','    ','    ','    ','    ','    '/
      DATA INFLAV(117)/'ONE '/
      DATA INFLAD(117)/'OFF '/
C
      DATA INCASE(118)/'SN+ '/
      DATA (INAME(118,J),J=1,6)/
     1'SN+ ','    ','    ','    ','    ','    '/
      DATA INFLAV(118)/'ONE '/
      DATA INFLAD(118)/'OFF '/
C
      DATA INCASE(119)/'SN- '/
      DATA (INAME(119,J),J=1,6)/
     1'SN- ','    ','    ','    ','    ','    '/
      DATA INFLAV(119)/'ONE '/
      DATA INFLAD(119)/'OFF '/
C
      DATA INCASE(120)/'SN00'/
      DATA (INAME(120,J),J=1,6)/
     1'SN00','    ','    ','    ','    ','    '/
      DATA INFLAV(120)/'ONE '/
      DATA INFLAD(120)/'OFF '/
C
      DATA INCASE(121)/'SN00'/
      DATA (INAME(121,J),J=1,6)/
     1'SNT2','    ','    ','    ','    ','    '/
      DATA INFLAV(121)/'ONE '/
      DATA INFLAD(121)/'OFF '/
C
      DATA INCASE(122)/'SN00'/
      DATA (INAME(122,J),J=1,6)/
     1'SNN2','    ','    ','    ','    ','    '/
      DATA INFLAV(122)/'ONE '/
      DATA INFLAD(122)/'OFF '/
C
      DATA INCASE(123)/'SN00'/
      DATA (INAME(123,J),J=1,6)/
     1'SN2 ','    ','    ','    ','    ','    '/
      DATA INFLAV(123)/'ONE '/
      DATA INFLAD(123)/'OFF '/
C
      DATA INCASE(124)/'GEME'/
      DATA (INAME(124,J),J=1,6)/
     1'GEOM','MEAN','    ','    ','    ','    '/
      DATA INFLAV(124)/'ONE '/
      DATA INFLAD(124)/'OFF '/
C
      DATA INCASE(125)/'GESD'/
      DATA (INAME(125,J),J=1,6)/
     1'GEOM','SD  ','    ','    ','    ','    '/
      DATA INFLAV(125)/'ONE '/
      DATA INFLAD(125)/'OFF '/
C
      DATA INCASE(126)/'GESD'/
      DATA (INAME(126,J),J=1,6)/
     1'GEOM','STAN','DEVI','    ','    ','    '/
      DATA INFLAV(126)/'ONE '/
      DATA INFLAD(126)/'OFF '/
C
      DATA INCASE(127)/'GESD'/
      DATA (INAME(127,J),J=1,6)/
     1'GEOM','STAN','DEVI','    ','    ','    '/
      DATA INFLAV(127)/'ONE '/
      DATA INFLAD(127)/'OFF '/
C
      DATA INCASE(128)/'HAME'/
      DATA (INAME(128,J),J=1,6)/
     1'HARM','MEAN','    ','    ','    ','    '/
      DATA INFLAV(128)/'ONE '/
      DATA INFLAD(128)/'OFF '/
C
      DATA INCASE(129)/'IQRA'/
      DATA (INAME(129,J),J=1,6)/
     1'IQ  ','RANG','    ','    ','    ','    '/
      DATA INFLAV(129)/'ONE '/
      DATA INFLAD(129)/'OFF '/
C
      DATA INCASE(130)/'IQRA'/
      DATA (INAME(130,J),J=1,6)/
     1'INTE','RANG','    ','    ','    ','    '/
      DATA INFLAV(130)/'ONE '/
      DATA INFLAD(130)/'OFF '/
C
      DATA INCASE(131)/'BILO'/
      DATA (INAME(131,J),J=1,6)/
     1'BIWE','LOCA','    ','    ','    ','    '/
      DATA INFLAV(131)/'ONE '/
      DATA INFLAD(131)/'OFF '/
C
      DATA INCASE(132)/'BISC'/
      DATA (INAME(132,J),J=1,6)/
     1'BIWE','SCAL','    ','    ','    ','    '/
      DATA INFLAV(132)/'ONE '/
      DATA INFLAD(132)/'OFF '/
C
      DATA INCASE(133)/'WIVA'/
      DATA (INAME(133,J),J=1,6)/
     1'WINS','VARI','    ','    ','    ','    '/
      DATA INFLAV(133)/'ONE '/
      DATA INFLAD(133)/'OFF '/
C
      DATA INCASE(134)/'WIVA'/
      DATA (INAME(134,J),J=1,6)/
     1'WIND','VARI','    ','    ','    ','    '/
      DATA INFLAV(134)/'ONE '/
      DATA INFLAD(134)/'OFF '/
C
      DATA INCASE(135)/'WISD'/
      DATA (INAME(135,J),J=1,6)/
     1'WINS','SD  ','    ','    ','    ','    '/
      DATA INFLAV(135)/'ONE '/
      DATA INFLAD(135)/'OFF '/
C
      DATA INCASE(136)/'WISD'/
      DATA (INAME(136,J),J=1,6)/
     1'WIND','SD  ','    ','    ','    ','    '/
      DATA INFLAV(136)/'ONE '/
      DATA INFLAD(136)/'OFF '/
C
      DATA INCASE(137)/'WISD'/
      DATA (INAME(137,J),J=1,6)/
     1'WINS','STAN','DEVI','    ','    ','    '/
      DATA INFLAV(137)/'ONE '/
      DATA INFLAD(137)/'OFF '/
C
      DATA INCASE(138)/'WISD'/
      DATA (INAME(138,J),J=1,6)/
     1'WIND','STAN','DEVI','    ','    ','    '/
      DATA INFLAV(138)/'ONE '/
      DATA INFLAD(138)/'OFF '/
C
      DATA INCASE(139)/'WICV'/
      DATA (INAME(139,J),J=1,6)/
     1'WINS','COVA','    ','    ','    ','    '/
      DATA INFLAV(139)/'TWO '/
      DATA INFLAD(139)/'OFF '/
C
      DATA INCASE(140)/'WICV'/
      DATA (INAME(140,J),J=1,6)/
     1'WIND','COVA','    ','    ','    ','    '/
      DATA INFLAV(140)/'TWO '/
      DATA INFLAD(140)/'OFF '/
C
      DATA INCASE(141)/'WICR'/
      DATA (INAME(141,J),J=1,6)/
     1'WINS','CORR','    ','    ','    ','    '/
      DATA INFLAV(141)/'TWO '/
      DATA INFLAD(141)/'OFF '/
C
      DATA INCASE(142)/'WICR'/
      DATA (INAME(142,J),J=1,6)/
     1'WIND','CORR','    ','    ','    ','    '/
      DATA INFLAV(142)/'TWO '/
      DATA INFLAD(142)/'OFF '/
C
      DATA INCASE(143)/'BICR'/
      DATA (INAME(143,J),J=1,6)/
     1'BIWE','MIDC','    ','    ','    ','    '/
      DATA INFLAV(143)/'TWO '/
      DATA INFLAD(143)/'OFF '/
C
      DATA INCASE(144)/'BICR'/
      DATA (INAME(144,J),J=1,6)/
     1'BIWE','MID ','CORR','    ','    ','    '/
      DATA INFLAV(144)/'TWO '/
      DATA INFLAD(144)/'OFF '/
C
      DATA INCASE(145)/'BIMV'/
      DATA (INAME(145,J),J=1,6)/
     1'BIWE','MID ','VARI','    ','    ','    '/
      DATA INFLAV(145)/'ONE '/
      DATA INFLAD(145)/'OFF '/
C
      DATA INCASE(146)/'BIMV'/
      DATA (INAME(146,J),J=1,6)/
     1'BIWE','MIDV','    ','    ','    ','    '/
      DATA INFLAV(146)/'ONE '/
      DATA INFLAD(146)/'OFF '/
C
      DATA INCASE(147)/'PBMV'/
      DATA (INAME(147,J),J=1,6)/
     1'PERC','BEND','MIDV','    ','    ','    '/
      DATA INFLAV(147)/'ONE '/
      DATA INFLAD(147)/'OFF '/
C
      DATA INCASE(148)/'HLEH'/
      DATA (INAME(148,J),J=1,6)/
     1'HODG','LEHM','    ','    ','    ','    '/
      DATA INFLAV(148)/'ONE '/
      DATA INFLAD(148)/'OFF '/
C
      DATA INCASE(149)/'QUSE'/
      DATA (INAME(149,J),J=1,6)/
     1'QUAN','STAN','ERRO','    ','    ','    '/
      DATA INFLAV(149)/'ONE '/
      DATA INFLAD(149)/'OFF '/
C
      DATA INCASE(150)/'QUAN'/
      DATA (INAME(150,J),J=1,6)/
     1'QUAN','    ','    ','    ','    ','    '/
      DATA INFLAV(150)/'ONE '/
      DATA INFLAD(150)/'OFF '/
C
      DATA INCASE(151)/'TMSE'/
      DATA (INAME(151,J),J=1,6)/
     1'TRIM','MEAN','STAN','ERRO','    ','    '/
      DATA INFLAV(151)/'ONE '/
      DATA INFLAD(151)/'OFF '/
C
      DATA INCASE(152)/'PBCR'/
      DATA (INAME(152,J),J=1,6)/
     1'PERC','BEND','CORR','    ','    ','    '/
      DATA INFLAV(152)/'TWO '/
      DATA INFLAD(152)/'OFF '/
C
      DATA INCASE(153)/'LICA'/
      DATA (INAME(153,J),J=1,6)/
     1'LINE','CALI','    ','    ','    ','    '/
      DATA INFLAV(153)/'TWO '/
      DATA INFLAD(153)/'OFF '/
C
      DATA INCASE(154)/'QUCA'/
      DATA (INAME(154,J),J=1,6)/
     1'QUAD','CALI','    ','    ','    ','    '/
      DATA INFLAV(154)/'TWO '/
      DATA INFLAD(154)/'OFF '/
C
      DATA INCASE(155)/'CP  '/
      DATA (INAME(155,J),J=1,6)/
     1'CP  ','    ','    ','    ','    ','    '/
      DATA INFLAV(155)/'ONE '/
      DATA INFLAD(155)/'OFF '/
C
      DATA INCASE(156)/'CPK '/
      DATA (INAME(156,J),J=1,6)/
     1'CPK ','    ','    ','    ','    ','    '/
      DATA INFLAV(156)/'ONE '/
      DATA INFLAD(156)/'OFF '/
C
      DATA INCASE(157)/'CNPK'/
      DATA (INAME(157,J),J=1,6)/
     1'CNPK','    ','    ','    ','    ','    '/
      DATA INFLAV(157)/'ONE '/
      DATA INFLAD(157)/'OFF '/
C
      DATA INCASE(158)/'CPM '/
      DATA (INAME(158,J),J=1,6)/
     1'CPM ','    ','    ','    ','    ','    '/
      DATA INFLAV(158)/'ONE '/
      DATA INFLAD(158)/'OFF '/
C
      DATA INCASE(159)/'CC  '/
      DATA (INAME(159,J),J=1,6)/
     1'CC  ','    ','    ','    ','    ','    '/
      DATA INFLAV(159)/'ONE '/
      DATA INFLAD(159)/'OFF '/
C
      DATA INCASE(160)/'CPL '/
      DATA (INAME(160,J),J=1,6)/
     1'CPL ','    ','    ','    ','    ','    '/
      DATA INFLAV(160)/'ONE '/
      DATA INFLAD(160)/'OFF '/
C
      DATA INCASE(161)/'CPU '/
      DATA (INAME(161,J),J=1,6)/
     1'CPU ','    ','    ','    ','    ','    '/
      DATA INFLAV(161)/'ONE '/
      DATA INFLAD(161)/'OFF '/
C
      DATA INCASE(162)/'EXLO '/
      DATA (INAME(162,J),J=1,6)/
     1'EXPE','LOSS','    ','    ','    ','    '/
      DATA INFLAV(162)/'ONE '/
      DATA INFLAD(162)/'OFF '/
C
      DATA INCASE(163)/'PEDE '/
      DATA (INAME(163,J),J=1,6)/
     1'PERC','DEFE','    ','    ','    ','    '/
      DATA INFLAV(163)/'ONE '/
      DATA INFLAD(163)/'OFF '/
C
      DATA INCASE(164)/'DMEA '/
      DATA (INAME(164,J),J=1,6)/
     1'DIFF','OF  ','MEAN','    ','    ','    '/
      DATA INFLAV(164)/'TWO '/
      DATA INFLAD(164)/'ON  '/
C
      DATA INCASE(165)/'DAAD '/
      DATA (INAME(165,J),J=1,6)/
     1'DIFF','OF  ','AVER','ABSO','DEVI','    '/
      DATA INFLAV(165)/'TWO '/
      DATA INFLAD(165)/'ON  '/
C
      DATA INCASE(166)/'DMEA '/
      DATA (INAME(166,J),J=1,6)/
     1'DIFF','OF  ','AVER','    ','    ','    '/
      DATA INFLAV(166)/'TWO '/
      DATA INFLAD(166)/'ON  '/
C
      DATA INCASE(167)/'DAAD '/
      DATA (INAME(167,J),J=1,6)/
     1'DIFF','OF  ','AAD ','    ','    ','    '/
      DATA INFLAV(167)/'TWO '/
      DATA INFLAD(167)/'ON  '/
C
      DATA INCASE(168)/'DMDM '/
      DATA (INAME(168,J),J=1,6)/
     1'DIFF','OF  ','MIDM','    ','    ','    '/
      DATA INFLAV(168)/'TWO '/
      DATA INFLAD(168)/'ON  '/
C
      DATA INCASE(169)/'DMAD '/
      DATA (INAME(169,J),J=1,6)/
     1'DIFF','OF  ','MAD ','    ','    ','    '/
      DATA INFLAV(169)/'TWO '/
      DATA INFLAD(169)/'ON  '/
C
      DATA INCASE(170)/'DMAD '/
      DATA (INAME(170,J),J=1,6)/
     1'DIFF','OF  ','MEDI','ABSO','DEVI','    '/
      DATA INFLAV(170)/'TWO '/
      DATA INFLAD(170)/'ON  '/
C
      DATA INCASE(171)/'DMED '/
      DATA (INAME(171,J),J=1,6)/
     1'DIFF','OF  ','MEDI','    ','    ','    '/
      DATA INFLAV(171)/'TWO '/
      DATA INFLAD(171)/'ON  '/
C
      DATA INCASE(172)/'DTRM '/
      DATA (INAME(172,J),J=1,6)/
     1'DIFF','OF  ','TRIM','MEAN','    ','    '/
      DATA INFLAV(172)/'TWO '/
      DATA INFLAD(172)/'ON  '/
C
      DATA INCASE(173)/'DWNM '/
      DATA (INAME(173,J),J=1,6)/
     1'DIFF','OF  ','WINS','MEAN','    ','    '/
      DATA INFLAV(173)/'TWO '/
      DATA INFLAD(173)/'ON  '/
C
      DATA INCASE(174)/'DWNM '/
      DATA (INAME(174,J),J=1,6)/
     1'DIFF','OF  ','WIND','MEAN','    ','    '/
      DATA INFLAV(174)/'TWO '/
      DATA INFLAD(174)/'ON  '/
C
      DATA INCASE(175)/'DGEO '/
      DATA (INAME(175,J),J=1,6)/
     1'DIFF','OF  ','GEOM','MEAN','    ','    '/
      DATA INFLAV(175)/'TWO '/
      DATA INFLAD(175)/'ON  '/
C
      DATA INCASE(176)/'DHAR '/
      DATA (INAME(176,J),J=1,6)/
     1'DIFF','OF  ','HARM','MEAN','    ','    '/
      DATA INFLAV(176)/'TWO '/
      DATA INFLAD(176)/'ON  '/
C
      DATA INCASE(177)/'DHDL'/
      DATA (INAME(177,J),J=1,6)/
     1'DIFF','OF  ','HODG','LEHM','    ','    '/
      DATA INFLAV(177)/'TWO '/
      DATA INFLAD(177)/'ON  '/
C
      DATA INCASE(178)/'DBIW'/
      DATA (INAME(178,J),J=1,6)/
     1'DIFF','OF  ','BIWE','LOCA','    ','    '/
      DATA INFLAV(178)/'TWO '/
      DATA INFLAD(178)/'ON  '/
C
      DATA INCASE(179)/'DSD '/
      DATA (INAME(179,J),J=1,6)/
     1'DIFF','OF  ','STAN','DEVI','    ','    '/
      DATA INFLAV(179)/'TWO '/
      DATA INFLAD(179)/'ON  '/
C
      DATA INCASE(180)/'DSD '/
      DATA (INAME(180,J),J=1,6)/
     1'DIFF','OF  ','SD  ','    ','    ','    '/
      DATA INFLAV(180)/'TWO '/
      DATA INFLAD(180)/'ON  '/
C
      DATA INCASE(181)/'DVAR'/
      DATA (INAME(181,J),J=1,6)/
     1'DIFF','OF  ','VARI','    ','    ','    '/
      DATA INFLAV(181)/'TWO '/
      DATA INFLAD(181)/'ON  '/
C
      DATA INCASE(182)/'DSDM'/
      DATA (INAME(182,J),J=1,6)/
     1'DIFF','OF  ','STAN','DEVI','OF  ','MEAN'/
      DATA INFLAV(182)/'TWO '/
      DATA INFLAD(182)/'ON  '/
C
      DATA INCASE(183)/'DSDM'/
      DATA (INAME(183,J),J=1,6)/
     1'DIFF','OF  ','STAN','DEVI','MEAN','    '/
      DATA INFLAV(183)/'TWO '/
      DATA INFLAD(183)/'ON  '/
C
      DATA INCASE(184)/'DSDM'/
      DATA (INAME(184,J),J=1,6)/
     1'DIFF','OF  ','STAN','DEVI','MEAN','    '/
      DATA INFLAV(184)/'TWO '/
      DATA INFLAD(184)/'ON  '/
C
      DATA INCASE(185)/'DSDM'/
      DATA (INAME(185,J),J=1,6)/
     1'DIFF','OF  ','SD  ','OF  ','THE ','MEAN'/
      DATA INFLAV(185)/'TWO '/
      DATA INFLAD(185)/'ON  '/
C
      DATA INCASE(186)/'DSDM'/
      DATA (INAME(186,J),J=1,6)/
     1'DIFF','OF  ','SD  ','THE ','MEAN','    '/
      DATA INFLAV(186)/'TWO '/
      DATA INFLAD(186)/'ON  '/
C
      DATA INCASE(187)/'DSDM'/
      DATA (INAME(187,J),J=1,6)/
     1'DIFF','OF  ','SD  ','MEAN','    ','    '/
      DATA INFLAV(187)/'TWO '/
      DATA INFLAD(187)/'ON  '/
C
      DATA INCASE(188)/'DVAM'/
      DATA (INAME(188,J),J=1,6)/
     1'DIFF','OF  ','VARI','MEAN','    ','    '/
      DATA INFLAV(188)/'TWO '/
      DATA INFLAD(188)/'ON  '/
C
      DATA INCASE(189)/'DVAM'/
      DATA (INAME(189,J),J=1,6)/
     1'DIFF','OF  ','VARI','OF  ','MEAN','    '/
      DATA INFLAV(189)/'TWO '/
      DATA INFLAD(189)/'ON  '/
C
      DATA INCASE(190)/'DVAM'/
      DATA (INAME(190,J),J=1,6)/
     1'DIFF','OF  ','VARI','OF  ','THE ','MEAN'/
      DATA INFLAV(190)/'TWO '/
      DATA INFLAD(190)/'ON  '/
C
      DATA INCASE(191)/'DIQR'/
      DATA (INAME(191,J),J=1,6)/
     1'DIFF','OF  ','INTE','RANG','    ','    '/
      DATA INFLAV(191)/'TWO '/
      DATA INFLAD(191)/'ON  '/
C
      DATA INCASE(192)/'DIQR'/
      DATA (INAME(192,J),J=1,6)/
     1'DIFF','OF  ','IQ  ','RANG','    ','    '/
      DATA INFLAV(192)/'TWO '/
      DATA INFLAD(192)/'ON  '/
C
      DATA INCASE(193)/'DWSD'/
      DATA (INAME(193,J),J=1,6)/
     1'DIFF','OF  ','WINS','SD  ','    ','    '/
      DATA INFLAV(193)/'TWO '/
      DATA INFLAD(193)/'ON  '/
C
      DATA INCASE(194)/'DWSD'/
      DATA (INAME(194,J),J=1,6)/
     1'DIFF','OF  ','WIND','SD  ','    ','    '/
      DATA INFLAV(194)/'TWO '/
      DATA INFLAD(194)/'ON  '/
C
      DATA INCASE(195)/'DWSD'/
      DATA (INAME(195,J),J=1,6)/
     1'DIFF','OF  ','WINS','STAN','DEVI','    '/
      DATA INFLAV(195)/'TWO '/
      DATA INFLAD(195)/'ON  '/
C
      DATA INCASE(196)/'DWSD'/
      DATA (INAME(196,J),J=1,6)/
     1'DIFF','OF  ','WIND','STAN','DEVI','    '/
      DATA INFLAV(196)/'TWO '/
      DATA INFLAD(196)/'ON  '/
C
      DATA INCASE(197)/'DWVA'/
      DATA (INAME(197,J),J=1,6)/
     1'DIFF','OF  ','WINS','VARI','    ','    '/
      DATA INFLAV(197)/'TWO '/
      DATA INFLAD(197)/'ON  '/
C
      DATA INCASE(198)/'DWVA'/
      DATA (INAME(198,J),J=1,6)/
     1'DIFF','OF  ','WIND','VARI','    ','    '/
      DATA INFLAV(198)/'TWO '/
      DATA INFLAD(198)/'ON  '/
C
      DATA INCASE(199)/'DBIM'/
      DATA (INAME(199,J),J=1,6)/
     1'DIFF','OF  ','BIWE','MIDV','    ','    '/
      DATA INFLAV(199)/'TWO '/
      DATA INFLAD(199)/'ON  '/
C
      DATA INCASE(200)/'DBIS'/
      DATA (INAME(200,J),J=1,6)/
     1'DIFF','OF  ','BIWE','SCAL','    ','    '/
      DATA INFLAV(200)/'TWO '/
      DATA INFLAD(200)/'ON  '/
C
      DATA INCASE(201)/'DPBN'/
      DATA (INAME(201,J),J=1,6)/
     1'DIFF','OF  ','PERC','BEND','MIDV','    '/
      DATA INFLAV(201)/'TWO '/
      DATA INFLAD(201)/'ON  '/
C
      DATA INCASE(202)/'DGSD'/
      DATA (INAME(202,J),J=1,6)/
     1'DIFF','OF  ','GEOM','SD  ','    ','    '/
      DATA INFLAV(202)/'TWO '/
      DATA INFLAD(202)/'ON  '/
C
      DATA INCASE(203)/'DGSD'/
      DATA (INAME(203,J),J=1,6)/
     1'DIFF','OF  ','GEOM','STAN','DEVI','    '/
      DATA INFLAV(203)/'TWO '/
      DATA INFLAD(203)/'ON  '/
C
      DATA INCASE(204)/'DRAN'/
      DATA (INAME(204,J),J=1,6)/
     1'DIFF','OF  ','RANG','    ','    ','    '/
      DATA INFLAV(204)/'TWO '/
      DATA INFLAD(204)/'ON  '/
C
      DATA INCASE(205)/'DMDR'/
      DATA (INAME(205,J),J=1,6)/
     1'DIFF','OF  ','MIDR','    ','    ','    '/
      DATA INFLAV(205)/'TWO '/
      DATA INFLAD(205)/'ON  '/
C
      DATA INCASE(206)/'DMDR'/
      DATA (INAME(206,J),J=1,6)/
     1'DIFF','OF  ','MID ','RANG','    ','    '/
      DATA INFLAV(206)/'TWO '/
      DATA INFLAD(206)/'ON  '/
C
      DATA INCASE(207)/'DQUA'/
      DATA (INAME(207,J),J=1,6)/
     1'DIFF','OF  ','QUAN','    ','    ','    '/
      DATA INFLAV(207)/'TWO '/
      DATA INFLAD(207)/'ON  '/
C
      DATA INCASE(208)/'DSKE'/
      DATA (INAME(208,J),J=1,6)/
     1'DIFF','OF  ','SKEW','    ','    ','    '/
      DATA INFLAV(208)/'TWO '/
      DATA INFLAD(208)/'ON  '/
C
      DATA INCASE(209)/'DSKE'/
      DATA (INAME(209,J),J=1,6)/
     1'DIFF','OF  ','STAN','CENT','THIR','MOME'/
      DATA INFLAV(209)/'TWO '/
      DATA INFLAD(209)/'ON  '/
C
      DATA INCASE(210)/'DSKE'/
      DATA (INAME(210,J),J=1,6)/
     1'DIFF','OF  ','STAN','CENT','3RD ','MOME'/
      DATA INFLAV(210)/'TWO '/
      DATA INFLAD(210)/'ON  '/
C
      DATA INCASE(211)/'DKUR'/
      DATA (INAME(211,J),J=1,6)/
     1'DIFF','OF  ','KURT','    ','    ','    '/
      DATA INFLAV(211)/'TWO '/
      DATA INFLAD(211)/'ON  '/
C
      DATA INCASE(212)/'DKUR'/
      DATA (INAME(212,J),J=1,6)/
     1'DIFF','OF  ','STAN','CENT','FOUR','MOME'/
      DATA INFLAV(212)/'TWO '/
      DATA INFLAD(212)/'ON  '/
C
      DATA INCASE(213)/'DKUR'/
      DATA (INAME(213,J),J=1,6)/
     1'DIFF','OF  ','STAN','CENT','4TH ','MOME'/
      DATA INFLAV(213)/'TWO '/
      DATA INFLAD(213)/'ON  '/
C
      DATA INCASE(214)/'DRSD'/
      DATA (INAME(214,J),J=1,6)/
     1'DIFF','OF  ','RELA','SD  ','    ','    '/
      DATA INFLAV(214)/'TWO '/
      DATA INFLAD(214)/'ON  '/
C
      DATA INCASE(215)/'DRSD'/
      DATA (INAME(215,J),J=1,6)/
     1'DIFF','OF  ','RELA','STAN','DEVI','    '/
      DATA INFLAV(215)/'TWO '/
      DATA INFLAD(215)/'ON  '/
C
      DATA INCASE(216)/'DRVA'/
      DATA (INAME(216,J),J=1,6)/
     1'DIFF','OF  ','RELA','VARI','    ','    '/
      DATA INFLAV(216)/'TWO '/
      DATA INFLAD(216)/'ON  '/
C
      DATA INCASE(217)/'DMIN'/
      DATA (INAME(217,J),J=1,6)/
     1'DIFF','OF  ','MINI','    ','    ','    '/
      DATA INFLAV(217)/'TWO '/
      DATA INFLAD(217)/'ON  '/
C
      DATA INCASE(218)/'DMAX'/
      DATA (INAME(218,J),J=1,6)/
     1'DIFF','OF  ','MAXI','    ','    ','    '/
      DATA INFLAV(218)/'TWO '/
      DATA INFLAD(218)/'ON  '/
C
      DATA INCASE(219)/'DEXT'/
      DATA (INAME(219,J),J=1,6)/
     1'DIFF','OF  ','EXTR','    ','    ','    '/
      DATA INFLAV(219)/'TWO '/
      DATA INFLAD(219)/'ON  '/
C
      DATA INCASE(220)/'DCVA'/
      DATA (INAME(220,J),J=1,6)/
     1'DIFF','OF  ','COEF','OF  ','VARI','    '/
      DATA INFLAV(220)/'TWO '/
      DATA INFLAD(220)/'ON  '/
C
      DATA INCASE(221)/'DCVA'/
      DATA (INAME(221,J),J=1,6)/
     1'DIFF','OF  ','COEF','VARI','    ','    '/
      DATA INFLAV(221)/'TWO '/
      DATA INFLAD(221)/'ON  '/
C
      DATA INCASE(222)/'DSN '/
      DATA (INAME(222,J),J=1,6)/
     1'DIFF','OF  ','SN  ','SCAL','    ','    '/
      DATA INFLAV(222)/'TWO '/
      DATA INFLAD(222)/'ON  '/
C
      DATA INCASE(223)/'DSN '/
      DATA (INAME(223,J),J=1,6)/
     1'DIFF','OF  ','SN  ','    ','    ','    '/
      DATA INFLAV(223)/'TWO '/
      DATA INFLAD(223)/'ON  '/
C
      DATA INCASE(224)/'DQN '/
      DATA (INAME(224,J),J=1,6)/
     1'DIFF','OF  ','QN  ','SCAL','    ','    '/
      DATA INFLAV(224)/'TWO '/
      DATA INFLAD(224)/'ON  '/
C
      DATA INCASE(225)/'DQN '/
      DATA (INAME(225,J),J=1,6)/
     1'DIFF','OF  ','QN  ','    ','    ','    '/
      DATA INFLAV(225)/'TWO '/
      DATA INFLAD(225)/'ON  '/
C
      DATA INCASE(226)/'DSUM'/
      DATA (INAME(226,J),J=1,6)/
     1'DIFF','OF  ','SUM ','    ','    ','    '/
      DATA INFLAV(226)/'TWO '/
      DATA INFLAD(226)/'ON  '/
C
      DATA INCASE(227)/'DSUM'/
      DATA (INAME(227,J),J=1,6)/
     1'DIFF','OF  ','SUMS','    ','    ','    '/
      DATA INFLAV(227)/'TWO '/
      DATA INFLAD(227)/'ON  '/
C
      DATA INCASE(228)/'COVA'/
      DATA (INAME(228,J),J=1,6)/
     1'COVA','    ','    ','    ','    ','    '/
      DATA INFLAV(228)/'TWO '/
      DATA INFLAD(228)/'OFF '/
C
      DATA INCASE(229)/'CORR'/
      DATA (INAME(229,J),J=1,6)/
     1'CORR','    ','    ','    ','    ','    '/
      DATA INFLAV(229)/'TWO '/
      DATA INFLAD(229)/'OFF '/
C
      DATA INCASE(230)/'NOML'/
      DATA (INAME(230,J),J=1,6)/
     1'NORM','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(230)/'ONE '/
      DATA INFLAD(230)/'OFF '/
C
      DATA INCASE(231)/'NOML'/
      DATA (INAME(231,J),J=1,6)/
     1'NORM','MLE ','    ','    ','    ','    '/
      DATA INFLAV(231)/'ONE '/
      DATA INFLAD(231)/'OFF '/
C
      DATA INCASE(232)/'LOML'/
      DATA (INAME(232,J),J=1,6)/
     1'LOGI','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(232)/'ONE '/
      DATA INFLAD(232)/'OFF '/
C
      DATA INCASE(233)/'LOML'/
      DATA (INAME(233,J),J=1,6)/
     1'LOGI','MLE ','    ','    ','    ','    '/
      DATA INFLAV(233)/'ONE '/
      DATA INFLAD(233)/'OFF '/
C
      DATA INCASE(234)/'LAML'/
      DATA (INAME(234,J),J=1,6)/
     1'LAPL','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(234)/'ONE '/
      DATA INFLAD(234)/'OFF '/
C
      DATA INCASE(235)/'LAPP'/
      DATA (INAME(235,J),J=1,6)/
     1'LAPL','    ','    ','    ','    ','    '/
      DATA INFLAV(235)/'ONE '/
      DATA INFLAD(235)/'OFF '/
C
      DATA INCASE(236)/'LAML'/
      DATA (INAME(236,J),J=1,6)/
     1'DOUB','EXPO','MAXI','LIKE','    ','    '/
      DATA INFLAV(236)/'ONE '/
      DATA INFLAD(236)/'OFF '/
C
      DATA INCASE(237)/'LAPP'/
      DATA (INAME(237,J),J=1,6)/
     1'DOUB','EXPO','    ','    ','    ','    '/
      DATA INFLAV(237)/'ONE '/
      DATA INFLAD(237)/'OFF '/
C
      DATA INCASE(238)/'UNML'/
      DATA (INAME(238,J),J=1,6)/
     1'UNIF','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(238)/'ONE '/
      DATA INFLAD(238)/'OFF '/
C
      DATA INCASE(239)/'UNPP'/
      DATA (INAME(239,J),J=1,6)/
     1'UNIF','    ','    ','    ','    ','    '/
      DATA INFLAV(239)/'ONE '/
      DATA INFLAD(239)/'OFF '/
C
      DATA INCASE(240)/'CAML'/
      DATA (INAME(240,J),J=1,6)/
     1'CAUC','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(240)/'ONE '/
      DATA INFLAD(240)/'OFF '/
C
      DATA INCASE(241)/'CAPP'/
      DATA (INAME(241,J),J=1,6)/
     1'CAUC','    ','    ','    ','    ','    '/
      DATA INFLAV(241)/'ONE '/
      DATA INFLAD(241)/'OFF '/
C
      DATA INCASE(242)/'EXML'/
      DATA (INAME(242,J),J=1,6)/
     1'EXPO','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(242)/'ONE '/
      DATA INFLAD(242)/'OFF '/
C
      DATA INCASE(243)/'EXPP'/
      DATA (INAME(243,J),J=1,6)/
     1'EXPO','    ','    ','    ','    ','    '/
      DATA INFLAV(243)/'ONE '/
      DATA INFLAD(243)/'OFF '/
C
      DATA INCASE(244)/'GUML'/
      DATA (INAME(244,J),J=1,6)/
     1'GUMB','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(244)/'ONE '/
      DATA INFLAD(244)/'OFF '/
C
      DATA INCASE(245)/'GUPP'/
      DATA (INAME(245,J),J=1,6)/
     1'GUMB','    ','    ','    ','    ','    '/
      DATA INFLAV(245)/'ONE '/
      DATA INFLAD(245)/'OFF '/
C
      DATA INCASE(246)/'GUML'/
      DATA (INAME(246,J),J=1,6)/
     1'EV1 ','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(246)/'ONE '/
      DATA INFLAD(246)/'OFF '/
C
      DATA INCASE(247)/'GUPP'/
      DATA (INAME(247,J),J=1,6)/
     1'EV1 ','    ','    ','    ','    ','    '/
      DATA INFLAV(247)/'ONE '/
      DATA INFLAD(247)/'OFF '/
C
      DATA INCASE(248)/'GUML'/
      DATA (INAME(248,J),J=1,6)/
     1'EXTR','VALU','TYPE','1   ','MAXI','LIKE'/
      DATA INFLAV(248)/'ONE '/
      DATA INFLAD(248)/'OFF '/
C
      DATA INCASE(249)/'GUPP'/
      DATA (INAME(249,J),J=1,6)/
     1'EXTR','VALU','TYPE','1   ','    ','    '/
      DATA INFLAV(249)/'ONE '/
      DATA INFLAD(249)/'OFF '/
C
      DATA INCASE(250)/'HNPP'/
      DATA (INAME(250,J),J=1,6)/
     1'HALF','NORM','    ','    ','    ','    '/
      DATA INFLAV(250)/'ONE '/
      DATA INFLAD(250)/'OFF '/
C
      DATA INCASE(251)/'COPP'/
      DATA (INAME(251,J),J=1,6)/
     1'COSI','    ','    ','    ','    ','    '/
      DATA INFLAV(251)/'ONE '/
      DATA INFLAD(251)/'OFF '/
C
      DATA INCASE(252)/'RAML'/
      DATA (INAME(252,J),J=1,6)/
     1'RAYL','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(252)/'ONE '/
      DATA INFLAD(252)/'OFF '/
C
      DATA INCASE(253)/'RAPP'/
      DATA (INAME(253,J),J=1,6)/
     1'RAYL','    ','    ','    ','    ','    '/
      DATA INFLAV(253)/'ONE '/
      DATA INFLAD(253)/'OFF '/
C
      DATA INCASE(254)/'SLPP'/
      DATA (INAME(254,J),J=1,6)/
     1'SLAS','    ','    ','    ','    ','    '/
      DATA INFLAV(254)/'ONE '/
      DATA INFLAD(254)/'OFF '/
C
      DATA INCASE(255)/'ANPP'/
      DATA (INAME(255,J),J=1,6)/
     1'ANGL','    ','    ','    ','    ','    '/
      DATA INFLAV(255)/'ONE '/
      DATA INFLAD(255)/'OFF '/
C
      DATA INCASE(256)/'ARPP'/
      DATA (INAME(256,J),J=1,6)/
     1'ARCS','    ','    ','    ','    ','    '/
      DATA INFLAV(256)/'ONE '/
      DATA INFLAD(256)/'OFF '/
C
      DATA INCASE(257)/'LUPP'/
      DATA (INAME(257,J),J=1,6)/
     1'LAND','    ','    ','    ','    ','    '/
      DATA INFLAV(257)/'ONE '/
      DATA INFLAD(257)/'OFF '/
C
      DATA INCASE(258)/'SEPP'/
      DATA (INAME(258,J),J=1,6)/
     1'SEMI','CIRC','    ','    ','    ','    '/
      DATA INFLAV(258)/'ONE '/
      DATA INFLAD(258)/'OFF '/
C
      DATA INCASE(259)/'SEPP'/
      DATA (INAME(259,J),J=1,6)/
     1'SEMI','    ','    ','    ','    ','    '/
      DATA INFLAV(259)/'ONE '/
      DATA INFLAD(259)/'OFF '/
C
      DATA INCASE(260)/'HSPP'/
      DATA (INAME(260,J),J=1,6)/
     1'HYPE','SECA','    ','    ','    ','    '/
      DATA INFLAV(260)/'ONE '/
      DATA INFLAD(260)/'OFF '/
C
      DATA INCASE(261)/'HCPP'/
      DATA (INAME(261,J),J=1,6)/
     1'HALF','CAUC','    ','    ','    ','    '/
      DATA INFLAV(261)/'ONE '/
      DATA INFLAD(261)/'OFF '/
C
      DATA INCASE(262)/'DSUM'/
      DATA (INAME(262,J),J=1,6)/
     1'DIFF','OF  ','SUMS','    ','    ','    '/
      DATA INFLAV(262)/'TWO '/
      DATA INFLAD(262)/'ON  '/
C
      DATA INCASE(263)/'NOPP'/
      DATA (INAME(263,J),J=1,6)/
     1'NORM','    ','    ','    ','    ','    '/
      DATA INFLAV(263)/'ONE '/
      DATA INFLAD(263)/'OFF '/
C
      DATA INCASE(264)/'WEML'/
      DATA (INAME(264,J),J=1,6)/
     1'WEIB','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(264)/'ONE '/
      DATA INFLAD(264)/'OFF '/
C
      DATA INCASE(265)/'LNML'/
      DATA (INAME(265,J),J=1,6)/
     1'LOGN','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(265)/'ONE '/
      DATA INFLAD(265)/'OFF '/
C
      DATA INCASE(266)/'LNML'/
      DATA (INAME(266,J),J=1,6)/
     1'LOG ','NORM','MAXI','LIKE','    ','    '/
      DATA INFLAV(266)/'ONE '/
      DATA INFLAD(266)/'OFF '/
C
      DATA INCASE(267)/'GAML'/
      DATA (INAME(267,J),J=1,6)/
     1'GAMM','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(267)/'ONE '/
      DATA INFLAD(267)/'OFF '/
C
      DATA INCASE(268)/'GIKS'/
      DATA (INAME(268,J),J=1,6)/
     1'INVE','GAMM','KS  ','    ','    ','    '/
      DATA INFLAV(268)/'ONE '/
      DATA INFLAD(268)/'OFF '/
C
      DATA INCASE(269)/'LGKS'/
      DATA (INAME(269,J),J=1,6)/
     1'LOG ','GAMM','KS  ','    ','    ','    '/
      DATA INFLAV(269)/'ONE '/
      DATA INFLAD(269)/'OFF '/
C
      DATA INCASE(270)/'GEKS'/
      DATA (INAME(270,J),J=1,6)/
     1'GENE','PARE','KS  ','    ','    ','    '/
      DATA INFLAV(270)/'ONE '/
      DATA INFLAD(270)/'OFF '/
C
      DATA INCASE(271)/'IWKS'/
      DATA (INAME(271,J),J=1,6)/
     1'INVE','WEIB','KS  ','    ','    ','    '/
      DATA INFLAV(271)/'ONE '/
      DATA INFLAD(271)/'OFF '/
C
      DATA INCASE(272)/'CSKS'/
      DATA (INAME(272,J),J=1,6)/
     1'CHI ','SQUA','KS  ','    ','    ','    '/
      DATA INFLAV(272)/'ONE '/
      DATA INFLAD(272)/'OFF '/
C
      DATA INCASE(273)/'CSKS'/
      DATA (INAME(273,J),J=1,6)/
     1'CHIS','KS  ','    ','    ','    ','    '/
      DATA INFLAV(273)/'ONE '/
      DATA INFLAD(273)/'OFF '/
C
      DATA INCASE(274)/'CHKS'/
      DATA (INAME(274,J),J=1,6)/
     1'CHI ','KS  ','    ','    ','    ','    '/
      DATA INFLAV(274)/'ONE '/
      DATA INFLAD(274)/'OFF '/
C
      DATA INCASE(275)/'TKS'/
      DATA (INAME(275,J),J=1,6)/
     1'T   ','KS  ','    ','    ','    ','    '/
      DATA INFLAV(275)/'ONE '/
      DATA INFLAD(275)/'OFF '/
C
      DATA INCASE(276)/'WEML'/
      DATA (INAME(276,J),J=1,6)/
     1'WEIB','MLE ','    ','    ','    ','    '/
      DATA INFLAV(276)/'ONE '/
      DATA INFLAD(276)/'OFF '/
C
      DATA INCASE(277)/'WEKS'/
      DATA (INAME(277,J),J=1,6)/
     1'WEIB','KS  ','    ','    ','    ','    '/
      DATA INFLAV(277)/'ONE '/
      DATA INFLAD(277)/'OFF '/
C
      DATA INCASE(278)/'LNML'/
      DATA (INAME(278,J),J=1,6)/
     1'LOGN','MLE ','    ','    ','    ','    '/
      DATA INFLAV(278)/'ONE '/
      DATA INFLAD(278)/'OFF '/
C
      DATA INCASE(279)/'LNKS'/
      DATA (INAME(279,J),J=1,6)/
     1'LOGN','KS  ','    ','    ','    ','    '/
      DATA INFLAV(279)/'ONE '/
      DATA INFLAD(279)/'OFF '/
C
      DATA INCASE(280)/'LNML'/
      DATA (INAME(280,J),J=1,6)/
     1'LOG ','NORM','MLE ','    ','    ','    '/
      DATA INFLAV(280)/'ONE '/
      DATA INFLAD(280)/'OFF '/
C
      DATA INCASE(281)/'LNKS'/
      DATA (INAME(281,J),J=1,6)/
     1'LOG ','NORM','KS  ','    ','    ','    '/
      DATA INFLAV(281)/'ONE '/
      DATA INFLAD(281)/'OFF '/
C
      DATA INCASE(282)/'GAML'/
      DATA (INAME(282,J),J=1,6)/
     1'GAMM','MLE ','    ','    ','    ','    '/
      DATA INFLAV(282)/'ONE '/
      DATA INFLAD(282)/'OFF '/
C
      DATA INCASE(283)/'GAKS'/
      DATA (INAME(283,J),J=1,6)/
     1'GAMM','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(283)/'ONE '/
      DATA INFLAD(283)/'OFF '/
C
      DATA INCASE(284)/'GAKS'/
      DATA (INAME(284,J),J=1,6)/
     1'GAMM','KS  ','    ','    ','    ','    '/
      DATA INFLAV(284)/'ONE '/
      DATA INFLAD(284)/'OFF '/
C
      DATA INCASE(285)/'GACP'/
      DATA (INAME(285,J),J=1,6)/
     1'GAMM','    ','    ','    ','    ','    '/
      DATA INFLAV(285)/'ONE '/
      DATA INFLAD(285)/'OFF '/
C
      DATA INCASE(286)/'WEKS'/
      DATA (INAME(286,J),J=1,6)/
     1'WEIB','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(286)/'ONE '/
      DATA INFLAD(286)/'OFF '/
C
      DATA INCASE(287)/'LNKS'/
      DATA (INAME(287,J),J=1,6)/
     1'LOGN','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(287)/'ONE '/
      DATA INFLAD(287)/'OFF '/
C
      DATA INCASE(288)/'LNCP'/
      DATA (INAME(288,J),J=1,6)/
     1'LOGN','    ','    ','    ','    ','    '/
      DATA INFLAV(288)/'ONE '/
      DATA INFLAD(288)/'OFF '/
C
      DATA INCASE(289)/'LNKS'/
      DATA (INAME(289,J),J=1,6)/
     1'LOG ','NORM','KOLM','SMIR','    ','    '/
      DATA INFLAV(289)/'ONE '/
      DATA INFLAD(289)/'OFF '/
C
      DATA INCASE(290)/'LNCP'/
      DATA (INAME(290,J),J=1,6)/
     1'LOG ','NORM','    ','    ','    ','    '/
      DATA INFLAV(290)/'ONE '/
      DATA INFLAD(290)/'OFF '/
C
      DATA INCASE(291)/'IWKS'/
      DATA (INAME(291,J),J=1,6)/
     1'INVE','WEIB','KOLM','SMIR','    ','    '/
      DATA INFLAV(291)/'ONE '/
      DATA INFLAD(291)/'OFF '/
C
      DATA INCASE(292)/'IWML'/
      DATA (INAME(292,J),J=1,6)/
     1'INVE','WEIB','MAXI','LIKE','    ','    '/
      DATA INFLAV(292)/'ONE '/
      DATA INFLAD(292)/'OFF '/
C
      DATA INCASE(293)/'GIKS'/
      DATA (INAME(293,J),J=1,6)/
     1'INVE','GAMM','KOLM','SMIR','    ','    '/
      DATA INFLAV(293)/'ONE '/
      DATA INFLAD(293)/'OFF '/
C
      DATA INCASE(294)/'GICP'/
      DATA (INAME(294,J),J=1,6)/
     1'INVE','GAMM','    ','    ','    ','    '/
      DATA INFLAV(294)/'ONE '/
      DATA INFLAD(294)/'OFF '/
C
      DATA INCASE(295)/'LGKS'/
      DATA (INAME(295,J),J=1,6)/
     1'LOG ','GAMM','KOLM','SMIR','    ','    '/
      DATA INFLAV(295)/'ONE '/
      DATA INFLAD(295)/'OFF '/
C
      DATA INCASE(296)/'LGCP'/
      DATA (INAME(296,J),J=1,6)/
     1'LOG ','GAMM','    ','    ','    ','    '/
      DATA INFLAV(296)/'ONE '/
      DATA INFLAD(296)/'OFF '/
C
      DATA INCASE(297)/'LGKS'/
      DATA (INAME(297,J),J=1,6)/
     1'LOGG','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(297)/'ONE '/
      DATA INFLAD(297)/'OFF '/
C
      DATA INCASE(298)/'LGCP'/
      DATA (INAME(298,J),J=1,6)/
     1'LOGG','    ','    ','    ','    ','    '/
      DATA INFLAV(298)/'ONE '/
      DATA INFLAD(298)/'OFF '/
C
      DATA INCASE(299)/'GEKS'/
      DATA (INAME(299,J),J=1,6)/
     1'GENE','PARE','KOLM','SMIR','    ','    '/
      DATA INFLAV(299)/'ONE '/
      DATA INFLAD(299)/'OFF '/
C
      DATA INCASE(300)/'GEML'/
      DATA (INAME(300,J),J=1,6)/
     1'GENE','PARE','MLE ','    ','    ','    '/
      DATA INFLAV(300)/'ONE '/
      DATA INFLAD(300)/'OFF '/
C
      DATA INCASE(301)/'CSKS'/
      DATA (INAME(301,J),J=1,6)/
     1'CHI ','SQUA','KOLM','SMIR','    ','    '/
      DATA INFLAV(301)/'ONE '/
      DATA INFLAD(301)/'OFF '/
C
      DATA INCASE(302)/'CSCP'/
      DATA (INAME(302,J),J=1,6)/
     1'CHI ','SQUA','    ','    ','    ','    '/
      DATA INFLAV(302)/'ONE '/
      DATA INFLAD(302)/'OFF '/
C
      DATA INCASE(303)/'CSKS'/
      DATA (INAME(303,J),J=1,6)/
     1'CHIS','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(303)/'ONE '/
      DATA INFLAD(303)/'OFF '/
C
      DATA INCASE(304)/'CSCP'/
      DATA (INAME(304,J),J=1,6)/
     1'CHIS','    ','    ','    ','    ','    '/
      DATA INFLAV(304)/'ONE '/
      DATA INFLAD(304)/'OFF '/
C
      DATA INCASE(305)/'CHKS'/
      DATA (INAME(305,J),J=1,6)/
     1'CHI ','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(305)/'ONE '/
      DATA INFLAD(305)/'OFF '/
C
      DATA INCASE(306)/'CHCP'/
      DATA (INAME(306,J),J=1,6)/
     1'CHI ','    ','    ','    ','    ','    '/
      DATA INFLAV(306)/'ONE '/
      DATA INFLAD(306)/'OFF '/
C
      DATA INCASE(307)/'TKS'/
      DATA (INAME(307,J),J=1,6)/
     1'T   ','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(307)/'ONE '/
      DATA INFLAD(307)/'OFF '/
C
      DATA INCASE(308)/'TCP'/
      DATA (INAME(308,J),J=1,6)/
     1'T   ','    ','    ','    ','    ','    '/
      DATA INFLAV(308)/'ONE '/
      DATA INFLAD(308)/'OFF '/
C
      DATA INCASE(309)/'EEKS'/
      DATA (INAME(309,J),J=1,6)/
     1'GEOM','EXTR','EXPO','KOLM','SMIR','    '/
      DATA INFLAV(309)/'ONE '/
      DATA INFLAD(309)/'OFF '/
C
      DATA INCASE(310)/'EEKS'/
      DATA (INAME(310,J),J=1,6)/
     1'GEOM','EXTR','EXPO','KS  ','    ','    '/
      DATA INFLAV(310)/'ONE '/
      DATA INFLAD(310)/'OFF '/
C
      DATA INCASE(311)/'EEML'/
      DATA (INAME(311,J),J=1,6)/
     1'GEOM','EXTR','EXPO','MAXI','LIKE','    '/
      DATA INFLAV(311)/'ONE '/
      DATA INFLAD(311)/'OFF '/
C
      DATA INCASE(312)/'EEML'/
      DATA (INAME(312,J),J=1,6)/
     1'GEOM','EXTR','EXPO','MLE ','    ','    '/
      DATA INFLAV(312)/'ONE '/
      DATA INFLAD(312)/'OFF '/
C
      DATA INCASE(313)/'EECP'/
      DATA (INAME(313,J),J=1,6)/
     1'GEOM','EXTR','EXPO','    ','    ','    '/
      DATA INFLAV(313)/'ONE '/
      DATA INFLAD(313)/'OFF '/
C
      DATA INCASE(314)/'PAKS'/
      DATA (INAME(314,J),J=1,6)/
     1'PARE','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(314)/'ONE '/
      DATA INFLAD(314)/'OFF '/
C
      DATA INCASE(315)/'PAKS'/
      DATA (INAME(315,J),J=1,6)/
     1'PARE','KS  ','    ','    ','    ','    '/
      DATA INFLAV(315)/'ONE '/
      DATA INFLAD(315)/'OFF '/
C
      DATA INCASE(316)/'PAML'/
      DATA (INAME(316,J),J=1,6)/
     1'PARE','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(316)/'ONE '/
      DATA INFLAD(316)/'OFF '/
C
      DATA INCASE(317)/'PAML'/
      DATA (INAME(317,J),J=1,6)/
     1'PARE','MLE ','    ','    ','    ','    '/
      DATA INFLAV(317)/'ONE '/
      DATA INFLAD(317)/'OFF '/
C
      DATA INCASE(318)/'PACP'/
      DATA (INAME(318,J),J=1,6)/
     1'PARE','    ','    ','    ','    ','    '/
      DATA INFLAV(318)/'ONE '/
      DATA INFLAD(318)/'OFF '/
C
      DATA INCASE(319)/'WAKS'/
      DATA (INAME(319,J),J=1,6)/
     1'WALD','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(319)/'ONE '/
      DATA INFLAD(319)/'OFF '/
C
      DATA INCASE(320)/'WAKS'/
      DATA (INAME(320,J),J=1,6)/
     1'WALD','KS  ','    ','    ','    ','    '/
      DATA INFLAV(320)/'ONE '/
      DATA INFLAD(320)/'OFF '/
C
      DATA INCASE(321)/'WAML'/
      DATA (INAME(321,J),J=1,6)/
     1'WALD','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(321)/'ONE '/
      DATA INFLAD(321)/'OFF '/
C
      DATA INCASE(322)/'WAML'/
      DATA (INAME(322,J),J=1,6)/
     1'WALD','MLE ','    ','    ','    ','    '/
      DATA INFLAV(322)/'ONE '/
      DATA INFLAD(322)/'OFF '/
C
      DATA INCASE(323)/'WACP'/
      DATA (INAME(323,J),J=1,6)/
     1'WALD','    ','    ','    ','    ','    '/
      DATA INFLAV(323)/'ONE '/
      DATA INFLAD(323)/'OFF '/
C
      DATA INCASE(324)/'FLKS'/
      DATA (INAME(324,J),J=1,6)/
     1'FATI','LIFE','KOLM','SMIR','    ','    '/
      DATA INFLAV(324)/'ONE '/
      DATA INFLAD(324)/'OFF '/
C
      DATA INCASE(325)/'FLKS'/
      DATA (INAME(325,J),J=1,6)/
     1'FATI','LIFE','KS  ','    ','    ','    '/
      DATA INFLAV(325)/'ONE '/
      DATA INFLAD(325)/'OFF '/
C
      DATA INCASE(326)/'FLML'/
      DATA (INAME(326,J),J=1,6)/
     1'FATI','LIFE','MAXI','LIKE','    ','    '/
      DATA INFLAV(326)/'ONE '/
      DATA INFLAD(326)/'OFF '/
C
      DATA INCASE(327)/'FLML'/
      DATA (INAME(327,J),J=1,6)/
     1'FATI','LIFE','MLE ','    ','    ','    '/
      DATA INFLAV(327)/'ONE '/
      DATA INFLAD(327)/'OFF '/
C
      DATA INCASE(328)/'FLCP'/
      DATA (INAME(328,J),J=1,6)/
     1'FATI','LIFE','    ','    ','    ','    '/
      DATA INFLAV(328)/'ONE '/
      DATA INFLAD(328)/'OFF '/
C
      DATA INCASE(329)/'FLKS'/
      DATA (INAME(329,J),J=1,6)/
     1'BIRN','SAUN','KOLM','SMIR','    ','    '/
      DATA INFLAV(329)/'ONE '/
      DATA INFLAD(329)/'OFF '/
C
      DATA INCASE(330)/'FLKS'/
      DATA (INAME(330,J),J=1,6)/
     1'BIRN','SAUN','KS  ','    ','    ','    '/
      DATA INFLAV(330)/'ONE '/
      DATA INFLAD(330)/'OFF '/
C
      DATA INCASE(331)/'FLML'/
      DATA (INAME(331,J),J=1,6)/
     1'BIRN','SAUN','MAXI','LIKE','    ','    '/
      DATA INFLAV(331)/'ONE '/
      DATA INFLAD(331)/'OFF '/
C
      DATA INCASE(332)/'FLML'/
      DATA (INAME(332,J),J=1,6)/
     1'BIRN','SAUN','MLE ','    ','    ','    '/
      DATA INFLAV(332)/'ONE '/
      DATA INFLAD(332)/'OFF '/
C
      DATA INCASE(333)/'FLCP'/
      DATA (INAME(333,J),J=1,6)/
     1'BIRN','SAUN','    ','    ','    ','    '/
      DATA INFLAV(333)/'ONE '/
      DATA INFLAD(333)/'OFF '/
C
      DATA INCASE(334)/'E2KS'/
      DATA (INAME(334,J),J=1,6)/
     1'FREC','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(334)/'ONE '/
      DATA INFLAD(334)/'OFF '/
C
      DATA INCASE(335)/'E2KS'/
      DATA (INAME(335,J),J=1,6)/
     1'FREC','KS  ','    ','    ','    ','    '/
      DATA INFLAV(335)/'ONE '/
      DATA INFLAD(335)/'OFF '/
C
      DATA INCASE(336)/'FRML'/
      DATA (INAME(336,J),J=1,6)/
     1'FREC','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(336)/'ONE '/
      DATA INFLAD(336)/'OFF '/
C
      DATA INCASE(337)/'FRML'/
      DATA (INAME(337,J),J=1,6)/
     1'FREC','MLE ','    ','    ','    ','    '/
      DATA INFLAV(337)/'ONE '/
      DATA INFLAD(337)/'OFF '/
C
      DATA INCASE(338)/'E2CP'/
      DATA (INAME(338,J),J=1,6)/
     1'FREC','    ','    ','    ','    ','    '/
      DATA INFLAV(338)/'ONE '/
      DATA INFLAD(338)/'OFF '/
C
      DATA INCASE(339)/'LAKS'/
      DATA (INAME(339,J),J=1,6)/
     1'TUKE','LAMB','KOLM','SMIR','    ','    '/
      DATA INFLAV(339)/'ONE '/
      DATA INFLAD(339)/'OFF '/
C
      DATA INCASE(340)/'LAKS'/
      DATA (INAME(340,J),J=1,6)/
     1'TUKE','LAMB','KS  ','    ','    ','    '/
      DATA INFLAV(340)/'ONE '/
      DATA INFLAD(340)/'OFF '/
C
      DATA INCASE(341)/'LACP'/
      DATA (INAME(341,J),J=1,6)/
     1'TUKE','LAMB','    ','    ','    ','    '/
      DATA INFLAV(341)/'ONE '/
      DATA INFLAD(341)/'OFF '/
C
      DATA INCASE(342)/'LAKS'/
      DATA (INAME(342,J),J=1,6)/
     1'LAMB','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(342)/'ONE '/
      DATA INFLAD(342)/'OFF '/
C
      DATA INCASE(343)/'LAKS'/
      DATA (INAME(343,J),J=1,6)/
     1'LAMB','KS  ','    ','    ','    ','    '/
      DATA INFLAV(343)/'ONE '/
      DATA INFLAD(343)/'OFF '/
C
      DATA INCASE(344)/'LACP'/
      DATA (INAME(344,J),J=1,6)/
     1'LAMB','    ','    ','    ','    ','    '/
      DATA INFLAV(344)/'ONE '/
      DATA INFLAD(344)/'OFF '/
C
      DATA INCASE(345)/'WECP'/
      DATA (INAME(345,J),J=1,6)/
     1'WEIB','    ','    ','    ','    ','    '/
      DATA INFLAV(345)/'ONE '/
      DATA INFLAD(345)/'OFF '/
C
      DATA INCASE(346)/'GHKS'/
      DATA (INAME(346,J),J=1,6)/
     1'GH  ','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(346)/'ONE '/
      DATA INFLAD(346)/'OFF '/
C
      DATA INCASE(347)/'GHKS'/
      DATA (INAME(347,J),J=1,6)/
     1'GH  ','KS  ','    ','    ','    ','    '/
      DATA INFLAV(347)/'ONE '/
      DATA INFLAD(347)/'OFF '/
C
      DATA INCASE(348)/'GHCP'/
      DATA (INAME(348,J),J=1,6)/
     1'GH  ','    ','    ','    ','    ','    '/
      DATA INFLAV(348)/'ONE '/
      DATA INFLAD(348)/'OFF '/
C
      DATA INCASE(349)/'GHKS'/
      DATA (INAME(349,J),J=1,6)/
     1'G   ','H   ','KOLM','SMIR','    ','    '/
      DATA INFLAV(349)/'ONE '/
      DATA INFLAD(349)/'OFF '/
C
      DATA INCASE(350)/'GHKS'/
      DATA (INAME(350,J),J=1,6)/
     1'G   ','H   ','KS  ','    ','    ','    '/
      DATA INFLAV(350)/'ONE '/
      DATA INFLAD(350)/'OFF '/
C
      DATA INCASE(351)/'GHCP'/
      DATA (INAME(351,J),J=1,6)/
     1'G   ','H   ','    ','    ','    ','    '/
      DATA INFLAV(351)/'ONE '/
      DATA INFLAD(351)/'OFF '/
C
      DATA INCASE(352)/'GHKS'/
      DATA (INAME(352,J),J=1,6)/
     1'G   ','AND ','H   ','KOLM','SMIR','    '/
      DATA INFLAV(352)/'ONE '/
      DATA INFLAD(352)/'OFF '/
C
      DATA INCASE(353)/'GHKS'/
      DATA (INAME(353,J),J=1,6)/
     1'G   ','AND ','H   ','KS  ','    ','    '/
      DATA INFLAV(353)/'ONE '/
      DATA INFLAD(353)/'OFF '/
C
      DATA INCASE(354)/'GHCP'/
      DATA (INAME(354,J),J=1,6)/
     1'G   ','AND ','H   ','    ','    ','    '/
      DATA INFLAV(354)/'ONE '/
      DATA INFLAD(354)/'OFF '/
C
      DATA INCASE(355)/'BRKS'/
      DATA (INAME(355,J),J=1,6)/
     1'BRAD','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(355)/'ONE '/
      DATA INFLAD(355)/'OFF '/
C
      DATA INCASE(356)/'BRKS'/
      DATA (INAME(356,J),J=1,6)/
     1'BRAD','KS  ','    ','    ','    ','    '/
      DATA INFLAV(356)/'ONE '/
      DATA INFLAD(356)/'OFF '/
C
      DATA INCASE(357)/'BRCP'/
      DATA (INAME(357,J),J=1,6)/
     1'BRAD','    ','    ','    ','    ','    '/
      DATA INFLAV(357)/'ONE '/
      DATA INFLAD(357)/'OFF '/
C
      DATA INCASE(358)/'REKS'/
      DATA (INAME(358,J),J=1,6)/
     1'RECI','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(358)/'ONE '/
      DATA INFLAD(358)/'OFF '/
C
      DATA INCASE(359)/'REKS'/
      DATA (INAME(359,J),J=1,6)/
     1'RECI','KS  ','    ','    ','    ','    '/
      DATA INFLAV(359)/'ONE '/
      DATA INFLAD(359)/'OFF '/
C
      DATA INCASE(360)/'RECP'/
      DATA (INAME(360,J),J=1,6)/
     1'RECI','    ','    ','    ','    ','    '/
      DATA INFLAV(360)/'ONE '/
      DATA INFLAD(360)/'OFF '/
C
      DATA INCASE(361)/'ERKS'/
      DATA (INAME(361,J),J=1,6)/
     1'ERRO','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(361)/'ONE '/
      DATA INFLAD(361)/'OFF '/
C
      DATA INCASE(362)/'ERKS'/
      DATA (INAME(362,J),J=1,6)/
     1'ERRO','KS  ','    ','    ','    ','    '/
      DATA INFLAV(362)/'ONE '/
      DATA INFLAD(362)/'OFF '/
C
      DATA INCASE(363)/'ERCP'/
      DATA (INAME(363,J),J=1,6)/
     1'ERRO','    ','    ','    ','    ','    '/
      DATA INFLAV(363)/'ONE '/
      DATA INFLAD(363)/'OFF '/
C
      DATA INCASE(364)/'ERKS'/
      DATA (INAME(364,J),J=1,6)/
     1'SUBB','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(364)/'ONE '/
      DATA INFLAD(364)/'OFF '/
C
      DATA INCASE(365)/'ERKS'/
      DATA (INAME(365,J),J=1,6)/
     1'SUBB','KS  ','    ','    ','    ','    '/
      DATA INFLAV(365)/'ONE '/
      DATA INFLAD(365)/'OFF '/
C
      DATA INCASE(366)/'ERCP'/
      DATA (INAME(366,J),J=1,6)/
     1'SUBB','    ','    ','    ','    ','    '/
      DATA INFLAV(366)/'ONE '/
      DATA INFLAD(366)/'OFF '/
C
      DATA INCASE(367)/'TRKS'/
      DATA (INAME(367,J),J=1,6)/
     1'TRIA','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(367)/'ONE '/
      DATA INFLAD(367)/'OFF '/
C
      DATA INCASE(368)/'TRKS'/
      DATA (INAME(368,J),J=1,6)/
     1'TRIA','KS  ','    ','    ','    ','    '/
      DATA INFLAV(368)/'ONE '/
      DATA INFLAD(368)/'OFF '/
C
      DATA INCASE(369)/'TRCP'/
      DATA (INAME(369,J),J=1,6)/
     1'TRIA','    ','    ','    ','    ','    '/
      DATA INFLAV(369)/'ONE '/
      DATA INFLAD(369)/'OFF '/
C
      DATA INCASE(370)/'LLKS'/
      DATA (INAME(370,J),J=1,6)/
     1'LOG ','LOGI','KOLM','SMIR','    ','    '/
      DATA INFLAV(370)/'ONE '/
      DATA INFLAD(370)/'OFF '/
C
      DATA INCASE(371)/'LLKS'/
      DATA (INAME(371,J),J=1,6)/
     1'LOG ','LOGI','KS  ','    ','    ','    '/
      DATA INFLAV(371)/'ONE '/
      DATA INFLAD(371)/'OFF '/
C
      DATA INCASE(372)/'LLCP'/
      DATA (INAME(372,J),J=1,6)/
     1'LOG ','LOGI','    ','    ','    ','    '/
      DATA INFLAV(372)/'ONE '/
      DATA INFLAD(372)/'OFF '/
C
      DATA INCASE(373)/'DWKS'/
      DATA (INAME(373,J),J=1,6)/
     1'DOUB','WEIB','KOLM','SMIR','    ','    '/
      DATA INFLAV(373)/'ONE '/
      DATA INFLAD(373)/'OFF '/
C
      DATA INCASE(374)/'DWKS'/
      DATA (INAME(374,J),J=1,6)/
     1'DOUB','WEIB','KS  ','    ','    ','    '/
      DATA INFLAV(374)/'ONE '/
      DATA INFLAD(374)/'OFF '/
C
      DATA INCASE(375)/'DWCP'/
      DATA (INAME(375,J),J=1,6)/
     1'DOUB','WEIB','    ','    ','    ','    '/
      DATA INFLAV(375)/'ONE '/
      DATA INFLAD(375)/'OFF '/
C
      DATA INCASE(376)/'FTKS'/
      DATA (INAME(376,J),J=1,6)/
     1'FOLD','T   ','KOLM','SMIR','    ','    '/
      DATA INFLAV(376)/'ONE '/
      DATA INFLAD(376)/'OFF '/
C
      DATA INCASE(377)/'FTKS'/
      DATA (INAME(377,J),J=1,6)/
     1'FOLD','T   ','KS  ','    ','    ','    '/
      DATA INFLAV(377)/'ONE '/
      DATA INFLAD(377)/'OFF '/
C
      DATA INCASE(378)/'FTCP'/
      DATA (INAME(378,J),J=1,6)/
     1'FOLD','T   ','    ','    ','    ','    '/
      DATA INFLAV(378)/'ONE '/
      DATA INFLAD(378)/'OFF '/
C
      DATA INCASE(379)/'ADKS'/
      DATA (INAME(379,J),J=1,6)/
     1'ASYM','LAPL','KOLM','SMIR','    ','    '/
      DATA INFLAV(379)/'ONE '/
      DATA INFLAD(379)/'OFF '/
C
      DATA INCASE(380)/'ADKS'/
      DATA (INAME(380,J),J=1,6)/
     1'ASYM','LAPL','KS  ','    ','    ','    '/
      DATA INFLAV(380)/'ONE '/
      DATA INFLAD(380)/'OFF '/
C
      DATA INCASE(381)/'ADML'/
      DATA (INAME(381,J),J=1,6)/
     1'ASYM','LAPL','MAXI','LIKE','    ','    '/
      DATA INFLAV(381)/'ONE '/
      DATA INFLAD(381)/'OFF '/
C
      DATA INCASE(382)/'LXKS'/
      DATA (INAME(382,J),J=1,6)/
     1'LOG ','LAPL','KOLM','SMIR','    ','    '/
      DATA INFLAV(382)/'ONE '/
      DATA INFLAD(382)/'OFF '/
C
      DATA INCASE(383)/'LXKS'/
      DATA (INAME(383,J),J=1,6)/
     1'LOG ','LAPL','KS  ','    ','    ','    '/
      DATA INFLAV(383)/'ONE '/
      DATA INFLAD(383)/'OFF '/
C
      DATA INCASE(384)/'LXCP'/
      DATA (INAME(384,J),J=1,6)/
     1'LOG ','LAPL','    ','    ','    ','    '/
      DATA INFLAV(384)/'ONE '/
      DATA INFLAD(384)/'OFF '/
C
      DATA INCASE(385)/'SDKS'/
      DATA (INAME(385,J),J=1,6)/
     1'SKEW','DOUB','EXPO','KOLM','SMIR','    '/
      DATA INFLAV(385)/'ONE '/
      DATA INFLAD(385)/'OFF '/
C
      DATA INCASE(386)/'SDKS'/
      DATA (INAME(386,J),J=1,6)/
     1'SKEW','DOUB','EXPO','KS  ','    ','    '/
      DATA INFLAV(386)/'ONE '/
      DATA INFLAD(386)/'OFF '/
C
      DATA INCASE(387)/'SDCP'/
      DATA (INAME(387,J),J=1,6)/
     1'SKEW','DOUB','EXPO','    ','    ','    '/
      DATA INFLAV(387)/'ONE '/
      DATA INFLAD(387)/'OFF '/
C
      DATA INCASE(388)/'ADKS'/
      DATA (INAME(388,J),J=1,6)/
     1'ASYM','DOUB','EXPO','KOLM','SMIR','    '/
      DATA INFLAV(388)/'ONE '/
      DATA INFLAD(388)/'OFF '/
C
      DATA INCASE(389)/'ADKS'/
      DATA (INAME(389,J),J=1,6)/
     1'ASYM','DOUB','EXPO','KS  ','    ','    '/
      DATA INFLAV(389)/'ONE '/
      DATA INFLAD(389)/'OFF '/
C
      DATA INCASE(390)/'ADCP'/
      DATA (INAME(390,J),J=1,6)/
     1'ASYM','DOUB','EXPO','    ','    ','    '/
      DATA INFLAV(390)/'ONE '/
      DATA INFLAD(390)/'OFF '/
C
      DATA INCASE(391)/'LXKS'/
      DATA (INAME(391,J),J=1,6)/
     1'LOG ','DOUB','EXPO','KOLM','SMIR','    '/
      DATA INFLAV(391)/'ONE '/
      DATA INFLAD(391)/'OFF '/
C
      DATA INCASE(392)/'LXKS'/
      DATA (INAME(392,J),J=1,6)/
     1'LOG ','DOUB','EXPO','KS  ','    ','    '/
      DATA INFLAV(392)/'ONE '/
      DATA INFLAD(392)/'OFF '/
C
      DATA INCASE(393)/'LXCP'/
      DATA (INAME(393,J),J=1,6)/
     1'LOG ','DOUB','EXPO','    ','    ','    '/
      DATA INFLAV(393)/'ONE '/
      DATA INFLAD(393)/'OFF '/
C
      DATA INCASE(394)/'GVKS'/
      DATA (INAME(394,J),J=1,6)/
     1'GENE','EXTR','VALU','KOLM','SMIR','    '/
      DATA INFLAV(394)/'ONE '/
      DATA INFLAD(394)/'OFF '/
C
      DATA INCASE(395)/'GVKS'/
      DATA (INAME(395,J),J=1,6)/
     1'GENE','EXTR','VALU','KS  ','    ','    '/
      DATA INFLAV(395)/'ONE '/
      DATA INFLAD(395)/'OFF '/
C
      DATA INCASE(396)/'GVCP'/
      DATA (INAME(396,J),J=1,6)/
     1'GENE','EXTR','VALU','    ','    ','    '/
      DATA INFLAV(396)/'ONE '/
      DATA INFLAD(396)/'OFF '/
C
      DATA INCASE(397)/'SDKS'/
      DATA (INAME(397,J),J=1,6)/
     1'SKEW','LAPL','KOLM','SMIR','    ','    '/
      DATA INFLAV(397)/'ONE '/
      DATA INFLAD(397)/'OFF '/
C
      DATA INCASE(398)/'SDKS'/
      DATA (INAME(398,J),J=1,6)/
     1'SKEW','LAPL','KS  ','    ','    ','    '/
      DATA INFLAV(398)/'ONE '/
      DATA INFLAD(398)/'OFF '/
C
      DATA INCASE(399)/'SDCP'/
      DATA (INAME(399,J),J=1,6)/
     1'SKEW','LAPL','    ','    ','    ','    '/
      DATA INFLAV(399)/'ONE '/
      DATA INFLAD(399)/'OFF '/
C
      DATA INCASE(400)/'HLPP'/
      DATA (INAME(400,J),J=1,6)/
     1'HALF','LOGI','    ','    ','    ','    '/
      DATA INFLAV(400)/'ONE '/
      DATA INFLAD(400)/'OFF '/
C
      DATA INCASE(401)/'PFKS'/
      DATA (INAME(401,J),J=1,6)/
     1'POWE','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(401)/'ONE '/
      DATA INFLAD(401)/'OFF '/
C
      DATA INCASE(402)/'PFKS'/
      DATA (INAME(402,J),J=1,6)/
     1'POWE','KS  ','    ','    ','    ','    '/
      DATA INFLAV(402)/'ONE '/
      DATA INFLAD(402)/'OFF '/
C
      DATA INCASE(403)/'PFML'/
      DATA (INAME(403,J),J=1,6)/
     1'POWE','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(403)/'ONE '/
      DATA INFLAD(403)/'OFF '/
C
      DATA INCASE(404)/'PFML'/
      DATA (INAME(404,J),J=1,6)/
     1'POWE','MLE ','    ','    ','    ','    '/
      DATA INFLAV(404)/'ONE '/
      DATA INFLAD(404)/'OFF '/
C
      DATA INCASE(405)/'PFCP'/
      DATA (INAME(405,J),J=1,6)/
     1'POWE','    ','    ','    ','    ','    '/
      DATA INFLAV(405)/'ONE '/
      DATA INFLAD(405)/'OFF '/
C
      DATA INCASE(406)/'VMKS'/
      DATA (INAME(406,J),J=1,6)/
     1'VON ','MISE','KOLM','SMIR','    ','    '/
      DATA INFLAV(406)/'ONE '/
      DATA INFLAD(406)/'OFF '/
C
      DATA INCASE(407)/'VMKS'/
      DATA (INAME(407,J),J=1,6)/
     1'VON ','MISE','KS  ','    ','    ','    '/
      DATA INFLAV(407)/'ONE '/
      DATA INFLAD(407)/'OFF '/
C
      DATA INCASE(408)/'VMCP'/
      DATA (INAME(408,J),J=1,6)/
     1'VON ','MISE','    ','    ','    ','    '/
      DATA INFLAV(408)/'ONE '/
      DATA INFLAD(408)/'OFF '/
C
      DATA INCASE(409)/'GLKS'/
      DATA (INAME(409,J),J=1,6)/
     1'GENE','LOGI','KOLM','SMIR','    ','    '/
      DATA INFLAV(409)/'ONE '/
      DATA INFLAD(409)/'OFF '/
C
      DATA INCASE(410)/'GLKS'/
      DATA (INAME(410,J),J=1,6)/
     1'GENE','LOGI','KS  ','    ','    ','    '/
      DATA INFLAV(410)/'ONE '/
      DATA INFLAD(410)/'OFF '/
C
      DATA INCASE(411)/'GLCP'/
      DATA (INAME(411,J),J=1,6)/
     1'GENE','LOGI','    ','    ','    ','    '/
      DATA INFLAV(411)/'ONE '/
      DATA INFLAD(411)/'OFF '/
C
      DATA INCASE(412)/'GZKS'/
      DATA (INAME(412,J),J=1,6)/
     1'GENE','HALF','LOGI','KOLM','SMIR','    '/
      DATA INFLAV(412)/'ONE '/
      DATA INFLAD(412)/'OFF '/
C
      DATA INCASE(413)/'GZKS'/
      DATA (INAME(413,J),J=1,6)/
     1'GENE','HALF','LOGI','KS  ','    ','    '/
      DATA INFLAV(413)/'ONE '/
      DATA INFLAD(413)/'OFF '/
C
      DATA INCASE(414)/'GZCP'/
      DATA (INAME(414,J),J=1,6)/
     1'GENE','HALF','LOGI','    ','    ','    '/
      DATA INFLAV(414)/'ONE '/
      DATA INFLAD(414)/'OFF '/
C
      DATA INCASE(415)/'P2KS'/
      DATA (INAME(415,J),J=1,6)/
     1'PARE','SECO','KIND','KOLM','SMIR','    '/
      DATA INFLAV(415)/'ONE '/
      DATA INFLAD(415)/'OFF '/
C
      DATA INCASE(416)/'P2KS'/
      DATA (INAME(416,J),J=1,6)/
     1'PARE','SECO','KIND','KS  ','    ','    '/
      DATA INFLAV(416)/'ONE '/
      DATA INFLAD(416)/'OFF '/
C
      DATA INCASE(417)/'P2CP'/
      DATA (INAME(417,J),J=1,6)/
     1'PARE','SECO','KIND','    ','    ','    '/
      DATA INFLAV(417)/'ONE '/
      DATA INFLAD(417)/'OFF '/
C
      DATA INCASE(418)/'WCKS'/
      DATA (INAME(418,J),J=1,6)/
     1'WRAP','CAUC','KOLM','SMIR','    ','    '/
      DATA INFLAV(418)/'ONE '/
      DATA INFLAD(418)/'OFF '/
C
      DATA INCASE(419)/'WCKS'/
      DATA (INAME(419,J),J=1,6)/
     1'WRAP','CAUC','KS  ','    ','    ','    '/
      DATA INFLAV(419)/'ONE '/
      DATA INFLAD(419)/'OFF '/
C
      DATA INCASE(420)/'WCCP'/
      DATA (INAME(420,J),J=1,6)/
     1'WRAP','CAUC','    ','    ','    ','    '/
      DATA INFLAV(420)/'ONE '/
      DATA INFLAD(420)/'OFF '/
C
      DATA INCASE(421)/'PFKS'/
      DATA (INAME(421,J),J=1,6)/
     1'POWE','FUNC','KOLM','SMIR','    ','    '/
      DATA INFLAV(421)/'ONE '/
      DATA INFLAD(421)/'OFF '/
C
      DATA INCASE(422)/'PFKS'/
      DATA (INAME(422,J),J=1,6)/
     1'POWE','FUNC','KS  ','    ','    ','    '/
      DATA INFLAV(422)/'ONE '/
      DATA INFLAD(422)/'OFF '/
C
      DATA INCASE(423)/'PFML'/
      DATA (INAME(423,J),J=1,6)/
     1'POWE','FUNC','MAXI','LIKE','    ','    '/
      DATA INFLAV(423)/'ONE '/
      DATA INFLAD(423)/'OFF '/
C
      DATA INCASE(424)/'PFML'/
      DATA (INAME(424,J),J=1,6)/
     1'POWE','FUNC','MLE ','    ','    ','    '/
      DATA INFLAV(424)/'ONE '/
      DATA INFLAD(424)/'OFF '/
C
      DATA INCASE(425)/'PFCP'/
      DATA (INAME(425,J),J=1,6)/
     1'POWE','FUNC','    ','    ','    ','    '/
      DATA INFLAV(425)/'ONE '/
      DATA INFLAD(425)/'OFF '/
C
      DATA INCASE(426)/'ADML'/
      DATA (INAME(426,J),J=1,6)/
     1'ASYM','LAPL','MLE ','    ','    ','    '/
      DATA INFLAV(426)/'ONE '/
      DATA INFLAD(426)/'OFF '/
C
      DATA INCASE(427)/'ADCP'/
      DATA (INAME(427,J),J=1,6)/
     1'ASYM','LAPL','    ','    ','    ','    '/
      DATA INFLAV(427)/'ONE '/
      DATA INFLAD(427)/'OFF '/
C
      DATA INCASE(428)/'IGKS'/
      DATA (INAME(428,J),J=1,6)/
     1'INVE','GAUS','KOLM','SMIR','    ','    '/
      DATA INFLAV(428)/'ONE '/
      DATA INFLAD(428)/'OFF '/
C
      DATA INCASE(429)/'IGKS'/
      DATA (INAME(429,J),J=1,6)/
     1'INVE','GAUS','KS  ','    ','    ','    '/
      DATA INFLAV(429)/'ONE '/
      DATA INFLAD(429)/'OFF '/
C
      DATA INCASE(430)/'IGML'/
      DATA (INAME(430,J),J=1,6)/
     1'INVE','GAUS','MAXI','LIKE','    ','    '/
      DATA INFLAV(430)/'ONE '/
      DATA INFLAD(430)/'OFF '/
C
      DATA INCASE(431)/'IGML'/
      DATA (INAME(431,J),J=1,6)/
     1'INVE','GAUS','MLE ','    ','    ','    '/
      DATA INFLAV(431)/'ONE '/
      DATA INFLAD(431)/'OFF '/
C
      DATA INCASE(432)/'IGCP'/
      DATA (INAME(432,J),J=1,6)/
     1'INVE','GAUS','    ','    ','    ','    '/
      DATA INFLAV(432)/'ONE '/
      DATA INFLAD(432)/'OFF '/
C
      DATA INCASE(433)/'FNKS'/
      DATA (INAME(433,J),J=1,6)/
     1'FOLD','NORM','KOLM','SMIR','    ','    '/
      DATA INFLAV(433)/'ONE '/
      DATA INFLAD(433)/'OFF '/
C
      DATA INCASE(434)/'FNKS'/
      DATA (INAME(434,J),J=1,6)/
     1'FOLD','NORM','KS  ','    ','    ','    '/
      DATA INFLAV(434)/'ONE '/
      DATA INFLAD(434)/'OFF '/
C
      DATA INCASE(435)/'FNML'/
      DATA (INAME(435,J),J=1,6)/
     1'FOLD','NORM','MAXI','LIKE','    ','    '/
      DATA INFLAV(435)/'ONE '/
      DATA INFLAD(435)/'OFF '/
C
      DATA INCASE(436)/'FNML'/
      DATA (INAME(436,J),J=1,6)/
     1'FOLD','NORM','MLE ','    ','    ','    '/
      DATA INFLAV(436)/'ONE '/
      DATA INFLAD(436)/'OFF '/
C
      DATA INCASE(437)/'FNCP'/
      DATA (INAME(437,J),J=1,6)/
     1'FOLD','NORM','    ','    ','    ','    '/
      DATA INFLAV(437)/'ONE '/
      DATA INFLAD(437)/'OFF '/
C
      DATA INCASE(438)/'LOPP'/
      DATA (INAME(438,J),J=1,6)/
     1'LOGI','    ','    ','    ','    ','    '/
      DATA INFLAV(438)/'ONE '/
      DATA INFLAD(438)/'OFF '/
C
      DATA INCASE(439)/'BEKS'/
      DATA (INAME(439,J),J=1,6)/
     1'BETA','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(439)/'ONE '/
      DATA INFLAD(439)/'OFF '/
C
      DATA INCASE(440)/'BEKS'/
      DATA (INAME(440,J),J=1,6)/
     1'BETA','KS  ','    ','    ','    ','    '/
      DATA INFLAV(440)/'ONE '/
      DATA INFLAD(440)/'OFF '/
C
      DATA INCASE(441)/'BEML'/
      DATA (INAME(441,J),J=1,6)/
     1'BETA','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(441)/'ONE '/
      DATA INFLAD(441)/'OFF '/
C
      DATA INCASE(442)/'BEML'/
      DATA (INAME(442,J),J=1,6)/
     1'BETA','MLE ','    ','    ','    ','    '/
      DATA INFLAV(442)/'ONE '/
      DATA INFLAD(442)/'OFF '/
C
      DATA INCASE(443)/'BECP'/
      DATA (INAME(443,J),J=1,6)/
     1'BETA','    ','    ','    ','    ','    '/
      DATA INFLAV(443)/'ONE '/
      DATA INFLAD(443)/'OFF '/
C
      DATA INCASE(444)/'FKS'/
      DATA (INAME(444,J),J=1,6)/
     1'F   ','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(444)/'ONE '/
      DATA INFLAD(444)/'OFF '/
C
      DATA INCASE(445)/'FKS'/
      DATA (INAME(445,J),J=1,6)/
     1'F   ','KS  ','    ','    ','    ','    '/
      DATA INFLAV(445)/'ONE '/
      DATA INFLAD(445)/'OFF '/
C
      DATA INCASE(446)/'FCP'/
      DATA (INAME(446,J),J=1,6)/
     1'F   ','    ','    ','    ','    ','    '/
      DATA INFLAV(446)/'ONE '/
      DATA INFLAD(446)/'OFF '/
C
      DATA INCASE(447)/'GGKS'/
      DATA (INAME(447,J),J=1,6)/
     1'GENE','GAMM','KOLM','SMIR','    ','    '/
      DATA INFLAV(447)/'ONE '/
      DATA INFLAD(447)/'OFF '/
C
      DATA INCASE(448)/'GGKS'/
      DATA (INAME(448,J),J=1,6)/
     1'GENE','GAMM','KS  ','    ','    ','    '/
      DATA INFLAV(448)/'ONE '/
      DATA INFLAD(448)/'OFF '/
C
      DATA INCASE(449)/'GGCP'/
      DATA (INAME(449,J),J=1,6)/
     1'GENE','GAMM','    ','    ','    ','    '/
      DATA INFLAV(449)/'ONE '/
      DATA INFLAD(449)/'OFF '/
C
      DATA INCASE(450)/'DGKS'/
      DATA (INAME(450,J),J=1,6)/
     1'DOUB','GAMM','KOLM','SMIR','    ','    '/
      DATA INFLAV(450)/'ONE '/
      DATA INFLAD(450)/'OFF '/
C
      DATA INCASE(451)/'DGKS'/
      DATA (INAME(451,J),J=1,6)/
     1'DOUB','GAMM','KS  ','    ','    ','    '/
      DATA INFLAV(451)/'ONE '/
      DATA INFLAD(451)/'OFF '/
C
      DATA INCASE(452)/'DGCP'/
      DATA (INAME(452,J),J=1,6)/
     1'DOUB','GAMM','    ','    ','    ','    '/
      DATA INFLAV(452)/'ONE '/
      DATA INFLAD(452)/'OFF '/
C
      DATA INCASE(453)/'PNKS'/
      DATA (INAME(453,J),J=1,6)/
     1'POWE','NORM','KOLM','SMIR','    ','    '/
      DATA INFLAV(453)/'ONE '/
      DATA INFLAD(453)/'OFF '/
C
      DATA INCASE(454)/'PNKS'/
      DATA (INAME(454,J),J=1,6)/
     1'POWE','NORM','KS  ','    ','    ','    '/
      DATA INFLAV(454)/'ONE '/
      DATA INFLAD(454)/'OFF '/
C
      DATA INCASE(455)/'PNML'/
      DATA (INAME(455,J),J=1,6)/
     1'POWE','NORM','MAXI','LIKE','    ','    '/
      DATA INFLAV(455)/'ONE '/
      DATA INFLAD(455)/'OFF '/
C
      DATA INCASE(456)/'PNML'/
      DATA (INAME(456,J),J=1,6)/
     1'POWE','NORM','MLE ','    ','    ','    '/
      DATA INFLAV(456)/'ONE '/
      DATA INFLAD(456)/'OFF '/
C
      DATA INCASE(457)/'PNCP'/
      DATA (INAME(457,J),J=1,6)/
     1'POWE','NORM','    ','    ','    ','    '/
      DATA INFLAV(457)/'ONE '/
      DATA INFLAD(457)/'OFF '/
C
      DATA INCASE(458)/'GEML'/
      DATA (INAME(458,J),J=1,6)/
     1'GENE','PARE','MAXI','LIKE','    ','    '/
      DATA INFLAV(458)/'ONE '/
      DATA INFLAD(458)/'OFF '/
C
      DATA INCASE(459)/'GEMO'/
      DATA (INAME(459,J),J=1,6)/
     1'GENE','PARE','MOME','    ','    ','    '/
      DATA INFLAV(459)/'ONE '/
      DATA INFLAD(459)/'OFF '/
C
      DATA INCASE(460)/'GEDE'/
      DATA (INAME(460,J),J=1,6)/
     1'DEHA','    ','    ','    ','    ','    '/
      DATA INFLAV(460)/'ONE '/
      DATA INFLAD(460)/'OFF '/
C
      DATA INCASE(461)/'GECM'/
      DATA (INAME(461,J),J=1,6)/
     1'CME ','    ','    ','    ','    ','    '/
      DATA INFLAV(461)/'ONE '/
      DATA INFLAD(461)/'OFF '/
C
      DATA INCASE(462)/'GECP'/
      DATA (INAME(462,J),J=1,6)/
     1'GENE','PARE','    ','    ','    ','    '/
      DATA INFLAV(462)/'ONE '/
      DATA INFLAD(462)/'OFF '/
C
      DATA INCASE(463)/'FRML'/
      DATA (INAME(463,J),J=1,6)/
     1'EXTR','VALU','TYPE','2   ','MAXI','LIKE'/
      DATA INFLAV(463)/'ONE '/
      DATA INFLAD(463)/'OFF '/
C
      DATA INCASE(464)/'FRML'/
      DATA (INAME(464,J),J=1,6)/
     1'EXTR','VALU','TYPE','2   ','MLE ','    '/
      DATA INFLAV(464)/'ONE '/
      DATA INFLAD(464)/'OFF '/
C
      DATA INCASE(466)/'E2KS'/
      DATA (INAME(466,J),J=1,6)/
     1'EXTR','VALU','TYPE','2   ','KOLM','SMIR'/
      DATA INFLAV(466)/'ONE '/
      DATA INFLAD(466)/'OFF '/
C
      DATA INCASE(467)/'E2KS'/
      DATA (INAME(467,J),J=1,6)/
     1'EXTR','VALU','TYPE','2   ','KS  ','    '/
      DATA INFLAV(467)/'ONE '/
      DATA INFLAD(467)/'OFF '/
C
      DATA INCASE(468)/'E2CP'/
      DATA (INAME(468,J),J=1,6)/
     1'EXTR','VALU','TYPE','2   ','    ','    '/
      DATA INFLAV(468)/'ONE '/
      DATA INFLAD(468)/'OFF '/
C
      DATA INCASE(469)/'MAML'/
      DATA (INAME(469,J),J=1,6)/
     1'MAXW','MAXI','LIKE','    ','    ','    '/
      DATA INFLAV(469)/'ONE '/
      DATA INFLAD(469)/'OFF '/
C
      DATA INCASE(470)/'MAKS'/
      DATA (INAME(470,J),J=1,6)/
     1'MAXW','KOLM','SMIR','    ','    ','    '/
      DATA INFLAV(470)/'ONE '/
      DATA INFLAD(470)/'OFF '/
C
      DATA INCASE(471)/'MAKS'/
      DATA (INAME(471,J),J=1,6)/
     1'MAXW','KS  ','    ','    ','    ','    '/
      DATA INFLAV(471)/'ONE '/
      DATA INFLAD(471)/'OFF '/
C
      DATA INCASE(472)/'IWML'/
      DATA (INAME(472,J),J=1,6)/
     1'INVE','WEIB','MLE ','    ','    ','    '/
      DATA INFLAV(472)/'ONE '/
      DATA INFLAD(472)/'OFF '/
C
      DATA INCASE(473)/'IWCP'/
      DATA (INAME(473,J),J=1,6)/
     1'INVE','WEIB','    ','    ','    ','    '/
      DATA INFLAV(473)/'ONE '/
      DATA INFLAD(473)/'OFF '/
C
      DATA INCASE(474)/'RATI'/
      DATA (INAME(474,J),J=1,6)/
     1'RATI','    ','    ','    ','    ','    '/
      DATA INFLAV(474)/'TWO '/
      DATA INFLAD(474)/'OFF '/
C
      DATA INCASE(475)/'G2KS'/
      DATA (INAME(475,J),J=1,6)/
     1'GENE','LOGI','TYPE','2   ','KOLM','SMIR'/
      DATA INFLAV(475)/'ONE '/
      DATA INFLAD(475)/'OFF '/
C
      DATA INCASE(476)/'G2KS'/
      DATA (INAME(476,J),J=1,6)/
     1'GENE','LOGI','TYPE','II  ','KOLM','SMIR'/
      DATA INFLAV(476)/'ONE '/
      DATA INFLAD(476)/'OFF '/
C
      DATA INCASE(477)/'G2KS'/
      DATA (INAME(477,J),J=1,6)/
     1'GENE','LOGI','TYPE','2   ','KS  ','    '/
      DATA INFLAV(477)/'ONE '/
      DATA INFLAD(477)/'OFF '/
C
      DATA INCASE(478)/'G2KS'/
      DATA (INAME(478,J),J=1,6)/
     1'GENE','LOGI','TYPE','II  ','KS  ','    '/
      DATA INFLAV(478)/'ONE '/
      DATA INFLAD(478)/'OFF '/
C
      DATA INCASE(479)/'G2CP'/
      DATA (INAME(479,J),J=1,6)/
     1'GENE','LOGI','TYPE','2   ','    ','    '/
      DATA INFLAV(479)/'ONE '/
      DATA INFLAD(479)/'OFF '/
C
      DATA INCASE(480)/'G2CP'/
      DATA (INAME(480,J),J=1,6)/
     1'GENE','LOGI','TYPE','II  ','    ','    '/
      DATA INFLAV(480)/'ONE '/
      DATA INFLAD(480)/'OFF '/
C
      DATA INCASE(481)/'G3KS'/
      DATA (INAME(481,J),J=1,6)/
     1'GENE','LOGI','TYPE','3   ','KOLM','SMIR'/
      DATA INFLAV(481)/'ONE '/
      DATA INFLAD(481)/'OFF '/
C
      DATA INCASE(482)/'G3KS'/
      DATA (INAME(482,J),J=1,6)/
     1'GENE','LOGI','TYPE','III ','KOLM','SMIR'/
      DATA INFLAV(482)/'ONE '/
      DATA INFLAD(482)/'OFF '/
C
      DATA INCASE(483)/'G3KS'/
      DATA (INAME(483,J),J=1,6)/
     1'GENE','LOGI','TYPE','3   ','KS  ','    '/
      DATA INFLAV(483)/'ONE '/
      DATA INFLAD(483)/'OFF '/
C
      DATA INCASE(484)/'G3KS'/
      DATA (INAME(484,J),J=1,6)/
     1'GENE','LOGI','TYPE','III ','KS  ','    '/
      DATA INFLAV(484)/'ONE '/
      DATA INFLAD(484)/'OFF '/
C
      DATA INCASE(485)/'G3CP'/
      DATA (INAME(485,J),J=1,6)/
     1'GENE','LOGI','TYPE','3   ','    ','    '/
      DATA INFLAV(485)/'ONE '/
      DATA INFLAD(485)/'OFF '/
C
      DATA INCASE(486)/'G3CP'/
      DATA (INAME(486,J),J=1,6)/
     1'GENE','LOGI','TYPE','III ','    ','    '/
      DATA INFLAV(486)/'ONE '/
      DATA INFLAD(486)/'OFF '/
C
      DATA INCASE(487)/'G4KS'/
      DATA (INAME(487,J),J=1,6)/
     1'GENE','LOGI','TYPE','4   ','KOLM','SMIR'/
      DATA INFLAV(487)/'ONE '/
      DATA INFLAD(487)/'OFF '/
C
      DATA INCASE(488)/'G4KS'/
      DATA (INAME(488,J),J=1,6)/
     1'GENE','LOGI','TYPE','IV  ','KOLM','SMIR'/
      DATA INFLAV(488)/'ONE '/
      DATA INFLAD(488)/'OFF '/
C
      DATA INCASE(489)/'G4KS'/
      DATA (INAME(489,J),J=1,6)/
     1'GENE','LOGI','TYPE','4   ','KS  ','    '/
      DATA INFLAV(489)/'ONE '/
      DATA INFLAD(489)/'OFF '/
C
      DATA INCASE(490)/'G4KS'/
      DATA (INAME(490,J),J=1,6)/
     1'GENE','LOGI','TYPE','IV  ','KS  ','    '/
      DATA INFLAV(490)/'ONE '/
      DATA INFLAD(490)/'OFF '/
C
      DATA INCASE(491)/'G4CP'/
      DATA (INAME(491,J),J=1,6)/
     1'GENE','LOGI','TYPE','4   ','    ','    '/
      DATA INFLAV(491)/'ONE '/
      DATA INFLAD(491)/'OFF '/
C
      DATA INCASE(492)/'G4CP'/
      DATA (INAME(492,J),J=1,6)/
     1'GENE','LOGI','TYPE','IV  ','    ','    '/
      DATA INFLAV(492)/'ONE '/
      DATA INFLAD(492)/'OFF '/
C
      DATA INCASE(493)/'G5KS'/
      DATA (INAME(493,J),J=1,6)/
     1'GENE','LOGI','TYPE','5   ','KOLM','SMIR'/
      DATA INFLAV(493)/'ONE '/
      DATA INFLAD(493)/'OFF '/
C
      DATA INCASE(494)/'G5KS'/
      DATA (INAME(494,J),J=1,6)/
     1'GENE','LOGI','TYPE','V   ','KOLM','SMIR'/
      DATA INFLAV(494)/'ONE '/
      DATA INFLAD(494)/'OFF '/
C
      DATA INCASE(495)/'G5KS'/
      DATA (INAME(495,J),J=1,6)/
     1'GENE','LOGI','HOSK','KOLM','SMIR','    '/
      DATA INFLAV(495)/'ONE '/
      DATA INFLAD(495)/'OFF '/
C
      DATA INCASE(496)/'G5KS'/
      DATA (INAME(496,J),J=1,6)/
     1'GENE','LOGI','TYPE','5   ','KS  ','    '/
      DATA INFLAV(496)/'ONE '/
      DATA INFLAD(496)/'OFF '/
C
      DATA INCASE(497)/'G5KS'/
      DATA (INAME(497,J),J=1,6)/
     1'GENE','LOGI','TYPE','V   ','KS  ','    '/
      DATA INFLAV(497)/'ONE '/
      DATA INFLAD(497)/'OFF '/
C
      DATA INCASE(498)/'G5KS'/
      DATA (INAME(498,J),J=1,6)/
     1'GENE','LOGI','HOSK','KS  ','    ','    '/
      DATA INFLAV(498)/'ONE '/
      DATA INFLAD(498)/'OFF '/
C
      DATA INCASE(499)/'G5CP'/
      DATA (INAME(499,J),J=1,6)/
     1'GENE','LOGI','TYPE','5   ','    ','    '/
      DATA INFLAV(499)/'ONE '/
      DATA INFLAD(499)/'OFF '/
C
      DATA INCASE(500)/'G5CP'/
      DATA (INAME(500,J),J=1,6)/
     1'GENE','LOGI','TYPE','V   ','    ','    '/
      DATA INFLAV(500)/'ONE '/
      DATA INFLAD(500)/'OFF '/
C
      DATA INCASE(501)/'G5CP'/
      DATA (INAME(501,J),J=1,6)/
     1'GENE','LOGI','HOSK','    ','    ','    '/
      DATA INFLAV(501)/'ONE '/
      DATA INFLAD(501)/'OFF '/
C
      DATA INCASE(502)/'BNKS'/
      DATA (INAME(502,J),J=1,6)/
     1'BETA','NORM','KOLM','SMIR','    ','    '/
      DATA INFLAV(502)/'ONE '/
      DATA INFLAD(502)/'OFF '/
C
      DATA INCASE(503)/'BNKS'/
      DATA (INAME(503,J),J=1,6)/
     1'BETA','NORM','KS  ','    ','    ','    '/
      DATA INFLAV(503)/'ONE '/
      DATA INFLAD(503)/'OFF '/
C
      DATA INCASE(504)/'BNCP'/
      DATA (INAME(504,J),J=1,6)/
     1'BETA','NORM','    ','    ','    ','    '/
      DATA INFLAV(504)/'ONE '/
      DATA INFLAD(504)/'OFF '/
C
      DATA INCASE(505)/'G5LM'/
      DATA (INAME(505,J),J=1,6)/
     1'GENE','LOGI','TYPE','5   ','LMOM','    '/
      DATA INFLAV(505)/'ONE '/
      DATA INFLAD(505)/'OFF '/
C
      DATA INCASE(506)/'G5LM'/
      DATA (INAME(506,J),J=1,6)/
     1'GENE','LOGI','TYPE','V   ','LMOM','    '/
      DATA INFLAV(506)/'ONE '/
      DATA INFLAD(506)/'OFF '/
C
      DATA INCASE(507)/'G5LM'/
      DATA (INAME(507,J),J=1,6)/
     1'GENE','LOGI','HOSK','LMOM','    ','    '/
      DATA INFLAV(507)/'ONE '/
      DATA INFLAD(507)/'OFF '/
C
      DATA INCASE(508)/'G5LM'/
      DATA (INAME(508,J),J=1,6)/
     1'GENE','LOGI','TYPE','5   ','L   ','MOME'/
      DATA INFLAV(508)/'ONE '/
      DATA INFLAD(508)/'OFF '/
C
      DATA INCASE(509)/'G5LM'/
      DATA (INAME(509,J),J=1,6)/
     1'GENE','LOGI','TYPE','V   ','L   ','MOME'/
      DATA INFLAV(509)/'ONE '/
      DATA INFLAD(509)/'OFF '/
C
      DATA INCASE(510)/'G5LM'/
      DATA (INAME(510,J),J=1,6)/
     1'GENE','LOGI','HOSK','L   ','MOME','    '/
      DATA INFLAV(510)/'ONE '/
      DATA INFLAD(510)/'OFF '/
C
      DATA INCASE(511)/'LDKS'/
      DATA (INAME(511,J),J=1,6)/
     1'GENE','TUKE','LAMB','KOLM','SMIR','    '/
      DATA INFLAV(511)/'ONE '/
      DATA INFLAD(511)/'OFF '/
C
      DATA INCASE(512)/'LDKS'/
      DATA (INAME(512,J),J=1,6)/
     1'GENE','TUKE','LAMB','KS  ','    ','    '/
      DATA INFLAV(512)/'ONE '/
      DATA INFLAD(512)/'OFF '/
C
      DATA INCASE(513)/'LDCP'/
      DATA (INAME(513,J),J=1,6)/
     1'GENE','TUKE','LAMB','    ','    ','    '/
      DATA INFLAV(513)/'ONE '/
      DATA INFLAD(513)/'OFF '/
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      IFLAGD='OFF'
      IFLAGV='ONE'
      NGRPV=0
      ICENSO='OFF'
      IMETHD='UNIM'
      IF(IPPLCN.EQ.'KAPL')IMETHD=IPPLCN
C
      ISUBN1='DPJB'
      ISUBN2='SP  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=4
      MINN2=2
C
      ICOLL=0
      ICOLH=0
      ICOLX=0
C
C               **********************************************
C               **  TREAT THE BOOTSTRAP/JACKNIFE PLOT CASE  **
C               **********************************************
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPJBSP--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
   52   FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1         A4,2X,A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53   FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)IBOOSS
   54   FORMAT('IBOOSS = ',I8)
        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.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE IF OF THIS TYPE  **
C               **  AND BRANCH ACCORDINGLY.    **
C               *********************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'JACK')THEN
        ICASJB='JACK'
      ELSEIF(ICOM.EQ.'BOOT')THEN
        ICASJB='BOOT'
      ELSE
        IFOUND='NO'
        GOTO9000
      ENDIF
C
      ISHIFT=1
      IF(IHARG(1).EQ.'CENS')THEN
        ISHIFT=2
        ICOM=IHARG(2)
        ICOM2=IHARG2(2)
        ICENSO='ON'
      ELSE
        ICOM=IHARG(1)
        ICOM2=IHARG2(1)
      ENDIF
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGG3,IERROR)
C
      IF(NUMARG.LE.1)GOTO9000
C
C               ***************************
C               **  STEP 1B--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1B'
      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=2,6
          IF(INAME(I,J).NE.'    ')GOTO102
          ITEMP=J-1
          GOTO104
  102   CONTINUE
        ITEMP=6
  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.'PLOT')THEN
          ILASTC=I1
          GOTO112
        ELSEIF(IHARG(I1).EQ.'STAT'.AND.IHARG(I2).EQ.'PLOT')THEN
          ILASTC=I2
          GOTO112
        ELSEIF(IHARG(I1).EQ.'CENS'.AND.IHARG(I2).EQ.'PLOT')THEN
          ICENSO='ON'
          ILASTC=I2
          GOTO112
        ELSEIF(IHARG(I1).EQ.'CENS'.AND.IHARG(I2).EQ.'STAT'.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)
      IFLAGV=INFLAV(IROW)
      IFLAGD=INFLAD(IROW)
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      IFOUND='YES'
C
      IF(ICENSO.EQ.'ON')IFLAGV='TWO'
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. **
C               ******************************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 22--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     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.'JBSP')THEN
        WRITE(ICOUT,2211)IHLEFT,ICOLL,NLEFT
 2211   FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *******************************************************
C               **  STEP 23--                                        **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)**
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.        **
C               *******************************************************
C
      ISTEPN='23'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2311)
 2311   FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2312)
 2312   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2314)
 2314   FORMAT('      BOOTSTRAP/JACKNIFE ... PLOT WAS TO HAVE BEEN ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2315)MINN2
 2315   FORMAT('      FORMED MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2316)
 2316   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2317)
 2317   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2318)(IANS(I),I=1,MIN(80,IWIDTH))
 2318     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************
C               **  STEP 24--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='24'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2480
      DO2400J=1,NUMARG
        J1=J
        IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2410
        IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2410
        IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2420
 2400 CONTINUE
      GOTO2490
 2410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2490
 2420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2490
C
 2480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2481)
 2481 FORMAT('***** INTERNAL ERROR IN BOOTSTRAP/JACKNIFE PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2482)
 2482 FORMAT('      AT BRANCH POINT 2481 IN DPJBSP--NUMARG LESS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2483)
 2483 FORMAT('      THAN 1 EVEN THOUGH NUMARG HAD PREVIOUSLY PASSED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2485)NUMARG
 2485 FORMAT('      THIS TEST ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2486)
 2486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,2487)(IANS(I),I=1,MIN(80,IWIDTH))
 2487   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 2490 CONTINUE
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')THEN
        WRITE(ICOUT,2491)NUMARG,ILOCQ,ICASEQ
 2491   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************************************
C               **  STEP 24.5--                        **
C               **  DETERMINE THE NUMBER OF VARIABLES  **
C               *****************************************
C
      ISTEPN='24.5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ******************************************************
C               **  STEP 25--                                       **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS          **
C               **  INDICATES THAT THE VALUES IN THE                **
C               **  FIRST VARIABLE ARE TO BE GROUPED                **
C               **  BASED ON VALUES OF THE SECOND VARIABLE;         **
C               **  THAT IS, THE SECOND VARAIBLE DEFINES THE        **
C               **  GROUP NUMBERS WITHIN WHICH THE MEANS,           **
C               **  STANDARD DEVIATIONS, RANGES, AND                **
C               **  CUMULATIVE SUMS ARE TO BE COMPUTED.             **
C               **  THE VALUES IN THE SECOND VARIABLE               **
C               **  ARE THE X VALUES FOR EACH MEAN, STANDARD        **
C               **  DEVIATION, ETC.  IN THE RESULTING STATISTIC     **
C               **  PLOT.  THE VALUES IN THE SECOND VARIABLE        **
C               **  NEED NOT HAVE BEEN PREVIOUSLY                   **
C               **  SORTED OR HAVE COMMON VALUES ADJACENT.          **
C               **  IF WE HAVE THE 2-VARIABLE CASE,                 **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.  **
C               ******************************************************
C
      ISTEPN='25'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMEXP=1
      IF(IFLAGV.EQ.'TWO')NUMEXP=2
      NUMV2=ILOCQ-1
C
      IF(NUMV2.LT.NUMEXP .OR. NUMV2.GT.NUMEXP+2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2511)
 2511   FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2512)
 2512   FORMAT('      FOR A BOOTSTRAP/JACKNIFE ... PLOT, THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2518)NUMEXP,NUMEXP+2
 2518   FORMAT('      NUMBER OF VARIABLES MUST BE BETWEEN ',I4,
     1         ' AND ',I4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2520)
 2520   FORMAT('      SUCH WAS NOT THE CASE HERE;  THE SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2522)NUMV2
 2522   FORMAT('      NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2523)
 2523   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2524)(IANS(I),I=1,MIN(80,IWIDTH))
 2524     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMV2.EQ.2)THEN
        IF(IFLAGV.EQ.'TWO')THEN
          IHHOR=IHARG(2)
          IHHOR2=IHARG2(2)
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ICOLH=IVALUE(ILOCV)
          NHOR=IN(ILOCV)
          IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')THEN
            WRITE(ICOUT,2531)IHHOR,ICOLH,NHOR
 2531       FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ELSE
          IHX=IHARG(2)
          IHX2=IHARG2(2)
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHX,IHX2,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ICOLX=IVALUE(ILOCV)
          NX=IN(ILOCV)
          NGRPV=1
        ENDIF
      ELSEIF(NUMV2.EQ.3)THEN
        IF(IFLAGV.EQ.'TWO')THEN
          IHHOR=IHARG(2)
          IHHOR2=IHARG2(2)
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ICOLH=IVALUE(ILOCV)
          NHOR=IN(ILOCV)
          IHX=IHARG(3)
          IHX2=IHARG2(3)
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHX,IHX2,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ICOLX=IVALUE(ILOCV)
          NX=IN(ILOCV)
          NGRPV=1
          IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')THEN
            WRITE(ICOUT,2531)IHHOR,ICOLH,NHOR
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2541)IHX,ICOLX,NX
 2541       FORMAT('IHX,ICOLX,NX   = ',A4,I8,I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ELSE
          IHX=IHARG(2)
          IHX2=IHARG2(2)
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHX,IHX2,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ICOLX=IVALUE(ILOCV)
          NX=IN(ILOCV)
C
          IHXG=IHARG(3)
          IHXG2=IHARG2(3)
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHXG,IHXG2,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ICOLX2=IVALUE(ILOCV)
          NX2=IN(ILOCV)
          NGRPV=2
          IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')THEN
            WRITE(ICOUT,2541)IHX,ICOLX,NX
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2543)IHXG,ICOLX2,NX2
 2543       FORMAT('IHXG,ICOLX2,NX2   = ',A4,I8,I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
      ELSEIF(NUMV2.EQ.4)THEN
        IF(IFLAGV.EQ.'TWO')THEN
          IHHOR=IHARG(2)
          IHHOR2=IHARG2(2)
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ICOLH=IVALUE(ILOCV)
          NHOR=IN(ILOCV)
          IHX=IHARG(3)
          IHX2=IHARG2(3)
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHX,IHX2,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ICOLX=IVALUE(ILOCV)
          NX=IN(ILOCV)
          NGRPV=2
          IHXG=IHARG(4)
          IHXG2=IHARG2(4)
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHXG,IHXG2,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ICOLX2=IVALUE(ILOCV)
          NX2=IN(ILOCV)
          IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')THEN
            WRITE(ICOUT,2531)IHHOR,ICOLH,NHOR
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2541)IHX,ICOLX,NX
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2543)IHXG,ICOLX2,NX2
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2551)
 2551     FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2552)NUMV2
 2552     FORMAT('      FOR A ONE VARIABLE STATISTIC, AT MOST THREE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2553)NUMV2
 2553     FORMAT('      EXPECTED.  FOUR VARIABLES WERE SPECIFIED.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
      ELSE
        GOTO2590
      ENDIF
C
CCCCC FOR DEPENDENT GROUPS FOR "DIFFERENCE OF" STATISTICS, SAMPLE
CCCCC SIZES FOR TWO RESPONSE VARIABLES NEED NOT BE EQUAL.  NOTE,
CCCCC HOWEVER, THAT IF A GROUP ID VARIABLE IS ALSO SPECIFIED,
CCCCC THEN WE DO RESTRICT TO EQUAL SAMPLE SIZES.
C
CCCCC UPDATE CHECK TO ACCOUNT FOR CASE WHERE THERE ARE TWO
CCCCC VARIABLES.
C
 2570 CONTINUE
      IF(NUMV2.EQ.2)THEN
        IF(IFLAGV.EQ.'ONE')THEN
          IF(NX.EQ.NLEFT)GOTO2590
        ELSEIF(IFLAGV.EQ.'TWO')THEN
          IF(NHOR.EQ.NLEFT)GOTO2590
          IF(IFLAGD.EQ.'ON' .AND. IBOOGR.EQ.'INDE')GOTO2590
        ENDIF
      ELSEIF(NUMV2.EQ.3)THEN
        IF(IFLAGV.EQ.'ONE')THEN
          IF(NX.EQ.NLEFT .AND. NX2.EQ.NLEFT)GOTO2590
        ELSEIF(IFLAGV.EQ.'TWO')THEN
          IF(NX.EQ.NLEFT.AND.NHOR.EQ.NLEFT)GOTO2590
        ENDIF
      ELSEIF(NUMV2.EQ.4)THEN
        IF(NX.EQ.NLEFT.AND.NX2.EQ.NLEFT.AND.NHOR.EQ.NLEFT)GOTO2590
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2571)
 2571 FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE PLOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2572)NUMV2
 2572 FORMAT('      FOR A BOOTSTRAP/JACKNIFE ... PLOT, WHEN ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2579)
 2579 FORMAT('      VARIABLES SPECIFIED, THE NUMBER OF ELEMENTS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2580)NUMV2
 2580 FORMAT('      THE ',I8,' VARIABLES MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2582)
 2582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2583)IHLEFT,IHLEF2,NLEFT
 2583 FORMAT('        VARIABLE 1 ',A4,A4,' HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.EQ.2 .AND. IFLAGV.EQ.'TWO')THEN
        WRITE(ICOUT,2584)IHHOR,IHHOR2,NHOR
 2584   FORMAT('        RESPONSE VARIABLE 2 ',A4,A4,' HAS ',I8,
     1         ' ELEMENTS')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NUMV2.EQ.2 .AND. IFLAGV.EQ.'ONE')THEN
        WRITE(ICOUT,2585)IHX,IHX2,NX2
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NUMV2.EQ.3 .AND. IFLAGV.EQ.'TWO')THEN
        WRITE(ICOUT,2585)IHX,IHX2,NX
 2585   FORMAT('        GROUP VARIABLE 1 ',A4,A4,' HAS ',I8,
     1         ' ELEMENTS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2584)IHHOR,IHHOR2,NHOR
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NUMV2.EQ.3 .AND. IFLAGV.EQ.'ONE')THEN
        WRITE(ICOUT,2585)IHX,IHX2,NX
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2589)IHXG,IHXG2,NX2
 2589   FORMAT('        GROUP VARIABLE 2 ',A4,A4,' HAS ',I8,
     1         ' ELEMENTS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NUMV2.EQ.4)THEN
        WRITE(ICOUT,2585)IHX,IHX2,NX
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2589)IHXG,IHXG2,NX2
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2584)IHHOR,IHHOR2,NHOR
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,2587)
 2587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,2588)(IANS(I),I=1,IWIDTH)
 2588   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 2590 CONTINUE
C
C               *************************************************
C               **  STEP 26--                                  **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='26'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC MARCH 2003: ACCOUNT FOR CASE OF INDPENDENT GROUPS FOR
CCCCC "DIFFERENCE OF" STATISTICS.  IN THIS CASE, EQUAL SAMPLE
CCCCC SIZES NOT REQUIRED.
C
      NMAX=NLEFT
      IF(NUMV2.EQ.2 .AND. IFLAGD.EQ.'ON' .AND. IBOOGR.EQ.'INDE')
     1   NMAX=MAX(NLEFT,NHOR)
C
      IF(ICASEQ.EQ.'FULL')GOTO2610
      IF(ICASEQ.EQ.'SUBS')GOTO2620
      IF(ICASEQ.EQ.'FOR')GOTO2630
C
 2610 CONTINUE
      DO2615I=1,NMAX
      ISUB(I)=1
 2615 CONTINUE
      NQ=NMAX
      GOTO2650
C
 2620 CONTINUE
      NIOLD=NMAX
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2650
C
 2630 CONTINUE
      NIOLD=NMAX
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      NLOCA2=NLOCAL
      GOTO2650
C
 2650 CONTINUE
      J=0
      J2=0
      IMAX=NMAX
      IF(NQ.LT.NMAX)IMAX=NQ
      DO2660I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO2660
C
        IF(NUMV2.EQ.2.AND.IFLAGD.EQ.'ON'.AND.IBOOGR.EQ.'INDE'.AND.
     1     J.GE.NLEFT)GOTO2665
        J=J+1
C
        IJ=MAXN*(ICOLL-1)+I
        IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
        IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
        IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
        IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
        IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
        IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
        IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
        IF(NUMV2.LE.1)GOTO2660
C
 2665   CONTINUE
        IF(NUMV2.EQ.2.AND.IFLAGD.EQ.'ON'.AND.IBOOGR.EQ.'INDE'.AND.
     1     J2.GE.NHOR)GOTO2660
        J2=J2+1
        IF(IFLAGV.EQ.'ONE')THEN
          IJ=MAXN*(ICOLX-1)+I
          IF(ICOLH.LE.MAXCOL)X1(J2)=V(IJ)
          IF(ICOLH.EQ.MAXCP1)X1(J2)=PRED(I)
          IF(ICOLH.EQ.MAXCP2)X1(J2)=RES(I)
          IF(ICOLH.EQ.MAXCP3)X1(J2)=YPLOT(I)
          IF(ICOLH.EQ.MAXCP4)X1(J2)=XPLOT(I)
          IF(ICOLH.EQ.MAXCP5)X1(J2)=X2PLOT(I)
          IF(ICOLH.EQ.MAXCP6)X1(J2)=TAGPLO(I)
        ELSE
          IJ=MAXN*(ICOLH-1)+I
          IF(ICOLH.LE.MAXCOL)Z1(J2)=V(IJ)
          IF(ICOLH.EQ.MAXCP1)Z1(J2)=PRED(I)
          IF(ICOLH.EQ.MAXCP2)Z1(J2)=RES(I)
          IF(ICOLH.EQ.MAXCP3)Z1(J2)=YPLOT(I)
          IF(ICOLH.EQ.MAXCP4)Z1(J2)=XPLOT(I)
          IF(ICOLH.EQ.MAXCP5)Z1(J2)=X2PLOT(I)
          IF(ICOLH.EQ.MAXCP6)Z1(J2)=TAGPLO(I)
        ENDIF
        IF(NUMV2.LE.2)GOTO2660
C
        IF(IFLAGV.EQ.'ONE')THEN
          IJ=MAXN*(ICOLX2-1)+I
          IF(ICOLX2.LE.MAXCOL)XGRP2(J)=V(IJ)
          IF(ICOLX2.EQ.MAXCP1)XGRP2(J)=PRED(I)
          IF(ICOLX2.EQ.MAXCP2)XGRP2(J)=RES(I)
          IF(ICOLX2.EQ.MAXCP3)XGRP2(J)=YPLOT(I)
          IF(ICOLX2.EQ.MAXCP4)XGRP2(J)=XPLOT(I)
          IF(ICOLX2.EQ.MAXCP5)XGRP2(J)=X2PLOT(I)
          IF(ICOLX2.EQ.MAXCP6)XGRP2(J)=TAGPLO(I)
        ELSE
          IJ=MAXN*(ICOLX-1)+I
          IF(ICOLX.LE.MAXCOL)X1(J)=V(IJ)
          IF(ICOLX.EQ.MAXCP1)X1(J)=PRED(I)
          IF(ICOLX.EQ.MAXCP2)X1(J)=RES(I)
          IF(ICOLX.EQ.MAXCP3)X1(J)=YPLOT(I)
          IF(ICOLX.EQ.MAXCP4)X1(J)=XPLOT(I)
          IF(ICOLX.EQ.MAXCP5)X1(J)=X2PLOT(I)
          IF(ICOLX.EQ.MAXCP6)X1(J)=TAGPLO(I)
        ENDIF
C
        IF(NUMV2.LE.3)GOTO2660
C
        IJ=MAXN*(ICOLX2-1)+I
        IF(ICOLX2.LE.MAXCOL)XGRP2(J)=V(IJ)
        IF(ICOLX2.EQ.MAXCP1)XGRP2(J)=PRED(I)
        IF(ICOLX2.EQ.MAXCP2)XGRP2(J)=RES(I)
        IF(ICOLX2.EQ.MAXCP3)XGRP2(J)=YPLOT(I)
        IF(ICOLX2.EQ.MAXCP4)XGRP2(J)=XPLOT(I)
        IF(ICOLX2.EQ.MAXCP5)XGRP2(J)=X2PLOT(I)
        IF(ICOLX2.EQ.MAXCP6)XGRP2(J)=TAGPLO(I)
        GOTO2660
C
 2660 CONTINUE
      NLOCAL=J
      IF(NUMV2.EQ.2.AND.IFLAGD.EQ.'ON'.AND.IBOOGR.EQ.'INDE')THEN
        NLOCA2=J2
      ELSE
        NLOCA2=NLOCAL
      ENDIF
C
C               ****************************************************
C               **  STEP 27--                                     **
C               **  FOR THE 1-VARIABLE CASE ONLY,                 **
C               **  DETERMINE IF THE ANALYST                      **
C               **  HAS SPECIFIED    THE GROUP SIZE,              **
C               **  FOR THE STATISTIC PLOT ANALYSIS.              **
C               **  THE GROUP SIZE SETTING IS DEFINED BY SEARCHING**
C               **  THE INTERNAL TABLE FOR THE PARAMETER NAME  NI;**
C               **  IF FOUND, USE THE SPECIFIED VALUE.            **
C               **  IF NOT FOUND, GENERATE AN ERROR MESSAGE.      **
C               ****************************************************
C
      ISTEPN='27'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *******************************************************
C               **  STEP 28--                                        **
C               **  COMPUTE THE APPROPRIATE STATISTIC PLOT STATISTIC--*
C               **  (MEAN, STANDARD DEVIATION, RANGE, OR CUSUM).     **
C               **  COMPUTE CONFIDENCE LINES.                        **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS            **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.               **
C               **  DEFINE THE VECTOR D(.) TO 1'S, 2'S, AND 3'S      **
C               **  FOR THE PLOTTED VALUE, THE LOWER CONFIDENCE LINE,**
C               **  AND THE UPPER CONFIDENCE LINE.                   **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).    **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).    **
C               *******************************************************
C
      ISTEPN='28'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHP='ALPH'
      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')THEN
        ALPHA=0.05
      ELSE
        ALPHA=VALUE(ILOCP)
      ENDIF
      IF(ALPHA.LT.0.0 .OR. ALPHA.GT.1.0)ALPHA=0.05
      IF(ALPHA.GT.0.5)ALPHA=1.0-ALPHA
C
      IF(IQUAVR.EQ.'NONE')THEN
        NPERC=0
      ELSEIF(IQUAVR.EQ.'DEFAULT')THEN
        QP(1)=0.5
        QP(2)=1.0
        QP(3)=2.5
        QP(4)=5.0
        QP(5)=10.0
        QP(6)=20.0
        QP(7)=30.0
        QP(8)=40.0
        QP(9)=50.0
        QP(10)=60.0
        QP(11)=70.0
        QP(12)=80.0
        QP(13)=90.0
        QP(14)=95.0
        QP(15)=97.5
        QP(16)=99.0
        QP(17)=99.5
        NPERC=17
      ELSE
        IH41=IQUAVR(1:4)
        IH42=IQUAVR(5:8)
        IHWUSE='V'
        MESSAG='NO'
        CALL CHECKN(IH41,IH42,IHWUSE,
     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
        IF(IERROR.EQ.'YES')THEN
          NPERC=0
        ELSE
          ICOLQP=IVALUE(ILOCV)
          NPERC=IN(ILOCV)
          ICNT=0
          DO4180I=1,NPERC
            IJ=MAXN*(ICOLQP-1)+I
            ICNT=ICNT+1
            IF(ICOLQP.LE.MAXCOL)QP(ICNT)=V(IJ)
            IF(ICOLQP.EQ.MAXCP1)QP(ICNT)=PRED(I)
            IF(ICOLQP.EQ.MAXCP2)QP(ICNT)=RES(I)
            IF(ICOLQP.EQ.MAXCP3)QP(ICNT)=YPLOT(I)
            IF(ICOLQP.EQ.MAXCP4)QP(ICNT)=XPLOT(I)
            IF(ICOLQP.EQ.MAXCP5)QP(ICNT)=X2PLOT(I)
            IF(ICOLQP.EQ.MAXCP6)QP(ICNT)=TAGPLO(I)
            IF(QP(ICNT).LE.0.0 .OR. QP(ICNT).GE.100.0)THEN
              ICNT=ICNT-1
            ENDIF
 4180     CONTINUE
          NPERC=ICNT
C
        ENDIF
      ENDIF
C
CCCCC JUNE, 1990.  MOVE TEMP0 - RES2 DIMENSIONING FROM DPJBS2
      CALL DPJBS2(Y1,Z1,X1,NLOCAL,NLOCA2,NUMV2,ICASPL,ISIZE,ICONT,
     1ICASJB,IBOOSS,ISEED,NGRPV,IBCABT,ALPHA,
     1IFLAGD,IFLAGV,
     1ICENSO,IMETHD,NUMPAR,MINMAX,NPERC,IPOTTO,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,XTEMP3,MAXOBV,
CCCC JULY 2002.  ADD FOLLOWING LINE
     1ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1Y,X,D,NPLOTP,NPLOTV,
CCCC MARCH 1998.  ADD FOLLOWING 2 LINES
     1TEMP0,TEMPZ0,RES1,RES2,TEMP4,TEMP5,XGRP2,TEMPTH,TEMP6,
     1TEMP7,TEMP8,TEMPT2,QP,XPERC,
     1DTEMP1,DTEMP2,DTEMP3,DTEMP4,
     1BMEAN,BSD,B001,B005,B01,B025,B05,B10,B20,B50,B80,B90,B95,
     1B975,B99,B995,B999,
     1ISUBRO,IBUGG3,IERROR)
C
C  AUTOMATICALLY SAVE CERTAIN PERCENTILE PARAMETERS.  MARCH 1998
C  JANUARY 2005: ONLY SAVE IF 1 PARAMETER IS ESTIMARED (E.G.,
C                DISTRIBUTIONAL FITTING HAS 2 TO 4 PARAMETERS)
C
C
C               ***************************************
C               **  STEP 51--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      CUTOFF=REAL(I1MACH(9))
      ISTEPN='51'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(NUMPAR.GT.1)GOTO5199
      DO5100IPASS=1,17
        IH=ISTATN(IPASS)
        IH2=ISTAT2(IPASS)
        DO5150I=1,NUMNAM
          I2=I
          IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1       IUSE(I).EQ.'P')GOTO5180
 5150   CONTINUE
        IF(NUMNAM.GE.MAXNAM)THEN
          WRITE(ICOUT,5151)
 5151     FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5152)
 5152     FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5153)MAXNAM
 5153     FORMAT('      NAMES MUST BE AT MOST ',I8,'.  SUCH WAS NOT')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5155)
 5155     FORMAT('      THE CASE HERE--THE MAXIMUM ALLOWABLE NUMBER OF')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5156)
 5156     FORMAT('      NAMES HAS JUST BEEN EXCEEDED.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5157)
 5157     FORMAT('      SUGGESTED ACTION--ENTER     STATUS     TO')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5158)
 5158     FORMAT('      DETERMINE THE IMPORTANT (VERSUS UNIMPORTANT)')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5160)
 5160     FORMAT('      VARIABLES AND PARAMETERS, AND THEN REUSE SOME')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5161)
 5161     FORMAT('      OF THE NAMES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5162)
 5162     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,5163)(IANS(I),I=1,MIN(80,IWIDTH))
 5163       FORMAT('      ',80A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
C
        NUMNAM=NUMNAM+1
        ILOC=NUMNAM
        IHNAME(ILOC)=IH
        IHNAM2(ILOC)=IH2
        IUSE(ILOC)='P'
        IF(IPASS.EQ.1)VALUE(ILOC)=BSD
        IF(IPASS.EQ.2)VALUE(ILOC)=BMEAN
        IF(IPASS.EQ.3)VALUE(ILOC)=B975
        IF(IPASS.EQ.4)VALUE(ILOC)=B025
        IF(IPASS.EQ.5)VALUE(ILOC)=B001
        IF(IPASS.EQ.6)VALUE(ILOC)=B005
        IF(IPASS.EQ.7)VALUE(ILOC)=B01
        IF(IPASS.EQ.8)VALUE(ILOC)=B05
        IF(IPASS.EQ.9)VALUE(ILOC)=B10
        IF(IPASS.EQ.10)VALUE(ILOC)=B20
        IF(IPASS.EQ.11)VALUE(ILOC)=B50
        IF(IPASS.EQ.12)VALUE(ILOC)=B80
        IF(IPASS.EQ.13)VALUE(ILOC)=B90
        IF(IPASS.EQ.14)VALUE(ILOC)=B95
        IF(IPASS.EQ.15)VALUE(ILOC)=B99
        IF(IPASS.EQ.16)VALUE(ILOC)=B995
        IF(IPASS.EQ.17)VALUE(ILOC)=B999
        VAL=VALUE(ILOC)
        IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
        IF(VAL.GT.CUTOFF)IVAL=CUTOFF
        IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
        IVALUE(ILOC)=IVAL
        GOTO5100
C
 5180   CONTINUE
        IF(IPASS.EQ.1)VALUE(I2)=BSD
        IF(IPASS.EQ.2)VALUE(I2)=BMEAN
        IF(IPASS.EQ.3)VALUE(I2)=B975
        IF(IPASS.EQ.4)VALUE(I2)=B025
        IF(IPASS.EQ.5)VALUE(I2)=B001
        IF(IPASS.EQ.6)VALUE(I2)=B005
        IF(IPASS.EQ.7)VALUE(I2)=B01
        IF(IPASS.EQ.8)VALUE(I2)=B05
        IF(IPASS.EQ.9)VALUE(I2)=B10
        IF(IPASS.EQ.10)VALUE(I2)=B20
        IF(IPASS.EQ.11)VALUE(I2)=B50
        IF(IPASS.EQ.12)VALUE(I2)=B80
        IF(IPASS.EQ.13)VALUE(I2)=B90
        IF(IPASS.EQ.14)VALUE(I2)=B95
        IF(IPASS.EQ.15)VALUE(I2)=B99
        IF(IPASS.EQ.16)VALUE(I2)=B995
        IF(IPASS.EQ.17)VALUE(I2)=B999
        VAL=VALUE(I2)
        IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
        IF(VAL.GT.CUTOFF)IVAL=CUTOFF
        IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
        IVALUE(I2)=IVAL
        GOTO5100
C
 5100 CONTINUE
 5199 CONTINUE
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'JBSP')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPJBSP--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
 9012   FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1         A4,2X,A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)IFOUND,IERROR,IBOOSS,ICASJB
 9013   FORMAT('IFOUND,IERROR,IBOOSS,ICASJB = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9014   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1         I8,I8,I8,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)ISIZE
 9015   FORMAT('ISIZE = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)NUMV2
 9016   FORMAT('NUMV2 = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9017)IHLEFT,IHLEF2,ICOLL,NLEFT
 9017   FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
        IF(NUMV2.GE.2)THEN
          WRITE(ICOUT,9018)IHHOR,IHHOR2,ICOLH,NHOR
 9018     FORMAT('IHHOR,IHHOR2,ICOLH,NHOR = ',A4,2X,A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NUMV2.GE.3)THEN
          WRITE(ICOUT,9019)IHX,IHX2,ICOLX,NX
 9019     FORMAT('IHX,IHX2,ICOLX,NX = ',A4,2X,A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NPLOTP.LE.0)THEN
          DO9025I=1,NPLOTP
            WRITE(ICOUT,9026)I,Y(I),X(I),D(I)
 9026       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
            CALL DPWRST('XXX','BUG ')
 9025     CONTINUE
        ENDIF
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPJBS2(Y,Z,X,N,NZ,NUMV2,ICASPL,ISIZE,ICONT,
     1ICASJB,IBOOSS,ISEED,NGRPV,IBCABT,ALPHA,
     1IFLAGD,IFLAGV,
     1ICENSO,IMETHD,NUMPAR,MINMAX,NPERC,IPOTTO,
     1TEMP,TEMPZ,XIDTEM,XTEMP1,XTEMP2,XTEMP3,MAXNXT,
CCCC JULY 2002.  ADD FOLLOWING LINE
     1ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1Y2,X2,D2,N2,NPLOTV,
     1TEMP0,TEMPZ0,RES1,RES2,TEMP4,XIDTE2,XGRP2,TEMPTH,TEMP6,
     1TEMP7,TEMP8,TEMPT2,QP,XQP,
     1DTEMP1,DTEMP2,DTEMP3,DTEMP4,
CCCCC MARCH 1998.  ADD FOLLOWING 2 LINES
     1BMEAN,BSD,B001,B005,B01,B025,B05,B10,B20,B50,B80,B90,B95,
     1B975,B99,B995,B999,
     1ISUBRO,IBUGG3,IERROR)
CCCCC JUNE, 1990.  MOVE DIMENSIONING OF TEMP0 - RES2 TO DPJBSP
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A JACKNIFE OR BOOTSTRAP PLOT
C              (SEE DPJBSP FOR ALLOWABLE TYPES)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --JUNE      1990.  MOVE SOME DIMENSIONS TO DPJBSP
C     UPDATED         --DECEMBER  1993. LINFIT ARGS
C     UPDATED         --DECEMBER  1993. LINFIT ARGS: PROTECT RESSD/DF
C     UPDATED         --MARCH     1995. MAD AND AAD
C     UPDATED         --MARCH     1995. GEOMETRIC MEAN
C     UPDATED         --MARCH     1995. GEOMETRIC SD
C     UPDATED         --NOVEMBER  2001. BIWEIGHT LOCATION
C     UPDATED         --NOVEMBER  2001. BIWEIGHT SCALE
C     UPDATED         --JULY      2002. WINSORIZED VARIANCE
C     UPDATED         --JULY      2002. WINSORIZED SD
C     UPDATED         --JULY      2002. ADD WINSORIZED COVARIANCE
C     UPDATED         --JULY      2002. ADD WINSORIZED CORRELATION
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDVARIANCE
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCOVARIANCE
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND MIDVARIANCE
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND CORRELATION
C     UPDATED         --JULY      2002. ADD HODGES LEHMAN
C     UPDATED         --JULY      2002. ADD QUANTILE
C     UPDATED         --JULY      2002. ADD QUANTILE STANDARD ERROR
C     UPDATED         --JULY      2002. ADD TRIMMED MEAN STANDARD ERROR
C     UPDATED         --JULY      2002. ADD BIWEIGHT CORRELATION
C     UPDATED         --JULY      2002. ADD LINEAR CALIBRATION
C     UPDATED         --JULY      2002. ADD QUADRATIC CALIBRATION
C     UPDATED         --AUGUST    2002. USE "CMPSTA" TO COMPUTE MOST
C                                       STATISTICS.
C     UPDATED         --MARCH     2003. ADD 34 "DIFFERENCE OF" STATS
C     UPDATED         --MARCH     2003. FOR "DIFFERENCE OF" STATS,
C                                       DISTINGUISH BETWEEN INDEPENDENT
C                                       AND DEPENDENT GROUPS
C     UPDATED         --APRIL     2003. SN AND QN (DIFFERENCE OF),
C                                       REQUIRED ADDITIONAL SCRATCH
C                                       ARRAYS.
C     UPDATED         --JULY      2003. FOR GROUP CASE, WRITE SOME
C                                       RELEVANT PERCENTILES FOR
C                                       EACH GROUP TO DPST1F.DAT.
C     UPDATED         --JULY      2003. SUPPORT TWO GROUP VARIABLES
C     UPDATED         --SEPTEMBER 2003. SUPPORT BCA CONFIDENCE
C                                       INTERVALS:
C                                       A) COMPUTE FULL-SAMPLE STAT
C                                       B) COMPUTE JACKNIFE ESTIMATE
C     UPDATED         --JANUARY   2005. SUPPORT BOOTSTRAP
C                                       DISTRIBUTIONAL FITTING
C     UPDATED         --MARCH     2005. GENERALIZED PARETO MLE
C     UPDATED         --MAY       2005. GENERALIZED PARETO DEHAAN, CME
C     UPDATED         --JULY      2005. CALL LIST TO DPJBCP AND DPJBKS
C     UPDATED         --AUGUST    2005. INVERTED WEIBULL MAXIMUM LIKE
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTC 2-5
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTC 5 LMOMENTS
C     UPDATED         --MARCH     2006. BETA NORMAL
C     UPDATED         --MARCH     2006. CHECK FOR UNDEFINED ML FOR
C                                       ASYMMETRIC LAPLACE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL SUM
      EXTERNAL RANGE
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IFLAGD
      CHARACTER*4 IFLAGV
      CHARACTER*4 IBCABT
      CHARACTER*4 ICASZZ
      CHARACTER*4 ICENSO
      CHARACTER*4 IMETHD
C
      CHARACTER*4 ICASJB
      CHARACTER*4 ICASRA
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*25 IFORMT
      CHARACTER*25 IFORMZ
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
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
      CHARACTER*80 IFILE4
      CHARACTER*12 ISTAT4
      CHARACTER*12 IFORM4
      CHARACTER*12 IACCE4
      CHARACTER*12 IPROT4
      CHARACTER*12 ICURS4
      CHARACTER*4 IERRF4
      CHARACTER*4 IENDF4
      CHARACTER*4 IREWI4
C
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y(*)
      DIMENSION Z(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION XIDTEM(*)
      DIMENSION XIDTE2(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
      DIMENSION TEMP4(*)
      DIMENSION XGRP2(*)
      DIMENSION TEMPTH(*)
      DIMENSION TEMP6(*)
      DIMENSION TEMPT2(*)
      DIMENSION TEMP7(*)
      DIMENSION TEMP8(*)
      DIMENSION QP(*)
      DIMENSION XQP(*)
C
      DOUBLE PRECISION DTEMP1(*)
      DOUBLE PRECISION DTEMP2(*)
      DOUBLE PRECISION DTEMP3(*)
      DOUBLE PRECISION DTEMP4(*)
C
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
      INTEGER ITEMP4(*)
      INTEGER ITEMP5(*)
      INTEGER ITEMP6(*)
C
CCCCC JUNE, 1990.  DIMENSION FOLLOWING ARRAYS IN DPJBSP
CCCCC DIMENSION TEMP0(MAXOBV)
CCCCC DIMENSION TEMPZ0(MAXOBV)
CCCCC DIMENSION RES1(MAXOBV)
CCCCC DIMENSION RES2(MAXOBV)
      DIMENSION TEMP0(*)
      DIMENSION TEMPZ0(*)
      DIMENSION RES1(*)
      DIMENSION RES2(*)
C
      REAL KSLOC
      REAL KSSCAL
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.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
      ISUBN1='JBS2'
      ISUBN2='2   '
C
      IWRITE='OFF'
C
      NUMPAR=1
C
      I2=0
      ISIZE2=0
      NUMSET=0
      NUMSE1=0
      NUMSE2=0
C
      NACC=0
      NREJ=0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,32)
   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 1;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)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.GE.'ON'.OR.ISUBRO.EQ.'PSP2')THEN
        WRITE(ICOUT,70)
   70   FORMAT('AT THE BEGINNING OF DPJBS2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)IBUGG3,ISUBRO,ICASJB,IBOOSS
   71   FORMAT('IBUGG3,ISUBRO,ICASJB,IBOOSS = ',A4,2X,A4,2X,A4,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)N,ICASPL,NUMV2,ISIZE,ICONT,NGRPV
   72   FORMAT('N,ICASPL,NUMV2,ISIZE,ICONT,NGRPV = ',
     1         I8,2X,A4,I8,I8,2X,A4,I4)
        CALL DPWRST('XXX','BUG ')
        DO73I=1,N
          IF(NUMV2.LE.2)THEN
            WRITE(ICOUT,74)I,Y(I),X(I),Z(I)
   74       FORMAT('I, Y(I),X(I),Z(I) = ',I8,3F15.7)
            CALL DPWRST('XXX','BUG ')
          ELSEIF(NUMV2.GE.3)THEN
            WRITE(ICOUT,75)I,Y(I),Z(I),X(I)
   75       FORMAT('I, Y(I),Z(I),X(I) = ',I8,3F15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
   73   CONTINUE
        WRITE(ICOUT,77)ICENSO,IMETHD,IPPLDP
   77   FORMAT('ICENSO,IMETHD,IPPLDP = ',A4,2X,A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES           **
C               **  FOR THE GROUP VARIABLE (USUALLY VAR. 2)           **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS             **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE           **
C               **  WHICH IS AN ERROR CONDITION FOR A PLOT.           **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGG3.GE.'ON'.OR.ISUBRO.EQ.'PSP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMSET=0
      IF(NGRPV.EQ.1)THEN
        DO151I=1,N
          IF(NUMSET.GT.0)THEN
            DO152J=1,NUMSET
              IF(X(I).EQ.XIDTEM(J))GOTO151
  152       CONTINUE
          ENDIF
          NUMSET=NUMSET+1
          XIDTEM(NUMSET)=X(I)
  151   CONTINUE
        CALL SORT(XIDTEM,NUMSET,XIDTEM)
        ANUMSE=NUMSET
C
        IF(NUMSET.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,161)
  161     FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,162)
  162     FORMAT('      FOR THE ONE GROUP VARIABLE CASE, THE NUMBER ',
     1           'OF SETS = 0 ')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
C
        ELSEIF(NUMSET.GE.N)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,175)
  175     FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,176)
  176     FORMAT('      NUMBER OF SETS    NUMSET   IDENTICAL TO ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,177)
  177     FORMAT('      NUMBER OF OBSERVATIONS   N   .')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,178)NUMSET
  178     FORMAT('      NUMSET = N = ',I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
      ELSEIF(NGRPV.EQ.2)THEN
        CALL DISTIN(X,N,IWRITE,XIDTEM,NUMSE1,IBUGG3,IERROR)
        CALL SORT(XIDTEM,NUMSE1,XIDTEM)
        CALL DISTIN(XGRP2,N,IWRITE,XIDTE2,NUMSE2,IBUGG3,IERROR)
        CALL SORT(XIDTE2,NUMSE2,XIDTE2)
        NUMSET=NUMSE1*NUMSE2
C
        IF(NUMSE1.LT.1 .OR. NUMSE1.GE.N)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,181)
  181     FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,182)
  182     FORMAT('      THE NUMBER OF SETS FOR THE GROUP ONE VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,183)
  183     FORMAT('      IS ZERO OR EQUAL TO THE NUMBER OF POINTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,184)NUMSE1
  184     FORMAT('      NUMBER OF SETS = ',I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(NUMSE2.LT.1 .OR. NUMSE2.GE.N)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,186)
  186     FORMAT('***** ERROR IN BOOTSTRAP/JACKNIFE PLOT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,187)
  187     FORMAT('      THE NUMBER OF SETS FOR THE GROUP TWO VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,188)
  188     FORMAT('      IS ZERO OR EQUAL TO THE NUMBER OF POINTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,189)NUMSE2
  189     FORMAT('      NUMBER OF SETS = ',I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
      ELSE
        NUMSET=0
      ENDIF
C
      AN=N
C
CCCCC JANUARY 2005.  UNGROUPED DATA WILL WRITE TO FILES DPST1F.DAT
CCCCC                ANFD DPST2F.DAT.
C
CCCCC IF(NUMSET.GE.1 .OR. NUMSE1.GE.1)THEN
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='JBS2'
        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
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='JBS2'
        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
CCCCC ENDIF
C
      IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
        IOUNI3=IST3NU
        IFILE3=IST3NA
        ISTAT3=IST3ST
        IFORM3=IST3FO
        IACCE3=IST3AC
        IPROT3=IST3PR
        ICURS3=IST3CS
        ISUBN0='JBS2'
        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
        WRITE(IOUNI3,203)100.0*(1.0-ALPHA)
  203   FORMAT('      BCa BOOTSTRAP ',F7.2,'% CONFIDENCE INTERVALS:')
        WRITE(IOUNI3,205)ALPHA/2.0,(1.0-ALPHA/2)
  205   FORMAT('SIGNIFICANCE LEVELS = (',F6.3,',',F6.3,')')
        WRITE(IOUNI3,207)
  207   FORMAT(6X,'LOWER',11X,'UPPER')
        WRITE(IOUNI3,209)
  209   FORMAT(3X,'CONFIDENCE',5X,'CONFIDENCE',11X,'^',14X,'^')
        WRITE(IOUNI3,211)
  211   FORMAT(6X,'LIMIT',11X,'LIMIT',12X,'Z0',13X,'A0',6X,'ALPHA1',
     1         3X,'ALPHA2')
        WRITE(IOUNI3,213)
  213   FORMAT('---------------------------------------------------',
     1         '-------------------------')
      ENDIF
C
C               ******************************************
C               **  STEP 11--                           **
C               **  COMPUTE THE SPECIFIED STATISTIC     **
C               **  FOR EACH SUBSET OF THE DATA, AND    **
C               **  THEN FOR THE FULL DATA SET          **
C               ******************************************
C
      ISTEPN='11'
      IF(IBUGG3.GE.'ON'.OR.ISUBRO.EQ.'PSP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      J2=0
      IF(NGRPV.EQ.1)THEN
        ISETMX=NUMSET+1
      ELSEIF(NGRPV.EQ.2)THEN
        ISETMX=NUMSE1*NUMSE2+1
      ELSE
        ISETMX=1
      ENDIF
C
      DO11000ISET=1,ISETMX
C
        IF(ISET.EQ.ISETMX)THEN
          K=0
          K2=0
          DO11021I=1,MAX(N,NZ)
            IF(K.LT.N)THEN
              K=K+1
              TEMP0(K)=Y(I)
            ENDIF
            IF(K2.LE.NZ)THEN
              K2=K2+1
              TEMPZ0(K2)=Z(I)
            ENDIF
            IF(NUMV2.EQ.2.AND.IFLAGV.EQ.'ON')TEMPZ0(K)=Y(I)
            IF(IBUGG3.EQ.'ON')THEN
            WRITE(ICOUT,777)NUMSET,TEMP0(1),TEMP(1),TEMPZ0(1),TEMPZ0(2)
            CALL DPWRST('XXX','BUG ')
            ENDIF
11021     CONTINUE
          NS2=K
          NS22=K2
          IF(NGRPV.EQ.2)THEN
            ISET1=0
            ISET2=0
          ENDIF
        ELSEIF(NGRPV.EQ.1 .AND. ISET.LE.NUMSET)THEN
          K=0
          K2=0
          DO11011I=1,MAX(N,NZ)
            IF(X(I).NE.XIDTEM(ISET))GOTO11011
            IF(K.LT.N)THEN
              K=K+1
              TEMP0(K)=Y(I)
            ENDIF
            IF(K2.LE.NZ)THEN
              K2=K2+1
              TEMPZ0(K2)=Z(I)
            ENDIF
            IF(NUMV2.EQ.2.AND.IFLAGV.EQ.'TWO')TEMPZ0(K)=Z(I)
            IF(IBUGG3.EQ.'ON')THEN
            WRITE(ICOUT,777)NUMSET,TEMP0(1),TEMP(1),TEMPZ0(1),TEMPZ0(2)
  777       FORMAT('NUMSET,TEMP0(1),TEMP(1),TEMPZ0(1),TEMPZ0(2) = ',
     1             I8,4E15.7)
            CALL DPWRST('XXX','BUG ')
            ENDIF
11011     CONTINUE
          NI=K
          NS2=NI
          NI2=K2
          NS22=NI2
        ELSEIF(NGRPV.EQ.2 .AND. ISET.LE.NUMSE1*NUMSE2)THEN
          ISET1=INT((ISET-1)/NUMSE2) + 1
          ISET2=MOD((ISET-1),NUMSE2) + 1
          K=0
          K2=0
          DO11031I=1,MAX(N,NZ)
            IF(X(I).NE.XIDTEM(ISET1) .OR. XGRP2(I).NE.XIDTE2(ISET2))
     1        GOTO11031
            IF(K.LT.N)THEN
              K=K+1
              TEMP0(K)=Y(I)
            ENDIF
            IF(K2.LE.NZ)THEN
              K2=K2+1
              TEMPZ0(K2)=Z(I)
            ENDIF
            IF(NUMV2.EQ.2.AND.IFLAGV.EQ.'TWO')TEMPZ0(K)=Z(I)
            IF(IBUGG3.EQ.'ON')THEN
              WRITE(ICOUT,777)NUMSET,TEMP0(1),TEMP(1),
     1                        TEMPZ0(1),TEMPZ0(2)
              CALL DPWRST('XXX','BUG ')
            ENDIF
11031     CONTINUE
          NI=K
          NS2=NI
          NI2=K2
          NS22=NI2
        ENDIF
C
        IF(NS2.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11081)
11081     FORMAT('***** INTERNAL ERROR IN DPJBS2--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11082)
11082     FORMAT('NI FOR SOME CLASS = 0')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11083)ISET,XIDTEM(ISET),NI
11083     FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        NRESAM=NS2
        IF(ICASJB.EQ.'BOOT')NRESAM=IBOOSS
C
C  AUGUST 2002.  SIMPLIFY CODE BY USING "CMPSTA" TO COMPUTE
C  STATISTIC.  NOTE THAT THE FOLLOWING DISTINCT CASES ARE SUPPORTED:
C
C     1) STATISTIC COMPUTED FROM A SINGLE RESPONSE VARIABLE
C        (MOST CASES IN THIS CATEGORY, E.G., THE MEAN)
C     2) STATISTIC COMPUTED FROM TWO RESPONSE VARIABLES,
C        RESPONSES ARE PAIRED (E.G., THE CORRELATION).
C     3) STATISTIC COMPUTED FROM TWO RESPONSE VARIABLES, THE
C        RESPONSES ARE NOT PAIRED (I.E., SAMPLE THE TWO VARIABLES
C        SEPARATELY).  CURRENTLY, NO CASES FOR THIS.
C     4) LINEAR AND QUADRATIC CALIBRATION HANDLED SEPARATELY.
C     5) LINEAR SLOPE, LINEAR CORRELATION, LINEAR RESSD,
C        LINEAR INTERCEPT HANDLED SEPARATELY.
C
C  CASES WITH TWO PAIRED RESPONSE VARIABLES
C
        IF(ICASPL.EQ.'BIMC')GOTO11490
        IF(ICASPL.EQ.'BICR')GOTO11490
        IF(ICASPL.EQ.'WICV')GOTO11490
        IF(ICASPL.EQ.'WICR')GOTO11490
        IF(ICASPL.EQ.'COVA')GOTO11490
        IF(ICASPL.EQ.'CORR')GOTO11490
        IF(ICASPL.EQ.'RACV')GOTO11490
        IF(ICASPL.EQ.'RACR')GOTO11490
        IF(ICASPL.EQ.'KTAU')GOTO11490
        IF(ICASPL.EQ.'PBCR')GOTO11490
        IF(ICASPL.EQ.'RATI')GOTO11490
        IF(IBOOGR.EQ.'DEPE'.AND.IFLAGD.EQ.'ON')GOTO11490
C
C  CASES WITH TWO UNPAIRED RESPONSE VARIABLES (NOT NECESSARILY OF
C  SAME SIZE)
C
        IF(IBOOGR.EQ.'INDE'.AND.IFLAGD.EQ.'ON')GOTO11590
C
C
C  HANDLE LINEAR INTERCEPT, LINEAR SLOPE, LINEAR RESSD,
C  LINEAR CORRELATION SEPARATELY.
C
        IF(ICASPL.EQ.'LIIN')GOTO11730
        IF(ICASPL.EQ.'LISL')GOTO11730
        IF(ICASPL.EQ.'LIRE')GOTO11730
        IF(ICASPL.EQ.'LICO')GOTO11730
C
C  HANDLE LINEAR CALIBRATION, QUADRATIC CALIBRATION SEPARATELY
C  LINEAR CORRELATION SEPARELY.
C
        IF(ICASPL.EQ.'LICA')GOTO12210
        IF(ICASPL.EQ.'QUCA')GOTO12240
C
C  JANUARY 2005:
C  HANDLE DISTRIBUTIONAL FITTING CASES SEPARATELY.  THERE ARE
C  SEVERAL SUB-CASES:
C
C  1) PROBABILITY PLOT USED TO ESTIMATE LOCATION AND SCALE
C  2) PPCC/PROBABILITY PLOT USED TO ESTIMATE SHAPE, LOCATION, AND SCALE
C  3) KS/PROBABILITY PLOT USED TO ESTIMATE SHAPE, LOCATION, AND SCALE
C  4) MAXIMUM LIKELIHOOD USED TO ESTIMATE DISTRIBUTION PARAMETERS
C
        IF(ICASPL.EQ.'NOPP')GOTO14210
        IF(ICASPL.EQ.'LOPP')GOTO14210
        IF(ICASPL.EQ.'LAPP')GOTO14210
        IF(ICASPL.EQ.'UNPP')GOTO14210
        IF(ICASPL.EQ.'CAPP')GOTO14210
        IF(ICASPL.EQ.'EXPP')GOTO14210
        IF(ICASPL.EQ.'GUPP')GOTO14210
        IF(ICASPL.EQ.'HNPP')GOTO14210
        IF(ICASPL.EQ.'COPP')GOTO14210
        IF(ICASPL.EQ.'RAPP')GOTO14210
        IF(ICASPL.EQ.'ARPP')GOTO14210
        IF(ICASPL.EQ.'ANPP')GOTO14210
        IF(ICASPL.EQ.'SEPP')GOTO14210
        IF(ICASPL.EQ.'HSPP')GOTO14210
        IF(ICASPL.EQ.'HCPP')GOTO14210
        IF(ICASPL.EQ.'SLPP')GOTO14210
        IF(ICASPL.EQ.'HLPP')GOTO14210
C
CCCCC   LANDAU HAS SOME PROBLEMS, SO COMMENT OUT FOR NOW
CCCCC   IF(ICASPL.EQ.'LUPP')GOTO14210
        IF(ICASPL.EQ.'LUPP')THEN
          IERROR='YES'
          GOTO9000
        ENDIF
C
        IF(ICASPL.EQ.'WECP')GOTO14310
        IF(ICASPL.EQ.'LNCP')GOTO14310
        IF(ICASPL.EQ.'GACP')GOTO14310
        IF(ICASPL.EQ.'GICP')GOTO14310
        IF(ICASPL.EQ.'LGCP')GOTO14310
        IF(ICASPL.EQ.'IWCP')GOTO14310
        IF(ICASPL.EQ.'GECP')GOTO14310
        IF(ICASPL.EQ.'CSCP')GOTO14310
        IF(ICASPL.EQ.'CHCP')GOTO14310
        IF(ICASPL.EQ.'TCP')GOTO14310
        IF(ICASPL.EQ.'EECP')GOTO14310
        IF(ICASPL.EQ.'FLCP')GOTO14310
        IF(ICASPL.EQ.'E2CP')GOTO14310
        IF(ICASPL.EQ.'WACP')GOTO14310
        IF(ICASPL.EQ.'PACP')GOTO14310
        IF(ICASPL.EQ.'P2CP')GOTO14310
        IF(ICASPL.EQ.'LACP')GOTO14310
        IF(ICASPL.EQ.'BRCP')GOTO14310
        IF(ICASPL.EQ.'RECP')GOTO14310
        IF(ICASPL.EQ.'TRCP')GOTO14310
        IF(ICASPL.EQ.'ERCP')GOTO14310
        IF(ICASPL.EQ.'LLCP')GOTO14310
        IF(ICASPL.EQ.'DWCP')GOTO14310
        IF(ICASPL.EQ.'FTCP')GOTO14310
        IF(ICASPL.EQ.'SDCP')GOTO14310
        IF(ICASPL.EQ.'ADCP')GOTO14310
        IF(ICASPL.EQ.'LXCP')GOTO14310
        IF(ICASPL.EQ.'GVCP')GOTO14310
        IF(ICASPL.EQ.'PFCP')GOTO14310
        IF(ICASPL.EQ.'VMCP')GOTO14310
        IF(ICASPL.EQ.'WCCP')GOTO14310
        IF(ICASPL.EQ.'GLCP')GOTO14310
        IF(ICASPL.EQ.'GZCP')GOTO14310
        IF(ICASPL.EQ.'DGCP')GOTO14310
        IF(ICASPL.EQ.'PNCP')GOTO14310
        IF(ICASPL.EQ.'G2CP')GOTO14310
        IF(ICASPL.EQ.'G3CP')GOTO14310
        IF(ICASPL.EQ.'G5CP')GOTO14310
C
        IF(ICASPL.EQ.'GHCP')GOTO14360
        IF(ICASPL.EQ.'IGCP')GOTO14360
        IF(ICASPL.EQ.'GGCP')GOTO14360
        IF(ICASPL.EQ.'BECP')GOTO14360
        IF(ICASPL.EQ.'FNCP')GOTO14360
        IF(ICASPL.EQ.'FCP')GOTO14360
        IF(ICASPL.EQ.'BNCP')GOTO14360
        IF(ICASPL.EQ.'G4CP')GOTO14360
        IF(ICASPL.EQ.'LDCP')GOTO14360
C
        IF(ICASPL.EQ.'WEKS')GOTO14410
        IF(ICASPL.EQ.'LNKS')GOTO14410
        IF(ICASPL.EQ.'GAKS')GOTO14410
        IF(ICASPL.EQ.'GIKS')GOTO14410
        IF(ICASPL.EQ.'LGKS')GOTO14410
        IF(ICASPL.EQ.'IWKS')GOTO14410
        IF(ICASPL.EQ.'GEKS')GOTO14410
        IF(ICASPL.EQ.'CSKS')GOTO14410
        IF(ICASPL.EQ.'CHKS')GOTO14410
        IF(ICASPL.EQ.'TKS')GOTO14410
        IF(ICASPL.EQ.'EEKS')GOTO14410
        IF(ICASPL.EQ.'FLKS')GOTO14410
        IF(ICASPL.EQ.'E2KS')GOTO14410
        IF(ICASPL.EQ.'WAKS')GOTO14410
        IF(ICASPL.EQ.'PAKS')GOTO14410
        IF(ICASPL.EQ.'LAKS')GOTO14410
        IF(ICASPL.EQ.'BRKS')GOTO14410
        IF(ICASPL.EQ.'REKS')GOTO14410
        IF(ICASPL.EQ.'TRKS')GOTO14410
        IF(ICASPL.EQ.'ERKS')GOTO14410
        IF(ICASPL.EQ.'LLKS')GOTO14410
        IF(ICASPL.EQ.'DWKS')GOTO14410
        IF(ICASPL.EQ.'FTKS')GOTO14410
        IF(ICASPL.EQ.'SDKS')GOTO14410
        IF(ICASPL.EQ.'ADKS')GOTO14410
        IF(ICASPL.EQ.'LXKS')GOTO14410
        IF(ICASPL.EQ.'GVKS')GOTO14410
        IF(ICASPL.EQ.'PFKS')GOTO14410
        IF(ICASPL.EQ.'VMKS')GOTO14410
        IF(ICASPL.EQ.'WCKS')GOTO14410
        IF(ICASPL.EQ.'GLKS')GOTO14410
        IF(ICASPL.EQ.'GZKS')GOTO14410
        IF(ICASPL.EQ.'DGKS')GOTO14410
        IF(ICASPL.EQ.'PNKS')GOTO14410
        IF(ICASPL.EQ.'G2KS')GOTO14410
        IF(ICASPL.EQ.'G3KS')GOTO14410
        IF(ICASPL.EQ.'G5KS')GOTO14410
C
        IF(ICASPL.EQ.'GHKS')GOTO14460
        IF(ICASPL.EQ.'IGKS')GOTO14460
        IF(ICASPL.EQ.'GGKS')GOTO14460
        IF(ICASPL.EQ.'BEKS')GOTO14460
        IF(ICASPL.EQ.'FNKS')GOTO14460
        IF(ICASPL.EQ.'FKS')GOTO14460
        IF(ICASPL.EQ.'LDKS')GOTO14460
        IF(ICASPL.EQ.'BNKS')GOTO14460
        IF(ICASPL.EQ.'G4KS')GOTO14460
C
        IF(ICASPL.EQ.'NOML')GOTO14710
        IF(ICASPL.EQ.'LOML')GOTO14710
        IF(ICASPL.EQ.'LAML')GOTO14710
        IF(ICASPL.EQ.'UNML')GOTO14710
        IF(ICASPL.EQ.'CAML')GOTO14710
        IF(ICASPL.EQ.'GUML')GOTO14710
        IF(ICASPL.EQ.'EXML')GOTO14710
        IF(ICASPL.EQ.'RAML')GOTO14710
        IF(ICASPL.EQ.'MAML')GOTO14710
        IF(ICASPL.EQ.'FNML')GOTO14710
C
        IF(ICASPL.EQ.'LNML')GOTO14810
        IF(ICASPL.EQ.'WEML')GOTO14810
        IF(ICASPL.EQ.'GAML')GOTO14810
        IF(ICASPL.EQ.'EEML')GOTO14810
        IF(ICASPL.EQ.'FLML')GOTO14810
        IF(ICASPL.EQ.'IGML')GOTO14810
        IF(ICASPL.EQ.'PAML')GOTO14810
        IF(ICASPL.EQ.'GEML')GOTO14810
        IF(ICASPL.EQ.'GEMO')GOTO14810
        IF(ICASPL.EQ.'GEDE')GOTO14810
        IF(ICASPL.EQ.'GECM')GOTO14810
        IF(ICASPL.EQ.'FRML')GOTO14810
        IF(ICASPL.EQ.'BEML')GOTO14810
        IF(ICASPL.EQ.'IWML')GOTO14810
C
        IF(ICASPL.EQ.'ADML')GOTO14910
        IF(ICASPL.EQ.'G5LM')GOTO14910
C
C  REMAINING CASES ARE FOR A SINGLE RESPONSE VARIABLE
C
        GOTO11360
C
C  JACKNIFE/BOOTSTRAP FOR STATISTICS WITH ONE RESPONSE VARIABLE
C
11360   CONTINUE
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL CMPSTA(
     1         TEMP0,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1         MAXNXT,NS2,NS2,NUMV2,ICASPL,
     1         ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1         IQUAME,IQUASE,
     1         THETHT,
     1         ISUBRO,IBUGG3,IERROR)
          NBELOW=0
        ENDIF
C
        TAGID=1.0
        DO11361IRESAM=1,NRESAM
          CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                TEMP4,IBUGG3,IERROR)
          CALL CMPSTA(
     1         TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1         MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1         ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1         IQUAME,IQUASE,
     1         RIGHT,
     1         ISUBRO,IBUGG3,IERROR)
          IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
            IF(RIGHT.LT.THETHT)NBELOW=NBELOW+1
            TEMP6(IRESAM)=RIGHT
          ENDIF
          IF(NGRPV.LE.1)THEN
            CALL DPJBS4(ISET,NUMSET,J,J2,RIGHT,TAGID,XIDTEM,Y2,X2,D2)
          ELSE
            CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,RIGHT,XIDTEM,
     1                  XIDTE2,Y2,X2,D2)
          ENDIF
11361   CONTINUE
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO11363IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
11363     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO11365I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
11365     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
11368     FORMAT(4E15.7,2F8.4,2F10.0)
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR STATISTICS WITH TWO (PAIRED) RESPONSE
C  VARIABLES
C
11490   CONTINUE
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL CMPSTA(
     1         TEMP0,TEMPZ0,XTEMP1,XTEMP2,XTEMP3,
     1         MAXNXT,NS2,NS2,NUMV2,ICASPL,
     1         ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1         IQUAME,IQUASE,
     1         THETHT,
     1         ISUBRO,IBUGG3,IERROR)
          NBELOW=0
        ENDIF
C
        TAGID=1.0
        DO11491IRESAM=1,NRESAM
          CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                TEMP4,IBUGG3,IERROR)
          DO11493IJ=1,NS3
            TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
11493     CONTINUE
          CALL CMPSTA(
     1         TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1         MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1         ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1         IQUAME,IQUASE,
     1         RIGHT,
     1         ISUBRO,IBUGG3,IERROR)
C
          IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
            IF(RIGHT.LT.THETHT)NBELOW=NBELOW+1
            TEMP6(IRESAM)=RIGHT
          ENDIF
C
          IF(NGRPV.LE.1)THEN
            CALL DPJBS4(ISET,NUMSET,J,J2,RIGHT,TAGID,XIDTEM,Y2,X2,D2)
          ELSE
            CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,RIGHT,XIDTEM,
     1                  XIDTE2,Y2,X2,D2)
          ENDIF
11491   CONTINUE
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO11496IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ0,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
11496     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO11497I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
11497     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11498)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11498)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11498)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
11498     FORMAT(4E15.7,2F8.4,2F10.0)
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR STATISTICS WITH TWO (UNPAIRED) RESPONSE
C  VARIABLES.  CURRENTLY ONLY FOR EQUAL SAMPLE SIZES, NEED TO
C  EXTEND TO UNEQUAL SAMPLE SIZES.
C
C  BCA INTERVALS NOT COMPUTED FOR THIS CASE (NOT CLEAR HOW TO
C  PERFORM THE JACKNIFE STEP FOR UNPAIRED SAMPLES).
C
11590   CONTINUE
        IBCABT='OFF'
        TAGID=1.0
        DO11591IRESAM=1,NRESAM
          CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                TEMP4,IBUGG3,IERROR)
          CALL DPJBS3(TEMPZ0,NS22,ICASJB,IRESAM,ISEED,TEMPZ,NS32,ITEMP1,
     1                TEMP4,IBUGG3,IERROR)
          CALL CMPSTA(
     1         TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1         MAXNXT,NS3,NS32,NUMV2,ICASPL,
     1         ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1         IQUAME,IQUASE,
     1         RIGHT,
     1         ISUBRO,IBUGG3,IERROR)
          IF(NGRPV.LE.1)THEN
            CALL DPJBS4(ISET,NUMSET,J,J2,RIGHT,TAGID,XIDTEM,Y2,X2,D2)
          ELSE
            CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,RIGHT,XIDTEM,
     1                  XIDTE2,Y2,X2,D2)
          ENDIF
11591   CONTINUE
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR THE 4 LINEAR FIT CASES
C
11730   CONTINUE
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL CMPSTA(
     1         TEMP0,TEMPZ0,XTEMP1,XTEMP2,XTEMP3,
     1         MAXNXT,NS2,NS2,NUMV2,ICASPL,
     1         ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1         IQUAME,IQUASE,
     1         THETHT,
     1         ISUBRO,IBUGG3,IERROR)
          NBELOW=0
        ENDIF
C
        CALL LINFIT(TEMP0,TEMPZ0,NS2,
     1       ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1       ISUBRO,IBUGG3,IERROR)
        ALPHA0=ALPHA
        BETA0=BETA
        DO11731I=1,NS2
          RES1(I)=TEMP0(I)-(ALPHA0+BETA0*TEMPZ0(I))
11731   CONTINUE
        DO11732IRESAM=1,NRESAM
          CALL DPJBS3(RES1,NS2,ICASJB,IRESAM,ISEED,RES2,NS3,ITEMP1,
     1                TEMP4,IBUGG3,IERROR)
          DO11733I=1,NS3
            TEMP0(I)=(ALPHA0+BETA0*TEMPZ0(I))+RES2(I)
11733     CONTINUE
          CALL CMPSTA(
     1       TEMP0,TEMPZ0,XTEMP1,XTEMP2,XTEMP3,
     1       MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1       ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1       IQUAME,IQUASE,
     1       RIGHT,
     1       ISUBRO,IBUGG3,IERROR)
C
          IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
            IF(RIGHT.LT.THETHT)NBELOW=NBELOW+1
            TEMP6(IRESAM)=RIGHT
          ENDIF
C
          IF(NGRPV.LE.1)THEN
            TAGID=1.0
            CALL DPJBS4(ISET,NUMSET,J,J2,RIGHT,TAGID,XIDTEM,Y2,X2,D2)
          ELSE
            CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,RIGHT,XIDTEM,
     1                  XIDTE2,Y2,X2,D2)
          ENDIF
11732   CONTINUE
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO11831IRESAM=1,NS2
            CALL DPJBS3(RES1,NS2,ICASJB,IRESAM,ISEED,RES2,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO11833I=1,NS3
              TEMP0(I)=(ALPHA0+BETA0*TEMPZ0(I))+RES2(I)
11833       CONTINUE
            CALL CMPSTA(
     1           TEMP0,TEMPZ0,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
11831     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO11835I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
11835     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11838)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11838)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11838)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
11838    FORMAT(4E15.7,2F8.4,2F10.0)
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR THE LINEAR/QUADRATIC CALIBRATION CASES
C
C
CCCCC NOTE: FOR LINEAR CALIBRATION, 2 METHODS.  "RESI" USES
CCCCC       EFROM METHOD OF RESAMPLING THE RESIDUALS.  "DATA"
CCCCC       USES WU METHOD OF RESAMPLING THE ORIGINAL Y AND X.
CCCCC       IN EITHER CASE, THE PARAMETER Y0 SHOULD BE PRE-DEFINED.
C
12210   CONTINUE
C
        IBCABT='OFF'
C
        IHP='Y0  '
        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')THEN
          GOTO9000
        ELSE
          Y0=VALUE(ILOCP)
        ENDIF
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JSB2')THEN
          DO12239I=1,NS2
            WRITE(ICOUT,12231)I,TEMP0(I),TEMPZ0(I)
12231       FORMAT('I,TEMP0(I),TEMPZ0(I) = ',I8,2G15.7)
            CALL DPWRST('XXX','BUG ')
12239     CONTINUE
        ENDIF
        IF(IBOOME.EQ.'RESI')THEN
C
C  GENERATE FIT AND RESIDUALS FROM ORIGINAL DATA.
C
          CALL LINFIT(TEMP0,TEMPZ0,NS2,
     1              ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1              ISUBRO,IBUGG3,IERROR)
          ALPHA0=ALPHA
          BETA0=BETA
          DO12211I=1,NS2
            RES1(I)=TEMP0(I)-(ALPHA0+BETA0*TEMPZ0(I))
12211     CONTINUE
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JSB2')THEN
            WRITE(ICOUT,12233)ALPHA0,BETA0
12233       FORMAT('ALPHA0,BETA0 = ',2G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
C  RESAMPLE RESIDUALS.
C
          DO12216IRESAM=1,NRESAM
            CALL DPJBS3(RES1,NS2,ICASJB,IRESAM,ISEED,RES2,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO12213I=1,NS3
              TEMP(I)=(ALPHA0+BETA0*TEMPZ0(I))+RES2(I)
12213       CONTINUE
            CALL LINFIT(TEMP,TEMPZ0,NS3,
     1         ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1         ISUBRO,IBUGG3,IERROR)
            A0=ALPHA
            A1=BETA
            RIGHT=(Y0-A0)/A1
            IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JSB2')THEN
              WRITE(ICOUT,12235)IRESAM,ALPHA,BETA,RIGHT
12235         FORMAT('IRESAM,ALPHA0,BETA0,RIGHT = ',I8,3G15.7)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            TAGID=1.0
            IF(NGRPV.LE.1)THEN
              CALL DPJBS4(ISET,NUMSET,J,J2,RIGHT,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,RIGHT,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
12216     CONTINUE
        ELSE
C
C  RESAMPLE ORIGINAL Y AND X VALUES (ROWS OF Y AND X SHOULD REMAIN
C  PAIRED).
C
          DO12226IRESAM=1,NRESAM
            CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO12221IJ=1,NS3
              TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
12221       CONTINUE
            CALL LINFIT(TEMP,TEMPZ,NS3,
     1         ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1         ISUBRO,IBUGG3,IERROR)
            A0=ALPHA
            A1=BETA
            RIGHT=(Y0-A0)/A1
            IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JSB2')THEN
              WRITE(ICOUT,12237)IRESAM,ALPHA,BETA,RIGHT
12237         FORMAT('IRESAM,ALPHA0,BETA0,RIGHT = ',I8,3G15.7)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            TAGID=1.0
            IF(NGRPV.LE.1)THEN
              CALL DPJBS4(ISET,NUMSET,J,J2,RIGHT,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,RIGHT,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
12226     CONTINUE
        ENDIF
        GOTO79000
C
CCCCC NOTE: FOR QUADRATIC CALIBRATION, 2 METHODS.  "RESI" USES
CCCCC       EFROM METHOD OF RESAMPLING THE RESIDUALS.  "DATA"
CCCCC       USES WU METHOD OF RESAMPLING THE ORIGINAL Y AND X.
CCCCC       IN EITHER CASE, THE PARAMETER Y0 SHOULD BE PRE-DEFINED.
CCCCC
CCCCC       AFTER QUADRATIC FIT, QUADRATIC FORMULA IS:
CCCCC           X = (-b +/- SQRT(b**2 - 4*a*c))/(2*a)
C
12240   CONTINUE
C
        IHP='Y0  '
        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')THEN
          GOTO9000
        ELSE
          Y0=VALUE(ILOCP)
        ENDIF
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JSB2')THEN
          DO12269I=1,NS2
            WRITE(ICOUT,12261)I,TEMP0(I),TEMPZ0(I)
12261       FORMAT('I,TEMP0(I),TEMPZ0(I) = ',I8,2G15.7)
            CALL DPWRST('XXX','BUG ')
12269     CONTINUE
        ENDIF
C
        CALL MINIM(TEMPZ0,NS2,IWRITE,XLEFT,IBUGG3,IERROR)
        CALL MAXIM(TEMPZ0,NS2,IWRITE,XRIGHT,IBUGG3,IERROR)
C
        IF(IBOOME.EQ.'RESI')THEN
C
C  GENERATE FIT AND RESIDUALS FROM ORIGINAL DATA.
C
          CALL QUAFI2(TEMPZ0,TEMP0,NS2,
     1                XTEMP1,
     1                ALPHA,BETA1,BETA2,
     1                ISUBRO,IBUGG3,IERROR)
          ALPHA0=ALPHA
          BETA10=BETA1
          BETA20=BETA2
C
          C=ALPHA - Y0
          B=BETA1
          A=BETA2
          TERM1=B**2 - 4.0*A*C
          RIGH10=0.0
          RIGH20=0.0
          IF(TERM1.GE.0.0)THEN
            TERM1=SQRT(TERM1)
            RIGH10=(-B + TERM1)/(2*A)
            RIGH20=(-B - TERM1)/(2*A)
          ENDIF
          IF(RIGH10.GE.XLEFT .AND. RIGH10.LE.XRIGHT)THEN
            RIGHT0=RIGH10
          ELSEIF(RIGH20.GE.XLEFT .AND. RIGH20.LE.XRIGHT)THEN
            RIGHT0=RIGH20
          ELSE
            RIGHT0=RIGH10
          ENDIF
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JSB2')THEN
            WRITE(ICOUT,12262)RIGH10,RIGH20
12262       FORMAT('FULL SAMPLE ROOTS: RIGH10,RIGH20 = ',2E15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          DO12241I=1,NS2
            AJUNK1=TEMPZ0(I)
            RES1(I)=TEMP0(I)-(ALPHA0+BETA10*AJUNK1+BETA20*AJUNK1**2)
12241     CONTINUE
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JSB2')THEN
            WRITE(ICOUT,12263)ALPHA0,BETA10,BETA20
12263       FORMAT('ALPHA0,BETA10,BETA20 = ',3G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
C  RESAMPLE RESIDUALS.
C
          NREJ=0
          NNEG=0
          DO12246IRESAM=1,NRESAM
            CALL DPJBS3(RES1,NS2,ICASJB,IRESAM,ISEED,RES2,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO12243I=1,NS3
              AJUNK1=TEMPZ0(I)
              TEMP(I)=(ALPHA0+BETA10*AJUNK1+BETA20*AJUNK1**2)+RES2(I)
12243       CONTINUE
            CALL QUAFI2(TEMPZ0,TEMP,NS3,
     1           XTEMP1,
     1           ALPHA,BETA1,BETA2,
     1           ISUBRO,IBUGG3,IERROR)
            C=ALPHA - Y0
            B=BETA1
            A=BETA2
            TERM1=B**2 - 4.0*A*C
            IF(TERM1.EQ.0.0)THEN
              RIGHT=(-B + TERM1)/(2*A)
            ELSEIF(TERM1.GT.0.0)THEN
              TERM1=SQRT(TERM1)
              RIGH1=(-B + TERM1)/(2*A)
              RIGH2=(-B - TERM1)/(2*A)
              IF(RIGH1.GE.XLEFT .AND. RIGH1.LE.XRIGHT)THEN
                IF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
                  D1DIFF=ABS(RIGH1-RIGHT0)
                  D2DIFF=ABS(RIGH2-RIGHT0)
                  IF(D1DIFF.LE.D2DIFF)THEN
                    RIGHT=RIGH1
                  ELSE
                    RIGHT=RIGH2
                  ENDIF
                ELSE
                  RIGHT=RIGH1
                ENDIF
              ELSEIF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
                RIGHT=RIGH2
              ELSE
                IF(RIGH1.GT.0.0 .AND. RIGH2.LE.0.0)THEN
                  RIGHT=RIGH1
                ELSEIF(RIGH2.GT.0.0 .AND. RIGH1.LE.0.0)THEN
                  RIGHT=RIGH2
                ELSE
                  D1DIFF=ABS(RIGH1-RIGHT0)
                  D2DIFF=ABS(RIGH2-RIGHT0)
                  IF(D1DIFF.LE.D2DIFF)THEN
                    RIGHT=RIGH1
                  ELSE
                    RIGHT=RIGH2
                  ENDIF
                ENDIF
              ENDIF
              IF(RIGHT.LT.0)NNEG=NNEG+1
            ELSEIF(TERM1.LT.0.0)THEN
              NREJ=NREJ+1
              GOTO12246
            ENDIF
            IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JSB2')THEN
              WRITE(ICOUT,12265)IRESAM,ALPHA,BETA1,BETA2,RIGHT
12265         FORMAT('IRESAM,ALPHA,BETA1,BETA2,RIGHT = ',I8,3G15.7)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,12266)A,B,C,TERM1
12266         FORMAT('A, B, C, TERM1 = ',4G15.7)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            TAGID=1.0
            IF(NGRPV.LE.1)THEN
              CALL DPJBS4(ISET,NUMSET,J,J2,RIGHT,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,RIGHT,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
12246     CONTINUE
        ELSE
C
C  RESAMPLE ORIGINAL Y AND X VALUES (ROWS OF Y AND X SHOULD REMAIN
C  PAIRED).
C
          NNEG=0
          NREJ=0
          DO12256IRESAM=1,NRESAM
            CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO12251IJ=1,NS3
              TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
12251       CONTINUE
            CALL QUAFI2(TEMPZ,TEMP,NS3,
     1           XTEMP1,
     1           ALPHA,BETA1,BETA2,
     1           ISUBRO,IBUGG3,IERROR)
            C=ALPHA - Y0
            B=BETA1
            A=BETA2
            TERM1=B**2 - 4.0*A*C
            IF(TERM1.EQ.0.0)THEN
              RIGHT=(-B + TERM1)/(2*A)
            ELSEIF(TERM1.GT.0.0)THEN
              TERM1=SQRT(TERM1)
              RIGH1=(-B + TERM1)/(2*A)
              RIGH2=(-B - TERM1)/(2*A)
              IF(RIGH1.GE.XLEFT .AND. RIGH1.LE.XRIGHT)THEN
                IF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
                  IF(RIGH1.GT.0.0 .AND. RIGH2.LE.0.0)THEN
                    RIGHT=RIGH1
                  ELSEIF(RIGH2.GT.0.0 .AND. RIGH1.LE.0.0)THEN
                    RIGHT=RIGH2
                  ELSE
                    D1DIFF=ABS(RIGH1-RIGHT0)
                    D2DIFF=ABS(RIGH2-RIGHT0)
                    IF(D1DIFF.LE.D2DIFF)THEN
                      RIGHT=RIGH1
                    ELSE
                      RIGHT=RIGH2
                    ENDIF
                  ENDIF
                ELSE
                  RIGHT=RIGH1
                ENDIF
              ELSEIF(RIGH2.GE.XLEFT .AND. RIGH2.LE.XRIGHT)THEN
                RIGHT=RIGH2
              ELSE
                D1DIFF=ABS(RIGH1-RIGHT0)
                D2DIFF=ABS(RIGH2-RIGHT0)
                IF(D1DIFF.LE.D2DIFF)THEN
                  RIGHT=RIGH1
                ELSE
                  RIGHT=RIGH2
                ENDIF
              ENDIF
              IF(RIGHT.LT.0)NNEG=NNEG+1
            ELSEIF(TERM1.LT.0.0)THEN
              NREJ=NREJ+1
              GOTO12256
            ENDIF
            IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JSB2')THEN
              WRITE(ICOUT,12265)IRESAM,ALPHA,BETA1,BETA2,RIGHT
              CALL DPWRST('XXX','BUG ')
            ENDIF
            TAGID=1.0
            IF(NGRPV.LE.1)THEN
              CALL DPJBS4(ISET,NUMSET,J,J2,RIGHT,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,RIGHT,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
12256     CONTINUE
        ENDIF
        IF(NREJ.GT.0)THEN
          WRITE(ICOUT,12247)
12247     FORMAT('***** WARNING FROM DPJBS2--QUADRATIC CALIBRATION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,12248)NREJ
12248     FORMAT('      FOR ',I8,' BOOTSTRAP SAMPLES, NO REAL ROOTS ',
     1           'FOR THE QUADRATIC EQUATION.')
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NNEG.GT.0)THEN
          WRITE(ICOUT,12247)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,12249)NREJ
12249     FORMAT('      FOR ',I8,' BOOTSTRAP SAMPLES, NEGATIVE ROOT ',
     1           'SELECTED.')
          CALL DPWRST('XXX','BUG ')
        ENDIF
        GOTO79000
C
C  JANUARY 2005: IMPLEMENT BOOTSTRAP DISTRIBUTIONAL FITTING
C
C  JACKNIFE/BOOTSTRAP FOR DISTRIBUTIONS THAT ESTIMATE LOCATION AND
C  SCALE PARAMETERS VIA A PROBABILITY PLOT.
C
14210   CONTINUE
C
        NUMPAR=3
C
        IF(NPERC.GT.0 .AND.ISET.EQ.1)THEN
          IOUNI4=IST4NU
          IFILE4=IST4NA
          ISTAT4=IST4ST
          IFORM4=IST4FO
          IACCE4=IST4AC
          IPROT4=IST4PR
          ICURS4=IST4CS
          ISUBN0='JBS2'
          IERRF4='NO'
C
          IREWI4='ON'
          CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,
     1                IPROT4,ICURS4,
     1                IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
          IF(NGRPV.EQ.0)THEN
            IFORMT='(    E15.7)'
            IFORMZ='(    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(5:5),'(I1)')NPERC
              WRITE(IFORMZ(5:5),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(4:5),'(I2)')NPERC
              WRITE(IFORMZ(4:5),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(3:5),'(I3)')NPERC
              WRITE(IFORMZ(3:5),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.1)THEN
            IFORMT='(I8,1X,    E15.7)'
            IFORMZ='(9X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(11:11),'(I1)')NPERC
              WRITE(IFORMZ(8:8),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(10:11),'(I2)')NPERC
              WRITE(IFORMZ(7:8),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(9:11),'(I3)')NPERC
              WRITE(IFORMZ(7:8),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.2)THEN
            IFORMT='(I8,1X,I8,1X,    E15.7)'
            IFORMZ='(18X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(17:17),'(I1)')NPERC
              WRITE(IFORMZ(9:9),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(16:17),'(I2)')NPERC
              WRITE(IFORMZ(8:9),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(15:17),'(I3)')NPERC
              WRITE(IFORMZ(8:9),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ENDIF
          IF(NPERC.GT.0)THEN
            WRITE(IOUNI4,IFORMZ)(QP(JJ),JJ=1,NPERC)
          ENDIF
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF((IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT') .OR.
     1     (IBOOPA.EQ.'PARA' .AND. ICENSO.NE.'ON'))THEN
          CALL DPJBPP(
     1         TEMP0,TEMPZ0,NS2,ICASPL,ICENSO,IMETHD,IPPLDP,MAXNXT,
     1         MINMAX,
     1         XTEMP1,XTEMP2,
     1         XTEMP3,TEMP8,RES1,RES2,
     1         QP,XQP,NPERC,
     1         PPA0HT,PPA1HT,CORRHT,
     1         IBUGG3,ISUBRO,IERROR)
          ICASRA='NULL'
          PPA0SV=PPA0HT
          PPA1SV=PPA1HT
          IF(ICASPL.EQ.'NOPP')ICASRA='NORM'
          IF(ICASPL.EQ.'UNPP')ICASRA='UNIF'
          IF(ICASPL.EQ.'LOPP')ICASRA='LOGI'
          IF(ICASPL.EQ.'CAPP')ICASRA='CAUC'
          IF(ICASPL.EQ.'LAPP')ICASRA='DOUB'
          IF(ICASPL.EQ.'HNPP')ICASRA='HALF'
          IF(ICASPL.EQ.'EXPP')ICASRA='EXPO'
          IF(ICASPL.EQ.'GUPP')ICASRA='EXV1'
          IF(ICASPL.EQ.'SEPP')ICASRA='SEMI'
          IF(ICASPL.EQ.'HCPP')ICASRA='HFCA'
          IF(ICASPL.EQ.'COPP')ICASRA='COSI'
          IF(ICASPL.EQ.'ANPP')ICASRA='ANGL'
          IF(ICASPL.EQ.'HSPP')ICASRA='HSEC'
          IF(ICASPL.EQ.'HLPP')ICASRA='HALO'
          IF(ICASPL.EQ.'SLPP')ICASRA='SLAS'
          IF(ICASPL.EQ.'RAPP')ICASRA='RAYL'
          IF(ICASPL.EQ.'ARPP')ICASRA='ARCS'
          IF(ICASPL.EQ.'LUPP')ICASRA='LAND'
          NBELW1=0
          NBELW2=0
          NBELW3=0
        ENDIF
C
C  HANDLE BOOTSTRAP SAMPLE DIFFERENTLY FOR CENSORED AND UNCENSORED
C  DATA (CENSORED CASE HAS A PAIRED VARIABLE TO RESAMPLE)
C
        IF(ICENSO.EQ.'OFF')THEN
          DO14261IRESAM=1,NRESAM
            IF(IBOOPA.EQ.'PARA')THEN
              CALL DPJBRA(ICASRA,ISEED,MINMAX,
     1                    TEMP,NS2,
     1                    SHAPE1,SHAPE2,PPA0SV,PPA1SV,
     1                    IMAKDF,IGEODF,IBEIDF,IBEKDF,IGEPDF,IADEDF,
     1                    ILGADF,ISKNDF,IGLDDF,
     1                    IBUGG3,ISUBRO,IERROR)
            ELSE
              CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,
     1                  TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            ENDIF
            CALL DPJBPP(TEMP,TEMP4,NS2,
     1                  ICASPL,ICENSO,IMETHD,IPPLDP,MAXNXT,
     1                  MINMAX,
     1                  XTEMP1,XTEMP2,
     1                  XTEMP3,TEMP8,RES1,RES2,
     1                  QP,XQP,NPERC,
     1                  PPA0,PPA1,ACORR,
     1                  IBUGG3,ISUBRO,IERROR)
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              TEMP6(IRESAM)=PPA0
              TEMP7(IRESAM)=PPA1
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=3.0
              CALL DPJBS4(ISET,NUMSET,J,J2,ACORR,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14261     CONTINUE
        ELSE
          DO14271IRESAM=1,NRESAM
            CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO14273IJ=1,NS3
              TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
14273       CONTINUE
            CALL DPJBPP(TEMP,TEMPZ,NS2,
     1                  ICASPL,ICENSO,IMETHD,IPPLDP,MAXNXT,
     1                  MINMAX,
     1                  XTEMP1,XTEMP2,
     1                  XTEMP3,TEMP8,RES1,RES2,
     1                  QP,XQP,NPERC,
     1                  PPA0,PPA1,ACORR,
     1                  IBUGG3,ISUBRO,IERROR)
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              TEMP6(IRESAM)=PPA0
              TEMP7(IRESAM)=PPA1
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=3.0
              CALL DPJBS4(ISET,NUMSET,J,J2,ACORR,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14271     CONTINUE
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO14275IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
14275     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO14265I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
14265     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
        ENDIF
C
        ILAST=ISETMX
        IF(NGRPV.GE.1)ILAST=ISETMX-1
        IF(NPERC.GT.0 .AND. ISET.EQ.ILAST)THEN
          IENDF4='OFF'
          IREWI4='ON'
          CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IENDF4,IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR DISTRIBUTIONS THAT ESTIMATE ONE SHAPE
C  PARAMETER VIA PPCC PLOT AND LOCATION AND SCALE PARAMETERS VIA
C  A PROBABILITY PLOT.
C
14310   CONTINUE
C
        NUMPAR=4
        NHOR1=IPPCAP(1)
        NHOR2=IPPCAP(2)
C
        IF(NPERC.GT.0 .AND.ISET.EQ.1)THEN
          IOUNI4=IST4NU
          IFILE4=IST4NA
          ISTAT4=IST4ST
          IFORM4=IST4FO
          IACCE4=IST4AC
          IPROT4=IST4PR
          ICURS4=IST4CS
          ISUBN0='JBS2'
          IERRF4='NO'
C
          IREWI4='ON'
          CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,
     1                IPROT4,ICURS4,
     1                IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
          IF(NGRPV.EQ.0)THEN
            IFORMT='(    E15.7)'
            IFORMZ='(    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(5:5),'(I1)')NPERC
              WRITE(IFORMZ(5:5),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(4:5),'(I2)')NPERC
              WRITE(IFORMZ(4:5),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(3:5),'(I3)')NPERC
              WRITE(IFORMZ(3:5),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.1)THEN
            IFORMT='(I8,1X,    E15.7)'
            IFORMZ='(9X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(11:11),'(I1)')NPERC
              WRITE(IFORMZ(8:8),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(10:11),'(I2)')NPERC
              WRITE(IFORMZ(7:8),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(9:11),'(I3)')NPERC
              WRITE(IFORMZ(7:8),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.2)THEN
            IFORMT='(I8,1X,I8,1X,    E15.7)'
            IFORMZ='(18X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(17:17),'(I1)')NPERC
              WRITE(IFORMZ(9:9),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(16:17),'(I2)')NPERC
              WRITE(IFORMZ(8:9),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(15:17),'(I3)')NPERC
              WRITE(IFORMZ(8:9),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ENDIF
          IF(NPERC.GT.0)THEN
            WRITE(IOUNI4,IFORMZ)(QP(JJ),JJ=1,NPERC)
          ENDIF
        ENDIF
C
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF((IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT') .OR.
     1     (IBOOPA.EQ.'PARA' .AND. ICENSO.NE.'ON'))THEN
          CALL DPJBCP(
     1         TEMP0,TEMPZ0,NS2,
     1         ICASPL,ICENSO,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1         XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1         NHOR1,IGEPDF,IADEDF,ILGADF,ISKNDF,
     1         QP,XQP,NPERC,
     1         PPA0HT,PPA1HT,SHAPHT,ACORR,
     1         IBUGG3,ISUBRO,IERROR)
          ICASRA='NULL'
          PPA0SV=PPA0HT
          PPA1SV=PPA1HT
          SHAPSV=SHAPHT
          IF(ICASPL.EQ.'WECP')ICASRA='WEIB'
          IF(ICASPL.EQ.'LACP')ICASRA='LAMB'
          IF(ICASPL.EQ.'LNCP')ICASRA='LOGN'
          IF(ICASPL.EQ.'TCP')ICASRA='T'
          IF(ICASPL.EQ.'CSCP')ICASRA='CHIS'
          IF(ICASPL.EQ.'CHCP')ICASRA='CHI'
          IF(ICASPL.EQ.'GACP')ICASRA='GAMM'
          IF(ICASPL.EQ.'GACP')ICASRA='GAMM'
          IF(ICASPL.EQ.'E2CP')ICASRA='EXV2'
          IF(ICASPL.EQ.'PACP')ICASRA='PARE'
          IF(ICASPL.EQ.'P2CP')ICASRA='PAR2'
          IF(ICASPL.EQ.'TRCP')ICASRA='TRIA'
          IF(ICASPL.EQ.'WACP')ICASRA='WALD'
          IF(ICASPL.EQ.'FLCP')ICASRA='FL'
          IF(ICASPL.EQ.'GECP')ICASRA='GEP'
          IF(ICASPL.EQ.'PFCP')ICASRA='POWF'
          IF(ICASPL.EQ.'IWCP')ICASRA='IWEI'
          IF(ICASPL.EQ.'DWCP')ICASRA='DWEI'
          IF(ICASPL.EQ.'DGCP')ICASRA='DGAM'
          IF(ICASPL.EQ.'LGCP')ICASRA='LGAM'
          IF(ICASPL.EQ.'GICP')ICASRA='IGAM'
          IF(ICASPL.EQ.'LDCP')ICASRA='LDEX'
          IF(ICASPL.EQ.'GVCP')ICASRA='GEVA'
          IF(ICASPL.EQ.'GZCP')ICASRA='GHLO'
          IF(ICASPL.EQ.'BRCP')ICASRA='BRAD'
          IF(ICASPL.EQ.'RECP')ICASRA='RECI'
          IF(ICASPL.EQ.'PNCP')ICASRA='PNOR'
          IF(ICASPL.EQ.'LLCP')ICASRA='LLOG'
          IF(ICASPL.EQ.'EECP')ICASRA='GEEE'
          IF(ICASPL.EQ.'ERCP')ICASRA='ERRO'
          IF(ICASPL.EQ.'VMCP')ICASRA='VONM'
          IF(ICASPL.EQ.'WCCP')ICASRA='WRCA'
          IF(ICASPL.EQ.'SNCP')ICASRA='SKWN'
          IF(ICASPL.EQ.'GLCP')ICASRA='GLOG'
          IF(ICASPL.EQ.'SDCP')ICASRA='SKDE'
          IF(ICASPL.EQ.'ADCP')ICASRA='ASDE'
          IF(ICASPL.EQ.'MCCP')ICASRA='MCLE'
          NBELW1=0
          NBELW2=0
          NBELW3=0
        ENDIF
C
C  HANDLE BOOTSTRAP SAMPLE DIFFERENTLY FOR CENSORED AND UNCENSORED
C  DATA (CENSORED CASE HAS A PAIRED VARIABLE TO RESAMPLE)
C
        IF(ICENSO.EQ.'OFF')THEN
          DO14321IRESAM=1,NRESAM
            IF(IBOOPA.EQ.'PARA')THEN
              CALL DPJBRA(ICASRA,ISEED,MINMAX,
     1                    TEMP,NS2,
     1                    SHAPSV,SHAPE2,PPA0SV,PPA1SV,
     1                    IMAKDF,IGEODF,IBEIDF,IBEKDF,IGEPDF,IADEDF,
     1                    ILGADF,ISKNDF,IGLDDF,
     1                    IBUGG3,ISUBRO,IERROR)
            ELSE
              CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,
     1                    NS3,ITEMP1,
     1                    TEMP4,IBUGG3,IERROR)
            ENDIF
            CALL DPJBCP(
     1           TEMP,TEMP4,NS2,
     1           ICASPL,ICENSO,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1           XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1           NHOR1,IGEPDF,IADEDF,ILGADF,ISKNDF,
     1           QP,XQP,NPERC,
     1           PPA0,PPA1,SHAPE1,ACORR,
     1           IBUGG3,ISUBRO,IERROR)
C
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              IF(PPA1.LT.PPA1HT)NBELW2=NBELW2+1
              IF(SHAPE1.LT.SHA1HT)NBELW3=NBELW3+1
              TEMP6(IRESAM)=PPA0
              TEMP7(IRESAM)=PPA1
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=3.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=4.0
              CALL DPJBS4(ISET,NUMSET,J,J2,ACORR,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14321     CONTINUE
        ELSE
          DO14331IRESAM=1,NRESAM
            CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO14333IJ=1,NS3
              TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
14333       CONTINUE
            CALL DPJBCP(
     1           TEMP,TEMPZ,NS2,
     1           ICASPL,ICENSO,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1           XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1           NHOR1,IGEPDF,IADEDF,ILGADF,ISKNDF,
     1           QP,XQP,NPERC,
     1           PPA0,PPA1,SHAPE1,ACORR,
     1           IBUGG3,ISUBRO,IERROR)
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              IF(PPA1.LT.PPA1HT)NBELW2=NBELW2+1
              IF(SHAPE1.LT.SHA1HT)NBELW3=NBELW3+1
              TEMP6(IRESAM)=PPA0
              TEMP7(IRESAM)=PPA1
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=3.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=4.0
              CALL DPJBS4(ISET,NUMSET,J,J2,ACORR,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14331     CONTINUE
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO14345IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
14345     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO14348I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
14348     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
        ENDIF
C
        ILAST=ISETMX
        IF(NGRPV.GE.1)ILAST=ISETMX-1
        IF(NPERC.GT.0 .AND. ISET.EQ.ILAST)THEN
          IENDF4='OFF'
          IREWI4='ON'
          CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IENDF4,IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR DISTRIBUTIONS THAT ESTIMATE TWO SHAPE
C  PARAMETER VIA PPCC PLOT AND LOCATION AND SCALE PARAMETERS VIA
C  A PROBABILITY PLOT.
C
14360   CONTINUE
C
        NUMPAR=5
        NHOR1=IPPCAP(1)
        NHOR2=IPPCAP(2)
C
        IF(NPERC.GT.0 .AND.ISET.EQ.1)THEN
          IOUNI4=IST4NU
          IFILE4=IST4NA
          ISTAT4=IST4ST
          IFORM4=IST4FO
          IACCE4=IST4AC
          IPROT4=IST4PR
          ICURS4=IST4CS
          ISUBN0='JBS2'
          IERRF4='NO'
C
          IREWI4='ON'
          CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,
     1                IPROT4,ICURS4,
     1                IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
          IF(NGRPV.EQ.0)THEN
            IFORMT='(    E15.7)'
            IFORMZ='(    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(5:5),'(I1)')NPERC
              WRITE(IFORMZ(5:5),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(4:5),'(I2)')NPERC
              WRITE(IFORMZ(4:5),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(3:5),'(I3)')NPERC
              WRITE(IFORMZ(3:5),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.1)THEN
            IFORMT='(I8,1X,    E15.7)'
            IFORMZ='(9X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(11:11),'(I1)')NPERC
              WRITE(IFORMZ(8:8),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(10:11),'(I2)')NPERC
              WRITE(IFORMZ(7:8),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(9:11),'(I3)')NPERC
              WRITE(IFORMZ(7:8),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.2)THEN
            IFORMT='(I8,1X,I8,1X,    E15.7)'
            IFORMZ='(18X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(17:17),'(I1)')NPERC
              WRITE(IFORMZ(9:9),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(16:17),'(I2)')NPERC
              WRITE(IFORMZ(8:9),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(15:17),'(I3)')NPERC
              WRITE(IFORMZ(8:9),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ENDIF
          IF(NPERC.GT.0)THEN
            WRITE(IOUNI4,IFORMZ)(QP(JJ),JJ=1,NPERC)
          ENDIF
        ENDIF
C
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF((IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT') .OR.
     1     (IBOOPA.EQ.'PARA' .AND. ICENSO.NE.'ON'))THEN
          CALL DPJBC2(
     1         TEMP0,TEMPZ0,NS2,
     1         ICASPL,ICENSO,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1         XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1         NHOR1,NHOR2,
     1         QP,XQP,NPERC,
     1         PPA0HT,PPA1HT,SHA1HT,SHA2HT,ACORR,
     1         IBUGG3,ISUBRO,IERROR)
          ICASRA='NULL'
          PPA0SV=PPA0HT
          PPA1SV=PPA1HT
          SHA1SV=SHA1HT
          SHA2SV=SHA2HT
          IF(ICASPL.EQ.'GHCP')ICASRA='GH  '
          IF(ICASPL.EQ.'FCP')ICASRA='F   '
          IF(ICASPL.EQ.'FNCP')ICASRA='FNRM'
          IF(ICASPL.EQ.'IGCP')ICASRA='IG  '
          IF(ICASPL.EQ.'BECP')ICASRA='BETA'
          IF(ICASPL.EQ.'GGCP')ICASRA='GGD '
          NBELW1=0
          NBELW2=0
          NBELW3=0
          NBELW4=0
        ENDIF
C
C  HANDLE BOOTSTRAP SAMPLE DIFFERENTLY FOR CENSORED AND UNCENSORED
C  DATA (CENSORED CASE HAS A PAIRED VARIABLE TO RESAMPLE)
C
        IF(ICENSO.EQ.'OFF')THEN
          DO14371IRESAM=1,NRESAM
            IF(IBOOPA.EQ.'PARA')THEN
              CALL DPJBRA(ICASRA,ISEED,MINMAX,
     1                    TEMP,NS2,
     1                    SHA1SV,SHA2SV,PPA0SV,PPA1SV,
     1                    IMAKDF,IGEODF,IBEIDF,IBEKDF,IGEPDF,IADEDF,
     1                    ILGADF,ISKNDF,IGLDDF,
     1                    IBUGG3,ISUBRO,IERROR)
            ELSE
              CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,
     1                  NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            ENDIF
            CALL DPJBC2(
     1           TEMP,TEMP4,NS2,
     1           ICASPL,ICENSO,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1           XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1           NHOR1,NHOR2,
     1           QP,XQP,NPERC,
     1           PPA0,PPA1,SHAPE1,SHAPE2,ACORR,
     1           IBUGG3,ISUBRO,IERROR)
C
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              IF(PPA1.LT.PPA1HT)NBELW2=NBELW2+1
              IF(SHAPE1.LT.SHA1HT)NBELW3=NBELW3+1
              IF(SHAPE2.LT.SHA2HT)NBELW4=NBELW4+1
              TEMP6(IRESAM)=PPA0
              TEMP7(IRESAM)=PPA1
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=3.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=4.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE2,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=5.0
              CALL DPJBS4(ISET,NUMSET,J,J2,ACORR,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14371     CONTINUE
        ELSE
          DO14381IRESAM=1,NRESAM
            CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO14383IJ=1,NS3
              TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
14383       CONTINUE
            CALL DPJBC2(
     1           TEMP,TEMPZ,NS2,
     1           ICASPL,ICENSO,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1           XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1           NHOR1,NHOR2,
     1           QP,XQP,NPERC,
     1           PPA0,PPA1,SHAPE1,SHAPE2,ACORR,
     1           IBUGG3,ISUBRO,IERROR)
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              IF(PPA1.LT.PPA1HT)NBELW2=NBELW2+1
              IF(SHAPE1.LT.SHA1HT)NBELW3=NBELW3+1
              TEMP6(IRESAM)=PPA0
              TEMP7(IRESAM)=PPA1
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=3.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=4.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE2,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=5.0
              CALL DPJBS4(ISET,NUMSET,J,J2,ACORR,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14381     CONTINUE
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO14395IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
14395     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO14398I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
14398     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
        ENDIF
C
        ILAST=ISETMX
        IF(NGRPV.GE.1)ILAST=ISETMX-1
        IF(NPERC.GT.0 .AND. ISET.EQ.ILAST)THEN
          IENDF4='OFF'
          IREWI4='ON'
          CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IENDF4,IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR DISTRIBUTIONS THAT ESTIMATE ONE SHAPE
C  PARAMETER VIA KS PLOT AND LOCATION AND SCALE PARAMETERS VIA
C  A PROBABILITY PLOT.
C
14410   CONTINUE
C
        NUMPAR=4
        NHOR1=IPPCAP(1)
        NHOR2=IPPCAP(2)
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
C
        IF(NPERC.GT.0 .AND.ISET.EQ.1)THEN
          IOUNI4=IST4NU
          IFILE4=IST4NA
          ISTAT4=IST4ST
          IFORM4=IST4FO
          IACCE4=IST4AC
          IPROT4=IST4PR
          ICURS4=IST4CS
          ISUBN0='JBS2'
          IERRF4='NO'
C
          IREWI4='ON'
          CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,
     1                IPROT4,ICURS4,
     1                IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
          IF(NGRPV.EQ.0)THEN
            IFORMT='(    E15.7)'
            IFORMZ='(    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(5:5),'(I1)')NPERC
              WRITE(IFORMZ(5:5),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(4:5),'(I2)')NPERC
              WRITE(IFORMZ(4:5),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(3:5),'(I3)')NPERC
              WRITE(IFORMZ(3:5),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.1)THEN
            IFORMT='(I8,1X,    E15.7)'
            IFORMZ='(9X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(11:11),'(I1)')NPERC
              WRITE(IFORMZ(8:8),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(10:11),'(I2)')NPERC
              WRITE(IFORMZ(7:8),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(9:11),'(I3)')NPERC
              WRITE(IFORMZ(7:8),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.2)THEN
            IFORMT='(I8,1X,I8,1X,    E15.7)'
            IFORMZ='(18X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(17:17),'(I1)')NPERC
              WRITE(IFORMZ(9:9),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(16:17),'(I2)')NPERC
              WRITE(IFORMZ(8:9),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(15:17),'(I3)')NPERC
              WRITE(IFORMZ(8:9),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ENDIF
          IF(NPERC.GT.0)THEN
            WRITE(IOUNI4,IFORMZ)(QP(JJ),JJ=1,NPERC)
          ENDIF
        ENDIF
C
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF((IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT') .OR.
     1     (IBOOPA.EQ.'PARA' .AND. ICENSO.NE.'ON'))THEN
          CALL DPJBKS(
     1         TEMP0,TEMPZ0,NS2,
     1         ICASPL,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1         XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1         NHOR1,IGEPDF,IADEDF,ILGADF,ISKNDF,KSLOC,KSSCAL,
     1         QP,XQP,NPERC,
     1         PPA0,PPA1,SHAPE1,AMINKS,
     1         IBUGG3,ISUBRO,IERROR)
          ICASRA='NULL'
          PPA0SV=PPA0HT
          PPA1SV=PPA1HT
          SHAPSV=SHAPHT
          IF(ICASPL.EQ.'WEKS')ICASRA='WEIB'
          IF(ICASPL.EQ.'LAKS')ICASRA='LAMB'
          IF(ICASPL.EQ.'LNKS')ICASRA='LOGN'
          IF(ICASPL.EQ.'TKS')ICASRA='T'
          IF(ICASPL.EQ.'CSKS')ICASRA='CHIS'
          IF(ICASPL.EQ.'CHKS')ICASRA='CHI'
          IF(ICASPL.EQ.'GAKS')ICASRA='GAMM'
          IF(ICASPL.EQ.'GAKS')ICASRA='GAMM'
          IF(ICASPL.EQ.'E2KS')ICASRA='EXV2'
          IF(ICASPL.EQ.'PAKS')ICASRA='PARE'
          IF(ICASPL.EQ.'P2KS')ICASRA='PAR2'
          IF(ICASPL.EQ.'TRKS')ICASRA='TRIA'
          IF(ICASPL.EQ.'WAKS')ICASRA='WALD'
          IF(ICASPL.EQ.'FLKS')ICASRA='FL'
          IF(ICASPL.EQ.'GEKS')ICASRA='GEP'
          IF(ICASPL.EQ.'PFKS')ICASRA='POWF'
          IF(ICASPL.EQ.'IWKS')ICASRA='IWEI'
          IF(ICASPL.EQ.'DWKS')ICASRA='DWEI'
          IF(ICASPL.EQ.'DGKS')ICASRA='DGAM'
          IF(ICASPL.EQ.'LGKS')ICASRA='LGAM'
          IF(ICASPL.EQ.'GIKS')ICASRA='IGAM'
          IF(ICASPL.EQ.'LDKS')ICASRA='LDEX'
          IF(ICASPL.EQ.'GVKS')ICASRA='GEVA'
          IF(ICASPL.EQ.'GZKS')ICASRA='GHLO'
          IF(ICASPL.EQ.'BRKS')ICASRA='BRAD'
          IF(ICASPL.EQ.'REKS')ICASRA='RECI'
          IF(ICASPL.EQ.'PNKS')ICASRA='PNOR'
          IF(ICASPL.EQ.'LLKS')ICASRA='LLOG'
          IF(ICASPL.EQ.'EEKS')ICASRA='GEEE'
          IF(ICASPL.EQ.'ERKS')ICASRA='ERRO'
          IF(ICASPL.EQ.'VMKS')ICASRA='VONM'
          IF(ICASPL.EQ.'WCKS')ICASRA='WRCA'
          IF(ICASPL.EQ.'SNKS')ICASRA='SKWN'
          IF(ICASPL.EQ.'GLKS')ICASRA='GLOG'
          IF(ICASPL.EQ.'SDKS')ICASRA='SKDE'
          IF(ICASPL.EQ.'ADKS')ICASRA='ASDE'
          IF(ICASPL.EQ.'MCKS')ICASRA='MCLE'
          NBELW1=0
          NBELW2=0
          NBELW3=0
        ENDIF
C
C  HANDLE BOOTSTRAP SAMPLE DIFFERENTLY FOR CENSORED AND UNCENSORED
C  DATA (CENSORED CASE HAS A PAIRED VARIABLE TO RESAMPLE)
C
        IF(ICENSO.EQ.'OFF')THEN
          DO14421IRESAM=1,NRESAM
            IF(IBOOPA.EQ.'PARA')THEN
              CALL DPJBRA(ICASRA,ISEED,MINMAX,
     1                    TEMP,NS2,
     1                    SHAPSV,SHAPE2,PPA0SV,PPA1SV,
     1                    IMAKDF,IGEODF,IBEIDF,IBEKDF,IGEPDF,IADEDF,
     1                    ILGADF,ISKNDF,IGLDDF,
     1                    IBUGG3,ISUBRO,IERROR)
            ELSE
              CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,
     1                    TEMP,NS3,ITEMP1,
     1                    TEMP4,IBUGG3,IERROR)
            ENDIF
            CALL DPJBKS(
     1           TEMP,TEMP4,NS2,
     1           ICASPL,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1           XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1           NHOR1,IGEPDF,IADEDF,ILGADF,ISKNDF,KSLOC,KSSCAL,
     1           QP,XQP,NPERC,
     1           PPA0,PPA1,SHAPE1,AMINKS,
     1           IBUGG3,ISUBRO,IERROR)
C
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              IF(PPA1.LT.PPA1HT)NBELW2=NBELW2+1
              IF(SHAPE1.LT.SHA1HT)NBELW3=NBELW3+1
              TEMP6(IRESAM)=PPA0
              TEMP7(IRESAM)=PPA1
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=3.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=4.0
              CALL DPJBS4(ISET,NUMSET,J,J2,AMINKS,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14421     CONTINUE
        ELSE
CCCCC     DO14431IRESAM=1,NRESAM
CCCCC       CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
CCCCC1                  TEMP4,IBUGG3,IERROR)
CCCCC       DO14433IJ=1,NS3
CCCCC         TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
14433       CONTINUE
CCCCC       CALL DPJBKS(
CCCCC1           TEMP,TEMPZ,NS2,
CCCCC1           ICASPL,IMETHD,IPPCDP,MAXNXT,MINMAX,
CCCCC1           XTEMP1,XTEMP2,XTEMP3,TEMP8,
CCCCC1           NHOR1,IGEPDF,IADEDF,ILGADF,ISKNDF,
CCCCC1           QP,XQP,NPERC,
CCCCC1           PPA0,PPA1,SHAPE1,ACORR,
CCCCC1           IBUGG3,ISUBRO,IERROR)
C
CCCCC       IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
CCCCC1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
CCCCC         IF(NGRPV.EQ.0)THEN
CCCCC           WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
CCCCC         ELSEIF(NGRPV.EQ.1)THEN
CCCCC           WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
CCCCC         ELSEIF(NGRPV.EQ.2)THEN
CCCCC           WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
CCCCC         ENDIF
CCCCC       ENDIF
C
CCCCC       IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
CCCCC         IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
CCCCC         IF(PPA1.LT.PPA1HT)NBELW2=NBELW2+1
CCCCC         IF(SHAPE1.LT.SHA1HT)NBELW3=NBELW3+1
CCCCC         TEMP6(IRESAM)=PPA0
CCCCC         TEMP7(IRESAM)=PPA1
CCCCC       ENDIF
CCCCC       IF(NGRPV.LE.1)THEN
CCCCC         TAGID=1.0
CCCCC         CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
CCCCC1                    Y2,X2,D2)
CCCCC         TAGID=2.0
CCCCC         CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
CCCCC1                    Y2,X2,D2)
CCCCC         TAGID=3.0
CCCCC         CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE1,TAGID,XIDTEM,
CCCCC1                    Y2,X2,D2)
CCCCC         TAGID=4.0
CCCCC         CALL DPJBS4(ISET,NUMSET,J,J2,ACORR,TAGID,XIDTEM,
CCCCC1                    Y2,X2,D2)
CCCCC       ELSE
CCCCC         CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
CCCCC1                    XIDTE2,Y2,X2,D2)
CCCCC       ENDIF
14431     CONTINUE
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO14445IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
14445     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO14448I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
14448     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
        ENDIF
C
        ILAST=ISETMX
        IF(NGRPV.GE.1)ILAST=ISETMX-1
        IF(NPERC.GT.0 .AND. ISET.EQ.ILAST)THEN
          IENDF4='OFF'
          IREWI4='ON'
          CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IENDF4,IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR DISTRIBUTIONS THAT ESTIMATE TWO SHAPE
C  PARAMETERS VIA KS PLOT AND LOCATION AND SCALE PARAMETERS VIA
C  A PROBABILITY PLOT.
C
14460   CONTINUE
C
        NUMPAR=4
        NHOR1=IPPCAP(1)
        NHOR2=IPPCAP(2)
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
C
        IF(NPERC.GT.0 .AND.ISET.EQ.1)THEN
          IOUNI4=IST4NU
          IFILE4=IST4NA
          ISTAT4=IST4ST
          IFORM4=IST4FO
          IACCE4=IST4AC
          IPROT4=IST4PR
          ICURS4=IST4CS
          ISUBN0='JBS2'
          IERRF4='NO'
C
          IREWI4='ON'
          CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,
     1                IPROT4,ICURS4,
     1                IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
          IF(NGRPV.EQ.0)THEN
            IFORMT='(    E15.7)'
            IFORMZ='(    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(5:5),'(I1)')NPERC
              WRITE(IFORMZ(5:5),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(4:5),'(I2)')NPERC
              WRITE(IFORMZ(4:5),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(3:5),'(I3)')NPERC
              WRITE(IFORMZ(3:5),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.1)THEN
            IFORMT='(I8,1X,    E15.7)'
            IFORMZ='(9X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(11:11),'(I1)')NPERC
              WRITE(IFORMZ(8:8),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(10:11),'(I2)')NPERC
              WRITE(IFORMZ(7:8),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(9:11),'(I3)')NPERC
              WRITE(IFORMZ(7:8),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.2)THEN
            IFORMT='(I8,1X,I8,1X,    E15.7)'
            IFORMZ='(18X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(17:17),'(I1)')NPERC
              WRITE(IFORMZ(9:9),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(16:17),'(I2)')NPERC
              WRITE(IFORMZ(8:9),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(15:17),'(I3)')NPERC
              WRITE(IFORMZ(8:9),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ENDIF
          IF(NPERC.GT.0)THEN
            WRITE(IOUNI4,IFORMZ)(QP(JJ),JJ=1,NPERC)
          ENDIF
        ENDIF
C
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF((IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT') .OR.
     1     (IBOOPA.EQ.'PARA' .AND. ICENSO.NE.'ON'))THEN
          CALL DPJBK2(
     1         TEMP0,TEMPZ0,NS2,
     1         ICASPL,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1         XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1         NHOR1,NHOR2,KSLOC,KSSCAL,
     1         QP,XQP,NPERC,
     1         PPA0,PPA1,SHAPE1,SHAPE2,AMINKS,
     1         IBUGG3,ISUBRO,IERROR)
          ICASRA='NULL'
          PPA0SV=PPA0HT
          PPA1SV=PPA1HT
          SHA1SV=SHA1HT
          SHA2SV=SHA2HT
          IF(ICASPL.EQ.'GHKS')ICASRA='GH  '
          IF(ICASPL.EQ.'FKS')ICASRA='F   '
          IF(ICASPL.EQ.'FNKS')ICASRA='FNRM'
          IF(ICASPL.EQ.'IGKS')ICASRA='IG  '
          IF(ICASPL.EQ.'BEKS')ICASRA='BETA'
          IF(ICASPL.EQ.'GGKS')ICASRA='GGD '
          NBELW1=0
          NBELW2=0
          NBELW3=0
        ENDIF
C
C  HANDLE BOOTSTRAP SAMPLE DIFFERENTLY FOR CENSORED AND UNCENSORED
C  DATA (CENSORED CASE HAS A PAIRED VARIABLE TO RESAMPLE)
C
        IF(ICENSO.EQ.'OFF')THEN
          DO14471IRESAM=1,NRESAM
            IF(IBOOPA.EQ.'PARA')THEN
              CALL DPJBRA(ICASRA,ISEED,MINMAX,
     1                    TEMP,NS2,
     1                    SHA1SV,SHA2SV,PPA0SV,PPA1SV,
     1                    IMAKDF,IGEODF,IBEIDF,IBEKDF,IGEPDF,IADEDF,
     1                    ILGADF,ISKNDF,IGLDDF,
     1                    IBUGG3,ISUBRO,IERROR)
            ELSE
              CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,
     1                  NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            ENDIF
            CALL DPJBK2(
     1           TEMP,TEMP4,NS2,
     1           ICASPL,IMETHD,IPPCDP,MAXNXT,MINMAX,
     1           XTEMP1,XTEMP2,XTEMP3,TEMP8,
     1           NHOR1,NHOR2,KSLOC,KSSCAL,
     1           QP,XQP,NPERC,
     1           PPA0,PPA1,SHAPE1,SHAPE2,AMINKS,
     1           IBUGG3,ISUBRO,IERROR)
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              IF(PPA1.LT.PPA1HT)NBELW2=NBELW2+1
              IF(SHAPE1.LT.SHA1HT)NBELW3=NBELW3+1
              TEMP6(IRESAM)=PPA0
              TEMP7(IRESAM)=PPA1
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=3.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE1,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=4.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE2,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=5.0
              CALL DPJBS4(ISET,NUMSET,J,J2,AMINKS,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14471     CONTINUE
        ELSE
CCCCC     DO14481IRESAM=1,NRESAM
CCCCC       CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
CCCCC1                  TEMP4,IBUGG3,IERROR)
CCCCC       DO14483IJ=1,NS3
CCCCC         TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
14483       CONTINUE
CCCCC       CALL DPJBK2(
CCCCC1           TEMP,TEMPZ,NS2,
CCCCC1           ICASPL,IMETHD,IPPCDP,MAXNXT,MINMAX,
CCCCC1           XTEMP1,XTEMP2,XTEMP3,TEMP8,
CCCCC1           NHOR1,NHOR2,KSLOC,KSSCAL,
CCCCC1           QP,XQP,NPERC,
CCCCC1           PPA0,PPA1,SHAPE1,SHAPE2,ACORR,
CCCCC1           IBUGG3,ISUBRO,IERROR)
C
CCCCC       IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
CCCCC1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
CCCCC         IF(NGRPV.EQ.0)THEN
CCCCC           WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
CCCCC         ELSEIF(NGRPV.EQ.1)THEN
CCCCC           WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
CCCCC         ELSEIF(NGRPV.EQ.2)THEN
CCCCC           WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
CCCCC         ENDIF
CCCCC       ENDIF
C
CCCCC       IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
CCCCC         IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
CCCCC         IF(PPA1.LT.PPA1HT)NBELW2=NBELW2+1
CCCCC         IF(SHAPE1.LT.SHA1HT)NBELW3=NBELW3+1
CCCCC         TEMP6(IRESAM)=PPA0
CCCCC         TEMP7(IRESAM)=PPA1
CCCCC       ENDIF
CCCCC       IF(NGRPV.LE.1)THEN
CCCCC         TAGID=1.0
CCCCC         CALL DPJBS4(ISET,NUMSET,J,J2,PPA0,TAGID,XIDTEM,
CCCCC1                    Y2,X2,D2)
CCCCC         TAGID=2.0
CCCCC         CALL DPJBS4(ISET,NUMSET,J,J2,PPA1,TAGID,XIDTEM,
CCCCC1                    Y2,X2,D2)
CCCCC         TAGID=3.0
CCCCC         CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE1,TAGID,XIDTEM,
CCCCC1                    Y2,X2,D2)
CCCCC         TAGID=4.0
CCCCC         CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE2,TAGID,XIDTEM,
CCCCC1                    Y2,X2,D2)
CCCCC         TAGID=5.0
CCCCC         CALL DPJBS4(ISET,NUMSET,J,J2,ACORR,TAGID,XIDTEM,
CCCCC1                    Y2,X2,D2)
CCCCC       ELSE
CCCCC         CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,PPA0,XIDTEM,
CCCCC1                    XIDTE2,Y2,X2,D2)
CCCCC       ENDIF
14481     CONTINUE
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO14495IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
14495     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO14498I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
14498     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
        ENDIF
C
        ILAST=ISETMX
        IF(NGRPV.GE.1)ILAST=ISETMX-1
        IF(NPERC.GT.0 .AND. ISET.EQ.ILAST)THEN
          IENDF4='OFF'
          IREWI4='ON'
          CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IENDF4,IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR DISTRIBUTIONS THAT ESTIMATE LOCATION AND
C  SCALE PARAMETERS VIA MAXIMUM LIKELIHOOD.
C
14710   CONTINUE
C
        NUMPAR=2
        IF(NPERC.GT.0 .AND.ISET.EQ.1)THEN
          IOUNI4=IST4NU
          IFILE4=IST4NA
          ISTAT4=IST4ST
          IFORM4=IST4FO
          IACCE4=IST4AC
          IPROT4=IST4PR
          ICURS4=IST4CS
          ISUBN0='JBS2'
          IERRF4='NO'
C
          IREWI4='ON'
          CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,
     1                IPROT4,ICURS4,
     1                IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
          IF(NGRPV.EQ.0)THEN
            IFORMT='(    E15.7)'
            IFORMZ='(    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(5:5),'(I1)')NPERC
              WRITE(IFORMZ(5:5),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(4:5),'(I2)')NPERC
              WRITE(IFORMZ(4:5),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(3:5),'(I3)')NPERC
              WRITE(IFORMZ(3:5),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.1)THEN
            IFORMT='(I8,1X,    E15.7)'
            IFORMZ='(9X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(11:11),'(I1)')NPERC
              WRITE(IFORMZ(8:8),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(10:11),'(I2)')NPERC
              WRITE(IFORMZ(7:8),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(9:11),'(I3)')NPERC
              WRITE(IFORMZ(7:8),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.2)THEN
            IFORMT='(I8,1X,I8,1X,    E15.7)'
            IFORMZ='(18X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(17:17),'(I1)')NPERC
              WRITE(IFORMZ(9:9),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(16:17),'(I2)')NPERC
              WRITE(IFORMZ(8:9),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(15:17),'(I3)')NPERC
              WRITE(IFORMZ(8:9),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ENDIF
          IF(NPERC.GT.0)THEN
            WRITE(IOUNI4,IFORMZ)(QP(JJ),JJ=1,NPERC)
          ENDIF
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF((IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT') .OR.
     1     (IBOOPA.EQ.'PARA' .AND. ICENSO.NE.'ON'))THEN
          CALL DPJBML(TEMP,TEMP4,NS2,
     1                ICASPL,ICENSO,MAXNXT,MINMAX,
     1                XTEMP1,XTEMP2,
     1                DTEMP1,
     1                ALOCTH,SCALTH,
     1                QP,XQP,NP,
     1                IBUGG3,ISUBRO,IERROR)
          ICASRA='NULL'
          ALOCSV=ALOCTH
          SCALSV=SCALTH
          IF(ICASPL.EQ.'NOML')ICASRA='NORM'
          IF(ICASPL.EQ.'UNML')ICASRA='UNIF'
          IF(ICASPL.EQ.'LOML')ICASRA='LOGI'
          IF(ICASPL.EQ.'CAML')ICASRA='CAUC'
          IF(ICASPL.EQ.'LAML')ICASRA='DOUB'
          IF(ICASPL.EQ.'EXML')ICASRA='EXPO'
          IF(ICASPL.EQ.'GUML')ICASRA='EXV1'
          IF(ICASPL.EQ.'RAML')ICASRA='RAYL'
          IF(ICASPL.EQ.'FNML')ICASRA='FNRM'
          IF(ICASPL.EQ.'MAML')ICASRA='MAXW'
          NBELW1=0
          NBELW2=0
        ENDIF
C
C  HANDLE BOOTSTRAP SAMPLE DIFFERENTLY FOR CENSORED AND UNCENSORED
C  DATA (CENSORED CASE HAS A PAIRED VARIABLE TO RESAMPLE)
C
        IF(ICENSO.EQ.'OFF')THEN
          DO14761IRESAM=1,NRESAM
            IF(IBOOPA.EQ.'PARA')THEN
              CALL DPJBRA(ICASRA,ISEED,MINMAX,
     1                    TEMP,NS2,
     1                    SHAPE1,SHAPE2,ALOCTH,SCALTH,
     1                    IMAKDF,IGEODF,IBEIDF,IBEKDF,IGEPDF,IADEDF,
     1                    ILGADF,ISKNDF,IGLDDF,
     1                    IBUGG3,ISUBRO,IERROR)
            ELSE
              CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,
     1                    NS3,ITEMP1,
     1                    TEMP4,IBUGG3,IERROR)
            ENDIF
            IF(IRESAM.EQ.1 .AND.
     1         (IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBS2'))THEN
               DO14762II=1,NS2
                 WRITE(ICOUT,14763)II,TEMP(II)
14763            FORMAT('II,TEMP(II) = ',I8,G15.7)
                 CALL DPWRST('XXX','BUG ')
14762          CONTINUE
            ENDIF
            CALL DPJBML(TEMP,TEMP4,NS2,
     1                  ICASPL,ICENSO,MAXNXT,MINMAX,
     1                  XTEMP1,XTEMP2,
     1                  DTEMP1,
     1                  ALOC,SCALE,
     1                  QP,XQP,NPERC,
     1                  IBUGG3,ISUBRO,IERROR)
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              TEMP6(IRESAM)=ALOC
              TEMP7(IRESAM)=SCALE
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,ALOC,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SCALE,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,ALOC,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14761     CONTINUE
        ELSE
          DO14771IRESAM=1,NRESAM
            CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO14773IJ=1,NS3
              TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
14773       CONTINUE
            CALL DPJBML(TEMP,TEMPZ,NS2,
     1                  ICASPL,ICENSO,MAXNXT,MINMAX,
     1                  XTEMP1,XTEMP2,
     1                  DTEMP1,
     1                  ALOC,SCALE,
     1                  QP,XQP,NPERC,
     1                  IBUGG3,ISUBRO,IERROR)
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(ALOC.LT.ALOCTH)NBELW1=NBELW1+1
              TEMP6(IRESAM)=ALOC
              TEMP7(IRESAM)=SCALE
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,ALOC,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SCALE,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,ALOC,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14771     CONTINUE
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO14775IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
14775     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO14765I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
14765     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
        ENDIF
C
        ILAST=ISETMX
        IF(NGRPV.GE.1)ILAST=ISETMX-1
        IF(NPERC.GT.0 .AND. ISET.EQ.ILAST)THEN
          IENDF4='OFF'
          IREWI4='ON'
          CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IENDF4,IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR DISTRIBUTIONS THAT ESTIMATE ONE SHAPE AND
C  THE SCALE PARAMETERS VIA MAXIMUM LIKELIHOOD.
C
14810   CONTINUE
C
        NUMPAR=2
        IF(NPERC.GT.0 .AND.ISET.EQ.1)THEN
          IOUNI4=IST4NU
          IFILE4=IST4NA
          ISTAT4=IST4ST
          IFORM4=IST4FO
          IACCE4=IST4AC
          IPROT4=IST4PR
          ICURS4=IST4CS
          ISUBN0='JBS2'
          IERRF4='NO'
C
          IREWI4='ON'
          CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,
     1                IPROT4,ICURS4,
     1                IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
          IF(NGRPV.EQ.0)THEN
            IFORMT='(    E15.7)'
            IFORMZ='(    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(5:5),'(I1)')NPERC
              WRITE(IFORMZ(5:5),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(4:5),'(I2)')NPERC
              WRITE(IFORMZ(4:5),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(3:5),'(I3)')NPERC
              WRITE(IFORMZ(3:5),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.1)THEN
            IFORMT='(I8,1X,    E15.7)'
            IFORMZ='(9X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(11:11),'(I1)')NPERC
              WRITE(IFORMZ(8:8),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(10:11),'(I2)')NPERC
              WRITE(IFORMZ(7:8),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(9:11),'(I3)')NPERC
              WRITE(IFORMZ(7:8),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.2)THEN
            IFORMT='(I8,1X,I8,1X,    E15.7)'
            IFORMZ='(18X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(17:17),'(I1)')NPERC
              WRITE(IFORMZ(9:9),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(16:17),'(I2)')NPERC
              WRITE(IFORMZ(8:9),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(15:17),'(I3)')NPERC
              WRITE(IFORMZ(8:9),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ENDIF
          IF(NPERC.GT.0)THEN
            WRITE(IOUNI4,IFORMZ)(QP(JJ),JJ=1,NPERC)
          ENDIF
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF((IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT') .OR.
     1     (IBOOPA.EQ.'PARA' .AND. ICENSO.NE.'ON'))THEN
          CALL DPJBM2(TEMP,TEMP4,NS2,
     1                ICASPL,ICENSO,MAXNXT,MINMAX,IGEPDF,
     1                XTEMP1,XTEMP2,
     1                DTEMP1,
     1                SCALTH,SHAPTH,
     1                QP,XQP,NP,
     1                IPOTTO,
     1                IBUGG3,ISUBRO,IERROR)
          ICASRA='NULL'
          ALOCSV=0.0
          SCALSV=SCALTH
          SHAPSV=SHAPTH
          IF(ICASPL.EQ.'WEML')ICASRA='WEIB'
          IF(ICASPL.EQ.'GAML')ICASRA='GAMM'
          IF(ICASPL.EQ.'LNML')ICASRA='LOGN'
          IF(ICASPL.EQ.'FLML')ICASRA='FL  '
          IF(ICASPL.EQ.'EEML')ICASRA='GEEE'
          IF(ICASPL.EQ.'BEML')ICASRA='BETA'
          IF(ICASPL.EQ.'IGML')ICASRA='IG  '
          IF(ICASPL.EQ.'PAML')ICASRA='PARE'
          IF(ICASPL.EQ.'GEML')ICASRA='GPAR'
          IF(ICASPL.EQ.'GEMO')ICASRA='GPAR'
          IF(ICASPL.EQ.'GEDE')ICASRA='GPAR'
          IF(ICASPL.EQ.'GECM')ICASRA='GPAR'
          IF(ICASPL.EQ.'FRML')ICASRA='FREC'
          IF(ICASPL.EQ.'IWML')ICASRA='IWEI'
          NBELW1=0
          NBELW2=0
        ENDIF
C
C  HANDLE BOOTSTRAP SAMPLE DIFFERENTLY FOR CENSORED AND UNCENSORED
C  DATA (CENSORED CASE HAS A PAIRED VARIABLE TO RESAMPLE)
C
        IF(ICENSO.EQ.'OFF')THEN
          DO14861IRESAM=1,NRESAM
            IF(IBOOPA.EQ.'PARA')THEN
              CALL DPJBRA(ICASRA,ISEED,MINMAX,
     1                    TEMP,NS2,
     1                    SHAPSV,SHAPE2,ALOCSV,SCALSV,
     1                    IMAKDF,IGEODF,IBEIDF,IBEKDF,IGEPDF,IADEDF,
     1                    ILGADF,ISKNDF,IGLDDF,
     1                    IBUGG3,ISUBRO,IERROR)
            ELSE
              CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,
     1                  NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            ENDIF
            IF(IRESAM.EQ.1 .AND.
     1         (IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBS2'))THEN
               DO14862II=1,NS2
                 WRITE(ICOUT,14863)II,TEMP(II)
14863            FORMAT('II,TEMP(II) = ',I8,G15.7)
                 CALL DPWRST('XXX','BUG ')
14862          CONTINUE
            ENDIF
            CALL DPJBM2(TEMP,TEMP4,NS2,
     1                  ICASPL,ICENSO,MAXNXT,MINMAX,IGEPDF,
     1                  XTEMP1,XTEMP2,
     1                  DTEMP1,
     1                  SCALE,SHAPE,
     1                  QP,XQP,NPERC,
     1                  IPOTTO,
     1                  IBUGG3,ISUBRO,IERROR)
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
              TEMP6(IRESAM)=SCALE
              TEMP7(IRESAM)=SHAPE
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SCALE,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,ALOC,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14861     CONTINUE
        ELSE
          DO14871IRESAM=1,NRESAM
            CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO14873IJ=1,NS3
              TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
14873       CONTINUE
            CALL DPJBM2(TEMP,TEMPZ,NS2,
     1                  ICASPL,ICENSO,MAXNXT,MINMAX,IGEPDF,
     1                  XTEMP1,XTEMP2,
     1                  DTEMP1,
     1                  SCALE,SHAPE,
     1                  QP,XQP,NPERC,
     1                  IPOTTO,
     1                  IBUGG3,ISUBRO,IERROR)
C
            IF((NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
              IF(NGRPV.EQ.0)THEN
                WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.1)THEN
                WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
              ELSEIF(NGRPV.EQ.2)THEN
                WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
              ENDIF
            ENDIF
C
            IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
              IF(ALOC.LT.ALOCTH)NBELW1=NBELW1+1
              TEMP6(IRESAM)=SCALE
              TEMP7(IRESAM)=SHAPE
            ENDIF
            IF(NGRPV.LE.1)THEN
              TAGID=1.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SCALE,TAGID,XIDTEM,
     1                    Y2,X2,D2)
              TAGID=2.0
              CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE,TAGID,XIDTEM,
     1                    Y2,X2,D2)
            ELSE
              CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,ALOC,XIDTEM,
     1                    XIDTE2,Y2,X2,D2)
            ENDIF
14871     CONTINUE
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO14875IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
14875     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO14865I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
14865     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
        ENDIF
C
        ILAST=ISETMX
        IF(NGRPV.GE.1)ILAST=ISETMX-1
        IF(NPERC.GT.0 .AND. ISET.EQ.ILAST)THEN
          IENDF4='OFF'
          IREWI4='ON'
          CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IENDF4,IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
        ENDIF
C
        GOTO79000
C
C  JACKNIFE/BOOTSTRAP FOR DISTRIBUTIONS THAT ESTIMATE ONE SHAPE AND
C  THE LOCATION AND SCALE PARAMETERS VIA MAXIMUM LIKELIHOOD.
C
C  NOTE 3/2006: ASYMMETRIC LAPLACE CAN HAVE UNDEFINED MAXIMUM
C               LIKELIHOOD ESTIMATE.
C
C               1) IF FULL SAMPLE MLE IS UNDEFINED, PRINT
C                  ERROR MESSAGE AND SKIP BOOTSTRAP.
C
C               2) FOR BOOTSTRAP SAMPLES, KEEP TRACK OF HOW
C                  MANY SAMPLES ARE UNDEFINED.  IF THIS POSITIVE,
C                  PRINT HOW MANY SAMPLES ARE UNDEFINED.
C
14910   CONTINUE
C
        NUMPAR=3
        IF(NPERC.GT.0 .AND.ISET.EQ.1)THEN
          IOUNI4=IST4NU
          IFILE4=IST4NA
          ISTAT4=IST4ST
          IFORM4=IST4FO
          IACCE4=IST4AC
          IPROT4=IST4PR
          ICURS4=IST4CS
          ISUBN0='JBS2'
          IERRF4='NO'
C
          IREWI4='ON'
          CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,
     1                IPROT4,ICURS4,
     1                IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
          IF(NGRPV.EQ.0)THEN
            IFORMT='(    E15.7)'
            IFORMZ='(    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(5:5),'(I1)')NPERC
              WRITE(IFORMZ(5:5),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(4:5),'(I2)')NPERC
              WRITE(IFORMZ(4:5),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(3:5),'(I3)')NPERC
              WRITE(IFORMZ(3:5),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.1)THEN
            IFORMT='(I8,1X,    E15.7)'
            IFORMZ='(9X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(11:11),'(I1)')NPERC
              WRITE(IFORMZ(8:8),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(10:11),'(I2)')NPERC
              WRITE(IFORMZ(7:8),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(9:11),'(I3)')NPERC
              WRITE(IFORMZ(7:8),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ELSEIF(NGRPV.EQ.2)THEN
            IFORMT='(I8,1X,I8,1X,    E15.7)'
            IFORMZ='(18X,    F15.3)'
            IF(NPERC.LE.9)THEN
              WRITE(IFORMT(17:17),'(I1)')NPERC
              WRITE(IFORMZ(9:9),'(I1)')NPERC
            ELSEIF(NPERC.LE.99)THEN
              WRITE(IFORMT(16:17),'(I2)')NPERC
              WRITE(IFORMZ(8:9),'(I2)')NPERC
            ELSEIF(NPERC.LE.999)THEN
              WRITE(IFORMT(15:17),'(I3)')NPERC
              WRITE(IFORMZ(8:9),'(I3)')NPERC
            ELSE
              NPERC=0
            ENDIF
          ENDIF
          IF(NPERC.GT.0)THEN
            WRITE(IOUNI4,IFORMZ)(QP(JJ),JJ=1,NPERC)
          ENDIF
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE FULL-SAMPLE STATISTIC.
C
        IF((IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT') .OR.
     1     (IBOOPA.EQ.'PARA' .AND. ICENSO.NE.'ON'))THEN
          IUDFLG=0
          CALL DPJBM4(TEMP,TEMP4,NS2,
     1                ICASPL,ICENSO,MAXNXT,MINMAX,
     1                XTEMP1,XTEMP2,
     1                DTEMP1,DTEMP2,DTEMP3,DTEMP4,
     1                IADEDF,
     1                ALOCTH,SCALTH,SHAPTH,
     1                QP,XQP,NP,
     1                IUDFLG,
     1                IBUGG3,ISUBRO,IERROR)
C
          IF(IUDFLG.EQ.1)THEN
            WRITE(ICOUT,14851)
14851       FORMAT('***** ERROR FROM BOOTSTRAP/JACKNIFE PLOT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14853)
14853       FORMAT('      FULL SAMPLE MAXIMUM LIKELIHOOD IS ',
     1             'UNDEFINED FOR')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14854)
14854       FORMAT('      ASYMMETRIC LAPLACE DISTRIBUTION.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
C
          ICASRA='NULL'
          ALOCSV=ALOCTH
          SCALSV=SCALTH
          SHAPSV=SHAPTH
          IF(ICASPL.EQ.'ADML')ICASRA='ASDE'
          NBELW1=0
          NBELW2=0
          NBELW3=0
        ELSE
          IUDFLG=0
          CALL DPJBM4(TEMP,TEMP4,NS2,
     1                ICASPL,ICENSO,MAXNXT,MINMAX,
     1                XTEMP1,XTEMP2,
     1                DTEMP1,DTEMP2,DTEMP3,DTEMP4,
     1                IADEDF,
     1                ALOCTH,SCALTH,SHAPTH,
     1                QP,XQP,NP,
     1                IUDFLG,
     1                IBUGG3,ISUBRO,IERROR)
C
          IF(IUDFLG.EQ.1)THEN
            WRITE(ICOUT,14851)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14853)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,14854)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
        ENDIF
C
C  HANDLE BOOTSTRAP SAMPLE DIFFERENTLY FOR CENSORED AND UNCENSORED
C  DATA (CENSORED CASE HAS A PAIRED VARIABLE TO RESAMPLE)
C
        IUDCNT=0
        IF(ICENSO.EQ.'OFF')THEN
          DO14961IRESAM=1,NRESAM
            IF(IBOOPA.EQ.'PARA')THEN
              CALL DPJBRA(ICASRA,ISEED,MINMAX,
     1                    TEMP,NS2,
     1                    SHAPSV,SHAPE2,ALOCSV,SCALSV,
     1                    IMAKDF,IGEODF,IBEIDF,IBEKDF,IGEPDF,IADEDF,
     1                    ILGADF,ISKNDF,IGLDDF,
     1                    IBUGG3,ISUBRO,IERROR)
            ELSE
              CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,
     1                    NS3,ITEMP1,
     1                    TEMP4,IBUGG3,IERROR)
            ENDIF
            IF(IRESAM.EQ.1 .AND.
     1         (IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBS2'))THEN
               DO14962II=1,NS2
                 WRITE(ICOUT,14963)II,TEMP(II)
14963            FORMAT('II,TEMP(II) = ',I8,G15.7)
                 CALL DPWRST('XXX','BUG ')
14962          CONTINUE
            ENDIF
            CALL DPJBM4(TEMP,TEMP4,NS2,
     1                  ICASPL,ICENSO,MAXNXT,MINMAX,
     1                  XTEMP1,XTEMP2,
     1                  DTEMP1,DTEMP2,DTEMP3,DTEMP4,
     1                  IADEDF,
     1                  ALOC,SCALE,SHAPE,
     1                  QP,XQP,NPERC,
     1                  IUDFLG,
     1                  IBUGG3,ISUBRO,IERROR)
            IF(IUDFLG.EQ.1)THEN
              NREJ=NREJ+1
            ENDIF
C
            IF(IUDFLG.EQ.0)THEN
              IF(
     1         (NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
                IF(NGRPV.EQ.0)THEN
                  WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
                ELSEIF(NGRPV.EQ.1)THEN
                  WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
                ELSEIF(NGRPV.EQ.2)THEN
                  WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
                ENDIF
              ENDIF
C
              IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
                IF(PPA0.LT.PPA0HT)NBELW1=NBELW1+1
                TEMP6(IRESAM)=SCALE
                TEMP7(IRESAM)=SHAPE
              ENDIF
              IF(NGRPV.LE.1)THEN
                TAGID=1.0
                CALL DPJBS4(ISET,NUMSET,J,J2,ALOC,TAGID,XIDTEM,
     1                      Y2,X2,D2)
                TAGID=2.0
                CALL DPJBS4(ISET,NUMSET,J,J2,SCALE,TAGID,XIDTEM,
     1                      Y2,X2,D2)
                TAGID=3.0
                CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE,TAGID,XIDTEM,
     1                      Y2,X2,D2)
              ELSE
                CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,ALOC,XIDTEM,
     1                      XIDTE2,Y2,X2,D2)
              ENDIF
            ENDIF
14961     CONTINUE
        ELSE
          DO14971IRESAM=1,NRESAM
            CALL DPJBS3(TEMP0,NS2,ICASJB,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            DO14973IJ=1,NS3
              TEMPZ(IJ)=TEMPZ0(ITEMP1(IJ))
14973       CONTINUE
            IUDFLG=0
            CALL DPJBM4(TEMP,TEMPZ,NS2,
     1                  ICASPL,ICENSO,MAXNXT,MINMAX,
     1                  XTEMP1,XTEMP2,
     1                  DTEMP1,DTEMP2,DTEMP3,DTEMP4,
     1                  IADEDF,
     1                  ALOC,SCALE,SHAPE,
     1                  QP,XQP,NPERC,
     1                  IUDFLG,
     1                  IBUGG3,ISUBRO,IERROR)
C
            IF(IUDFLG.EQ.1)THEN
              NREJ=NREJ+1
            ENDIF
C
            IF(IUDFLG.EQ.0)THEN
              IF(
     1         (NGRPV.GE.1 .AND. NPERC.GT.0 .AND. ISET.LE.NUMSET) .OR.
     1         (NPERC.GT.0 .AND. NGRPV.EQ.0 .AND. ISET.EQ.1))THEN
                IF(NGRPV.EQ.0)THEN
                  WRITE(IOUNI4,IFORMT)(XQP(JJ),JJ=1,NPERC)
                ELSEIF(NGRPV.EQ.1)THEN
                  WRITE(IOUNI4,IFORMT)ISET,(XQP(JJ),JJ=1,NPERC)
                ELSEIF(NGRPV.EQ.2)THEN
                  WRITE(IOUNI4,IFORMT)ISET1,ISET2,(XQP(JJ),JJ=1,NPERC)
                ENDIF
              ENDIF
C
              IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
                IF(ALOC.LT.ALOCTH)NBELW1=NBELW1+1
                TEMP6(IRESAM)=SCALE
                TEMP7(IRESAM)=SHAPE
              ENDIF
              IF(NGRPV.LE.1)THEN
                TAGID=1.0
                CALL DPJBS4(ISET,NUMSET,J,J2,ALOC,TAGID,XIDTEM,
     1                      Y2,X2,D2)
                TAGID=2.0
                CALL DPJBS4(ISET,NUMSET,J,J2,SCALE,TAGID,XIDTEM,
     1                      Y2,X2,D2)
                TAGID=3.0
                CALL DPJBS4(ISET,NUMSET,J,J2,SHAPE,TAGID,XIDTEM,
     1                      Y2,X2,D2)
              ELSE
                CALL DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,ALOC,XIDTEM,
     1                      XIDTE2,Y2,X2,D2)
              ENDIF
            ENDIF
14971     CONTINUE
        ENDIF
C
        IF(NREJ.GT.0)THEN
          WRITE(ICOUT,54872)
54872     FORMAT('***** WARNING FROM BOOTSTRAP/JACKNIFE PLOT')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,54873)NREJ,NRESAM
54873     FORMAT('      ',I8,' OF ',I8,' BOOTSTRAP SAMPLES')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,54874)
54874     FORMAT('      RESULTED IN UNDEFINED MAXIMUM LIKELIHOOD',
     1           'ESTIMATES.')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
C  FOR BCA CONFIDENCE INTERVAL, COMPUTE:
C  1) Z0HAT
C  2) JACKNIFE ESTIMATES
C
        IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT' .AND. NREJ.LE.0)THEN
          CALL NORPPF(REAL(NBELOW)/REAL(NRESAM),Z0HAT)
          ICASZZ='JACK'
          DO14975IRESAM=1,NS2
            CALL DPJBS3(TEMP0,NS2,ICASZZ,IRESAM,ISEED,TEMP,NS3,ITEMP1,
     1                  TEMP4,IBUGG3,IERROR)
            CALL CMPSTA(
     1           TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1           MAXNXT,NS3,NS3,NUMV2,ICASPL,
     1           ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1           IQUAME,IQUASE,
     1           RIGHT,
     1           ISUBRO,IBUGG3,IERROR)
            TEMPTH(IRESAM)=RIGHT
14975     CONTINUE
          CALL MEAN(TEMPTH,NS2,IWRITE,THETDT,IBUGG3,IERROR)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DTHETM=DBLE(THETDT)
          DO14965I=1,NS2
            DTERM1=DBLE(TEMPTH(I))
            DSUM1 = DSUM1 + (DTHETM - DTERM1)**3
            DSUM2 = DSUM2 + (DTHETM - DTERM1)**2
14965     CONTINUE
          DTERM2 = DSUM1/(6.0D0*(DSUM2**1.5))
          A0HAT=REAL(DTERM2)
          CALL NORPPF(ALPHA/2.0,ALOWSL)
          CALL NORPPF(1.0 - ALPHA/2.0,AUPPSL)
          TERM1=Z0HAT + (Z0HAT + AUPPSL)/(1.0 - A0HAT*(Z0HAT+AUPPSL))
          CALL NORCDF(TERM1,ALPHA2)
          TERM1=Z0HAT + (Z0HAT + ALOWSL)/(1.0 - A0HAT*(Z0HAT+ALOWSL))
          CALL NORCDF(TERM1,ALPHA1)
          CALL PERCEN(100.0*ALPHA1,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCAUL,IBUGG3,IERROR)
          CALL PERCEN(100.0*ALPHA2,TEMP6,NS2,IWRITE,TEMP4,MAXNXT,
     1                BCALL,IBUGG3,IERROR)
          IF(NGRPV.EQ.1)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2,
     1                         XIDTEM(ISET1),XIDTE2(ISET2)
          ELSE
            WRITE(IOUNI3,11368)BCALL,BCAUL,Z0HAT,A0HAT,ALPHA1,ALPHA2
          ENDIF
        ENDIF
C
        ILAST=ISETMX
        IF(NGRPV.GE.1)ILAST=ISETMX-1
        IF(NPERC.GT.0 .AND. ISET.EQ.ILAST)THEN
          IENDF4='OFF'
          IREWI4='ON'
          CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IENDF4,IREWI4,ISUBN0,IERRF4,IBUGG3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
        ENDIF
C
        GOTO79000
C
79000   CONTINUE
C
C               ************************************************
C               **   STEP 19--                                **
C               **   FOR GROUPED DATA, WRITE GROUP-ID, MEAN,  **
C               **   MEDIAN, B025, B975, B05, B90, B005, B995 **
C               **   TO DPST1F.DAT.                           **
C               ************************************************
C
CCCCC JANUARY 2005.  FOR UNGROUPED DATA, WRITE BOOTSTRAP ESTIMATES
CCCCC                TO FILE.  ALSO, ACCOMODATE CASE WHERE MORE
CCCCC                THAN ONE PARAMETER IS ESTIMATED.
C
        IF(NGRPV.EQ.1)THEN
          IF(NUMPAR.LE.1)THEN
            IF(ISET.LE.NUMSET)THEN
              ICOUNT=0
              DO19010I=1,J
                IF(INT(D2(I)+0.01).EQ.ISET)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  WRITE(IOUNI1,19012)ISET,Y2(I)
                ENDIF
19010         CONTINUE
19012         FORMAT(I8,E15.7)
            ENDIF
          ELSEIF(NUMPAR.EQ.2)THEN
            IF(ISET.LE.NUMSET)THEN
              ICOUNT=0
              DO19013I=1,J,2
                IF(INT(D2(I)+0.01).EQ.ISET)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+1)
                  WRITE(IOUNI1,19014)ISET,Y2(I),Y2(I+1)
                ENDIF
19013         CONTINUE
19014         FORMAT(I8,2E15.7)
            ENDIF
          ELSEIF(NUMPAR.EQ.3)THEN
            IF(ISET.LE.NUMSET)THEN
              ICOUNT=0
              DO19016I=1,J,3
                IF(INT(D2(I)+0.01).EQ.ISET)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+1)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+2)
                  WRITE(IOUNI1,19017)ISET,Y2(I),Y2(I+1),Y2(I+2)
                ENDIF
19016         CONTINUE
19017         FORMAT(I8,3E15.7)
            ENDIF
          ELSEIF(NUMPAR.EQ.4)THEN
            IF(ISET.LE.NUMSET)THEN
              ICOUNT=0
              DO19018I=1,J,4
                IF(INT(D2(I)+0.01).EQ.ISET)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+1)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+2)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+3)
                  WRITE(IOUNI1,19019)ISET,Y2(I),Y2(I+1),Y2(I+2),Y2(I+3)
                ENDIF
19018         CONTINUE
19019         FORMAT(I8,4E15.7)
            ENDIF
          ELSEIF(NUMPAR.EQ.5)THEN
            IF(ISET.LE.NUMSET)THEN
              ICOUNT=0
              DO19118I=1,J,5
                IF(INT(D2(I)+0.01).EQ.ISET)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+1)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+2)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+3)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+4)
                  WRITE(IOUNI1,19119)ISET,Y2(I),Y2(I+1),Y2(I+2),
     1                               Y2(I+3),Y2(I+4)
                ENDIF
19118         CONTINUE
19119         FORMAT(I8,5E15.7)
            ENDIF
          ENDIF
        ELSEIF(NGRPV.EQ.2)THEN
          IF(NUMPAR.EQ.1)THEN
            IF(ISET.LE.NUMSET)THEN
              ITAG=(ISET1-1)*NUMSE2 + ISET2
              ICOUNT=0
              DO19020I=1,J
                IF(INT(D2(I)+0.01).EQ.ITAG)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  WRITE(IOUNI1,19024)ISET1,ISET2,Y2(I)
                ENDIF
19020         CONTINUE
19024         FORMAT(2I8,E15.7)
            ENDIF
          ELSEIF(NUMPAR.EQ.2)THEN
            IF(ISET.LE.NUMSET)THEN
              ITAG=(ISET1-1)*NUMSE2 + ISET2
              ICOUNT=0
              DO19030I=1,J,2
                IF(INT(D2(I)+0.01).EQ.ITAG)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+1)
                  WRITE(IOUNI1,19034)ISET1,ISET2,Y2(I),Y2(I+1)
                ENDIF
19030         CONTINUE
19034         FORMAT(2I8,2E15.7)
            ENDIF
          ELSEIF(NUMPAR.EQ.3)THEN
            IF(ISET.LE.NUMSET)THEN
              ITAG=(ISET1-1)*NUMSE2 + ISET2
              ICOUNT=0
              DO19040I=1,J,3
                IF(INT(D2(I)+0.01).EQ.ITAG)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+1)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+2)
                  WRITE(IOUNI1,19044)ISET1,ISET2,Y2(I),Y2(I+1),Y2(I+2)
                ENDIF
19040         CONTINUE
19044         FORMAT(2I8,3E15.7)
            ENDIF
          ELSEIF(NUMPAR.EQ.4)THEN
            IF(ISET.LE.NUMSET)THEN
              ITAG=(ISET1-1)*NUMSE2 + ISET2
              ICOUNT=0
              DO19050I=1,J,4
                IF(INT(D2(I)+0.01).EQ.ITAG)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+1)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+2)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+3)
                  WRITE(IOUNI1,19054)ISET1,ISET2,Y2(I),Y2(I+1),
     1                               Y2(I+2),Y2(I+3)
                ENDIF
19050         CONTINUE
19054         FORMAT(2I8,4E15.7)
            ENDIF
          ELSEIF(NUMPAR.EQ.5)THEN
            IF(ISET.LE.NUMSET)THEN
              ITAG=(ISET1-1)*NUMSE2 + ISET2
              ICOUNT=0
              DO19150I=1,J,5
                IF(INT(D2(I)+0.01).EQ.ITAG)THEN
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+1)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+2)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+3)
                  ICOUNT=ICOUNT+1
                  TEMP(ICOUNT)=Y2(I+4)
                  WRITE(IOUNI1,19154)ISET1,ISET2,Y2(I),Y2(I+1),
     1                               Y2(I+2),Y2(I+3),Y2(I+4)
                ENDIF
19150         CONTINUE
19154         FORMAT(2I8,5E15.7)
            ENDIF
          ENDIF
        ELSE
          ICOUNT=J
          IF(NUMPAR.LE.1)THEN
            DO29110I=1,J
              WRITE(IOUNI1,29114)Y2(I)
              TEMP(I)=Y2(I)
29114         FORMAT(E15.7)
29110       CONTINUE
          ELSEIF(NUMPAR.EQ.2)THEN
            DO29130I=1,J,2
              WRITE(IOUNI1,29134)Y2(I),Y2(I+1)
              TEMP(I)=Y2(I)
              TEMP(I+1)=Y2(I+1)
29134         FORMAT(2E15.7)
29130       CONTINUE
          ELSEIF(NUMPAR.EQ.3)THEN
            DO29140I=1,J,3
              WRITE(IOUNI1,29144)Y2(I),Y2(I+1),Y2(I+2)
              TEMP(I)=Y2(I)
              TEMP(I+1)=Y2(I+1)
              TEMP(I+2)=Y2(I+2)
29144         FORMAT(3E15.7)
29140       CONTINUE
          ELSEIF(NUMPAR.EQ.4)THEN
            DO29150I=1,J,4
              WRITE(IOUNI1,29154)Y2(I),Y2(I+1),Y2(I+2),Y2(I+3)
              TEMP(I)=Y2(I)
              TEMP(I+1)=Y2(I+1)
              TEMP(I+2)=Y2(I+2)
              TEMP(I+3)=Y2(I+3)
29154         FORMAT(4E15.7)
29150       CONTINUE
          ELSEIF(NUMPAR.EQ.5)THEN
            DO29250I=1,J,5
              WRITE(IOUNI1,29254)Y2(I),Y2(I+1),Y2(I+2),Y2(I+3),Y2(I+4)
              TEMP(I)=Y2(I)
              TEMP(I+1)=Y2(I+1)
              TEMP(I+2)=Y2(I+2)
              TEMP(I+3)=Y2(I+3)
              TEMP(I+4)=Y2(I+4)
29254         FORMAT(5E15.7)
29250       CONTINUE
          ENDIF
        ENDIF
C
        IF(NGRPV.GE.1 .AND. ISET.GT.NUMSET)GOTO11000
C
        IF(NUMPAR.EQ.1)THEN
          CALL SORT(TEMP,ICOUNT,TEMP)
          CALL MEAN(TEMP,ICOUNT,IWRITE,BMEAN,IBUGG3,IERROR)
          CALL SD(TEMP,ICOUNT,IWRITE,BSD,IBUGG3,IERROR)
          CALL MEDIAN(TEMP,ICOUNT,IWRITE,XTEMP1,MAXNXT,B50,
     1                IBUGG3,IERROR)
C
          APERC=95.0
          CALL PERCEN(APERC,TEMP,ICOUNT,IWRITE,XTEMP1,MAXNXT,B95,
     1                IBUGG3,IERROR)
          APERC=5.0
          CALL PERCEN(APERC,TEMP,ICOUNT,IWRITE,XTEMP1,MAXNXT,B05,
     1              IBUGG3,IERROR)
          APERC=97.5
          CALL PERCEN(APERC,TEMP,ICOUNT,IWRITE,XTEMP1,MAXNXT,B975,
     1                IBUGG3,IERROR)
          APERC=2.5
          CALL PERCEN(APERC,TEMP,ICOUNT,IWRITE,XTEMP1,MAXNXT,B025,
     1                IBUGG3,IERROR)
          APERC=99.5
          CALL PERCEN(APERC,TEMP,ICOUNT,IWRITE,XTEMP1,MAXNXT,B995,
     1                IBUGG3,IERROR)
          APERC=0.5
          CALL PERCEN(APERC,TEMP,ICOUNT,IWRITE,XTEMP1,MAXNXT,B005,
     1                IBUGG3,IERROR)
C
          IF(NGRPV.EQ.0)THEN
            WRITE(IOUNI2,39025)BMEAN,BSD,B50,B025,B975,B05,B95,
     1                         B005,B995
39025       FORMAT(9E15.7)
          ELSEIF(NGRPV.EQ.1)THEN
            WRITE(IOUNI2,39027)ISET,BMEAN,BSD,B50,B025,B975,B05,B95,
     1                         B005,B995
39027       FORMAT(I8,9E15.7)
          ELSEIF(NGRPV.EQ.2)THEN
            WRITE(IOUNI2,39029)ISET1,ISET2,BMEAN,BSD,B50,B025,B975,
     1                         B05,B95,B005,B995
39029       FORMAT(2I8,9E15.7)
          ENDIF
        ELSEIF(NUMPAR.GE.2)THEN
          DO39110IPAR=1,NUMPAR
            ICOUNT=0
            DO39013I=1,J,NUMPAR
              IF(INT(D2(I)+0.01).EQ.ISET)THEN
                ICOUNT=ICOUNT+1
                XTEMP1(ICOUNT)=Y2(I+IPAR-1)
              ENDIF
39013       CONTINUE
            CALL SORT(XTEMP1,ICOUNT,XTEMP1)
C
            CALL MEAN(XTEMP1,ICOUNT,IWRITE,BMEAN,IBUGG3,IERROR)
            CALL SD(XTEMP1,ICOUNT,IWRITE,BSD,IBUGG3,IERROR)
            CALL MEDIAN(XTEMP1,ICOUNT,IWRITE,XTEMP2,MAXNXT,B50,
     1                  IBUGG3,IERROR)
            APERC=95.0
            CALL PERCEN(APERC,XTEMP1,ICOUNT,IWRITE,XTEMP1,MAXNXT,B95,
     1                  IBUGG3,IERROR)
            APERC=5.0
            CALL PERCEN(APERC,XTEMP1,ICOUNT,IWRITE,XTEMP1,MAXNXT,B05,
     1                  IBUGG3,IERROR)
            APERC=97.5
            CALL PERCEN(APERC,XTEMP1,ICOUNT,IWRITE,XTEMP1,MAXNXT,B975,
     1                  IBUGG3,IERROR)
            APERC=2.5
            CALL PERCEN(APERC,XTEMP1,ICOUNT,IWRITE,XTEMP1,MAXNXT,B025,
     1                  IBUGG3,IERROR)
            APERC=99.5
            CALL PERCEN(APERC,XTEMP1,ICOUNT,IWRITE,XTEMP1,MAXNXT,B995,
     1                  IBUGG3,IERROR)
            APERC=0.5
            CALL PERCEN(APERC,XTEMP1,ICOUNT,IWRITE,XTEMP1,MAXNXT,B005,
     1                  IBUGG3,IERROR)
C
            IF(NGRPV.EQ.0)THEN
              WRITE(IOUNI2,39125)IPAR,BMEAN,BSD,B50,B025,B975,B05,
     1                           B95,B005,B995
39125         FORMAT(I8,9E15.7)
            ELSEIF(NGRPV.EQ.1)THEN
              WRITE(IOUNI2,39127)IPAR,ISET,BMEAN,BSD,B50,B025,B975,
     1                           B05,B95,B005,B995
39127         FORMAT(2I8,9E15.7)
            ELSEIF(NGRPV.EQ.2)THEN
              WRITE(IOUNI2,39129)IPAR,ISET1,ISET2,BMEAN,BSD,B50,B025,
     1                           B975,B05,B95,B005,B995
39129         FORMAT(3I8,9E15.7)
            ENDIF
39110     CONTINUE
        ENDIF
11000 CONTINUE
      N2=J
      NPLOTV=3
C
CCCCC IF(NUMSET.GE.1)THEN
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1  IENDF1,IREWI1,ISUBN0,IERRF1,IBUGG3,ISUBRO,IERROR)
C
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1  IENDF2,IREWI2,ISUBN0,IERRF2,IBUGG3,ISUBRO,IERROR)
C
        IF(IFEEDB.EQ.'ON')THEN
C
          WRITE(ICOUT,8102)
 8102     FORMAT('THE FOLLOWING INFORMATION IS WRITTEN TO FILES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8104)
 8104     FORMAT('DPST1F.DAT: THE BOOTSTRAP VALUES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8106)
 8106     FORMAT('            FOR GROUPED DATA, THE FIRST ONE (OR ',
     1           'TWO) COLUMNS IDENTIFY THE GROUP(S).')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8112)
 8112     FORMAT('DPST2F.DAT: STATISTICS BASED ON BOOTSTRAP VALUES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8114)
 8114     FORMAT('            MEAN, SD, MEDIAN, B025, ',
     1           'B975, B05, B95, B005, B995')
          CALL DPWRST('XXX','BUG ')
          IF(NUMPAR.GT.1)THEN
            WRITE(ICOUT,8118)
 8118       FORMAT('            THE FIRST COLUMN IDENTIFIES THE ',
     1             'PARAMETER.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,8116)
 8116     FORMAT('            FOR GROUPED DATA, THE FIRST ONE (OR ',
     1           'TWO) COLUMNS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8117)
 8117     FORMAT('            (AFTER THE PARAMETER ID) IDENTIFY ',
     1           'THE GROUP(S).')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
C
        ENDIF
C
CCCCC ENDIF
C
      IF(IBCABT.EQ.'ON' .AND. ICASJB.EQ.'BOOT')THEN
        IENDF3='OFF'
        IREWI3='ON'
        CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1  IENDF3,IREWI3,ISUBN0,IERRF3,IBUGG3,ISUBRO,IERROR)
C
        IF(IFEEDB.EQ.'ON')THEN
C
          WRITE(ICOUT,8102)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8131)
 8131     FORMAT('DPST3F.DAT: BCa CONFIDENCE INTERVALS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8132)
 8132     FORMAT('LOWER INTERVAL, UPPER INTERVAL, Z0HAT, A0HAT, ',
     1         'ALPHA1, ALPHA2, GROUP 1 ID, GROUP 2 ID')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8134)
 8134     FORMAT('WITH 4E15.7,2F8.4,2F10.0 FORMAT')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
C
        ENDIF
C
      ENDIF
C
C               ***********************************
C               **   STEP 20--                   **
C               **   COMPUTE VARIOUS PERCENTILES **
C               ***********************************
C
      CALL SORT(Y2,N2,TEMP)
      CALL MEAN(TEMP,N2,IWRITE,BMEAN,IBUGG3,IERROR)
      CALL SD(TEMP,N2,IWRITE,BSD,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,N2,IWRITE,XTEMP1,MAXNXT,B50,IBUGG3,IERROR)
C
      APERC=0.20
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B20=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.80
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B80=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.10
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B10=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.90
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B90=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.95
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B95=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.05
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B05=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.975
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B975=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.025
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B025=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.99
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B99=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.01
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B01=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.995
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B995=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.005
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B005=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.999
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B999=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      APERC=0.001
      AN=REAL(N2)*APERC
      ILOW=INT(AN+0.0000001)
      IHIGH=ILOW+1
      IF(ILOW.LT.1)ILOW=1
      IF(ILOW.GT.N2)ILOW=N2
      IF(IHIGH.LT.1)ILOW=1
      IF(IHIGH.GT.N2)ILOW=N2
      AWT2=AN-REAL(ILOW)
      AWT1=1.0-AWT2
      B001=AWT1*TEMP(ILOW) + AWT2*TEMP(IHIGH) 
C
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PSP2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPJBS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,ICASJB,IBOOSS
 9012 FORMAT('IBUGG3,ISUBRO,ICASJB,IBOOSS = ',A4,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,N,NUMSET,N2,IERROR
 9013 FORMAT('ICASPL,N,NUMSET,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMV2,ISIZE
 9014 FORMAT('NUMV2,ISIZE = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N2
      WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I)
 9021 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBS3(TEMP1,N1,ICASJB,IJACIN,ISEED,TEMP2,N2,
     1INDX,
     1AINDEX,
     1IBUGG3,IERROR)
C
C     PURPOSE--GENERATE 1 JACKNIFE  SUBSAMPLE OF SIZE N1-1
C              OR       1 BOOTSTRAP SUBSAMPLE OF SIZE N1
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --JULY      2002. ADD AN INDEX VARIABLE.  USE
C                                       FOR CASES WHERE NEED TO
C                                       KEEP TWO OR MORE RESPONSE
C                                       VARIABLES DEPENDENT (E.G.,
C                                       CORRELATION KEEPS PAIRING
C                                       INTACT).
C     UPDATED         --AUGUST    2005. DUNRAN WAS FIXED TO GO FROM
C                                       0 TO N.  THIS ROUTINE WAS
C                                       MODIFIED TO CALL A VERSION
C                                       THAT GOES FROM 1 TO N.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASJB
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
CCCCC INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DIMENSION AINDEX(*)
      DIMENSION INDX(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPJBS3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N1,ICASJB,IJACIN
   52 FORMAT('N1,ICASJB,IJACIN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG3
   53 FORMAT('IBUGG3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISEED
   54 FORMAT('ISEED = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO59
      DO55I=1,N1
      WRITE(ICOUT,56)I,TEMP1(I)
   56 FORMAT('I,TEMP1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   59 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **  STEP 11--                                   **
C               **  CHECK THE INPUT NUMBER FOR ERRORS           **
C               **************************************************
C
      IF(N1.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPJBS3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE INPUT RAW DATA SAMPLE SIZE WAS NEGATIVE ',
     1'OR ZERO.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)N1
 1113 FORMAT('      THE INPUT RAW DATA SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(ICASJB.EQ.'JACK')GOTO1120
      GOTO1129
 1120 CONTINUE
      IF(IJACIN.GE.1)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPJBS3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE INPUT JACKNIFE INDEX WAS NON-POSITIVE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)N1
 1123 FORMAT('      THE INPUT JACKNIFE INDEX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  GENERATE THE JACKNIFE OR BOOTSTRAP SAMPLE   **
C               **************************************************
C
      IF(ICASJB.EQ.'JACK')GOTO1210
      GOTO1220
C
 1210 CONTINUE
      J=0
      DO1211I=1,N1
      IF(I.EQ.IJACIN)GOTO1211
      J=J+1
      TEMP2(J)=TEMP1(I)
      INDX(J)=I
 1211 CONTINUE
      N2=J
      GOTO9000
C
 1220 CONTINUE
CCCCC CALL DUNRAN(N1,N1,ISEED,AINDEX)
      CALL DUNRA2(N1,N1,ISEED,AINDEX)
      DO1221I=1,N1
      J=AINDEX(I)+0.5
      TEMP2(I)=TEMP1(J)
      INDX(I)=J
 1221 CONTINUE
      N2=N1
      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 DPJBS3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N1,ICASJB,IJACIN
 9012 FORMAT('N1,ICASJB,IJACIN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGG3
 9013 FORMAT('IBUGG3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)N2
 9014 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IBUGG3
 9015 FORMAT('IBUGG3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ISEED
 9016 FORMAT('ISEED = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO9029
      DO9021I=1,N1
      WRITE(ICOUT,9022)I,TEMP1(I),AINDEX(I),INDX(I)
 9022 FORMAT('I,TEMP1(I),AINDEX(I),INDX(I) = ',I8,2E15.7,I8)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9029 CONTINUE
      IF(N2.LE.0)GOTO9039
      DO9031I=1,N2
      WRITE(ICOUT,9032)I,TEMP2(I)
 9032 FORMAT('I,TEMP2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9031 CONTINUE
 9039 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBS4(ISET,NUMSET,J,J2,RIGHT,TAGID,XIDTEM,Y2,X2,D2)
C
C     PURPOSE--ADD A COMPUTED POINT TO THE OUTPUT PLOT VECTORS
C              FOR THE JACKNIFE AND BOOTSTRAP PLOTS.
C     CAUTION--THE INPUT ARGUMENT J CHANGES WITHIN
C              THIS ROUTINE AND IS ALSO AN OUTPUT ARGUMENT.
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --MARCH     2003. FOR REPLICATION CASE, SET
C                                       TAGPLOT (D2) TO REFLECT
C                                       REPLICATION NUMBER
C     UPDATED         --JANUARY   2005. SET D2 FOR CASE WHERE MORE
C                                       THAN ONE STATISTIC ESTIMATED
C                                       (E.G., DISTRIBUTIONAL FITS),
C                                       TAGID IDENTIFIES WHICH
C                                       STATISTIC
C
C---------------------------------------------------------------------
C
      DIMENSION XIDTEM(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(NUMSET.LE.0)GOTO1100
      GOTO1200
C
C               **************************************************
C               **  STEP 11--                                   **
C               **  TREAT THE CASE WHEN HAVE NO (= FULL DATA) SUBSET  **
C               **************************************************
C
 1100 CONTINUE
CCCCC IF(ISET.LE.NUMSET)GOTO1110
CCCCC GOTO1120
 1110 CONTINUE
      J=J+1
      Y2(J)=RIGHT
      IF(TAGID.EQ.1.0)THEN
        J2=J2+1
      ENDIF
      X2(J)=J2
CCCCC D2(J)=1.0
      D2(J)=TAGID
      GOTO1190
 1120 CONTINUE
      GOTO9000
CCCCC J=J+1
CCCCC Y2(J)=RIGHT
CCCCC X2(J)=XIDTEM(1)
CCCCC D2(J)=2.0
CCCCC J=J+1
CCCCC Y2(J)=RIGHT
CCCCC X2(J)=XIDTEM(NUMSET)
CCCCC D2(J)=2.0
CCCCC GOTO1190
 1190 CONTINUE
      GOTO9000
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  TREAT THE CASE WHEN HAVE 2 OR MORE SUBSETS  **
C               **************************************************
C
 1200 CONTINUE
      IF(ISET.LE.NUMSET)GOTO1210
      GOTO1220
 1210 CONTINUE
      J=J+1
      Y2(J)=RIGHT
      X2(J)=XIDTEM(ISET) + (TAGID-1.0)/10.0
CCCCC D2(J)=1.0
      D2(J)=(TAGID-1.0)*REAL(NUMSET) + REAL(ISET)
      GOTO1290
 1220 CONTINUE
      GOTO9000
CCCCC J=J+1
CCCCC Y2(J)=RIGHT
CCCCC X2(J)=XIDTEM(1)
CCCCC D2(J)=2.0
CCCCC J=J+1
CCCCC Y2(J)=RIGHT
CCCCC X2(J)=XIDTEM(NUMSET)
CCCCC D2(J)=2.0
CCCCC GOTO1290
 1290 CONTINUE
      GOTO9000
C
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBS5(ISET1,ISET2,NUMSE1,NUMSE2,J,RIGHT,XIDTEM,
     1                  XIDTE2,Y2,X2,D2)
C
C     PURPOSE--ADD A COMPUTED POINT TO THE OUTPUT PLOT VECTORS
C              FOR THE JACKNIFE AND BOOTSTRAP PLOTS.
C              THIS IS A SPECIAL VERSION OF DPJBS4 FOR THE CASE
C              WHEN THERE ARE EXACTLY TWO GROUP VRIABLES.
C     CAUTION--THE INPUT ARGUMENT J CHANGES WITHIN
C              THIS ROUTINE AND IS ALSO AN OUTPUT ARGUMENT.
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--2003/7
C     ORIGINAL VERSION--JULY      2003.
C
C---------------------------------------------------------------------
C
      DIMENSION XIDTEM(*)
      DIMENSION XIDTE2(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(ISET1.LE.0 .OR. ISET2.LE.0)GOTO9000
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  TREAT THE CASE WHEN HAVE 2 GROUPS           **
C               **************************************************
C
      AINC=0.4/REAL(NUMSE2)
      ASTRT=XIDTEM(ISET1) - 0.2
      XTEMP=ASTRT + REAL(ISET2-1)*AINC
      J=J+1
      Y2(J)=RIGHT
      X2(J)=XTEMP
      ITEMP=(ISET1-1)*NUMSE2 + ISET2
      D2(J)=REAL(ITEMP)
C
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBCP(Y,X,N,
     1ICASPL,ICENSO,IMETHD,IPPCDP,MAXOBV,MINMAX,
     1Y2,X2,Y3,X3,
     1NHOR1,IGEPDF,IADEDF,ILGADF,ISKNDF,
     1QP,XPERC,NPERC,
     1PPA0,PPA1,SHAPE1,CORRMX,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN BOOTSTRAP SAMPLE, GENERATE THE PPCC PLOT
C              TO ESTIMATE THE SHAPE PARAMETER(S) AND THEN THE
C              PROBABILITY PLOT TO ESTIMATE LOCATION (PPA0) AND
C              SCALE (PPA1).  BOTH UNCENSORED AND CENSORED
C              PLOTS ARE SUPPORTED.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/1
C     ORIGINAL VERSION--JANUARY   2005.
C
C              SUPPORTED DISTRIBUTIONS ARE:
C
C              1) WEIBULL
C              2) LOGNORMAL
C              3) GAMMA
C              4) INVERTED GAMMA
C              5) LOG GAMMA
C              6) INVERTED WEIBULL
C              7) GENERALIZED PARETO
C              8) T
C              9) CHI-SQUARE
C             10) CHI
C             11) TUKEY-LAMBDA
C             12) FRECHET
C             13) WALD
C             14) FATIGUE LIFE
C             15) PARETO
C             16) PARETO SECOND KIND
C             17) GEOMETRIC EXTREME EXPONENTIAL
C             18) BRADFORD
C             19) RECIPROCAL
C             20) ERROR (SUBBOTIN)
C             21) LOG LOGISTIC
C             22) DOUBLE WEIBULL
C             23) FOLDED T
C             24) SKEW LAPLACE (SKEW DOUBLE EXPONENTIAL)
C             25) ASYMMETRIC LAPLACE (ASYMMETRIC DOUBLE EXPONENTIAL)
C             26) GENERALIZED EXTREME VALUE
C             27) LOG DOUBLE EXPONENTIAL (LOG LAPLACE)
C             28) POWER
C             29) VON MISES
C             30) GENERALIZED LOGISTIC
C             31) GENERALIZED HALF LOGISTIC
C             32) WRAPPED CAUCHY
C             33) POWER NORMAL
C             34) DOUBLE GAMMA
C             35) GENERALIZED LOGISTIC TYPE 2
C             36) GENERALIZED LOGISTIC TYPE 3
C             37) GENERALIZED LOGISTIC TYPE 5
C
C             FOLLOWING COULD POTENTIALLY BE ADDED:
C
C             35) SKEW NORMAL
C             36) MAXWELL
C             37) MCLEISH
C             38) TRIANGULAR
C
C             ALL OF THESE SUPPORT BOTH CENSORED AND UNCENSORED DATA
C
C------------------------------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICENSO
      CHARACTER*4 IMETHD
      CHARACTER*4 IGEPDF
      CHARACTER*4 IADEDF
      CHARACTER*4 ILGADF
      CHARACTER*4 ISKNDF
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION Y3(*)
      DIMENSION X3(*)
      DIMENSION QP(*)
      DIMENSION XPERC(*)
C
      DOUBLE PRECISION DPPF
      DOUBLE PRECISION XPAR(3)
      DOUBLE PRECISION QUAGLO
      EXTERNAL QUAGLO
C
      CHARACTER*30 IDIST
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 LOWLTY
      CHARACTER*4 UPPLTY
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='DPJB'
      ISUBN2='CP  '
      IWRITE='OFF'
      IR=0
      IF(NPERC.GT.0)THEN
        DO410I=1,NPERC
          XPERC(I)=0.0
  410   CONTINUE
      ENDIF
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  IF SET PPCC      Y PLOT DATA POINTS COMMAND **
C               **  WAS ENTERED, THIN DATA SET BY COMPUTING     **
C               **  PERCENTILES OF THE DATA.  ONLY DO THIS FOR  **
C               **  THE UNCENSORED CASE.                        **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPPCDP.GT.0 .AND. ICENSO.EQ.'OFF')THEN
        NP=MAX(20,IPPCDP)
        NP=MIN(NP,N)
        CALL SORT(Y,N,Y2)
        ASTRT=0.0
        ASTOP=100.0
        AINC=(ASTOP - ASTRT)/REAL(NP+1)
        IWRITE='OFF'
        DO100I=1,NP
          P100=ASTRT + REAL(I)*AINC
          CALL PERCEN(P100,Y2,N,IWRITE,X2,MAXOBV,
     1                APERC,IBUGG3,IERROR)
          X2(I)=APERC
  100   CONTINUE
        N=NP
        DO105I=1,N
          Y2(I)=X2(I)
  105   CONTINUE
      ELSE
        DO110I=1,N
          Y2(I)=Y(I)
  110   CONTINUE
      ENDIF
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBCP')THEN
        WRITE(ICOUT,113)IPPCDP,NP,N
  113   FORMAT('      IPPCDP, NP, N = ',3I8)
        CALL DPWRST('XXX','BUG ')
        DO117I=1,N
          WRITE(ICOUT,118)I,Y2(I)
  118     FORMAT('      I, Y2(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
  117   CONTINUE
      ENDIF
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)
  999     FORMAT(1X)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1104)
 1104     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP 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(Y2,X,N,Y2,X)
        CALL UNIME3(N,X2,X,IMETHD)
      ELSE
        CALL SORT(Y2,N,Y2)
        CALL UNIMED(N,X2)
      ENDIF
C
      XMIN=Y2(1)
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  EXTRACT RANGE FOR SHAPE PARAMETER             **
C               ****************************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICNT=0
      CORRMX=CPUMIN
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
C
      IF(ICASPL.EQ.'WECP' .OR. ICASPL.EQ.'IWCP' .OR.
     1   ICASPL.EQ.'GACP' .OR. ICASPL.EQ.'GICP' .OR.
     1   ICASPL.EQ.'LGCP' .OR. ICASPL.EQ.'GECP' .OR.
     1   ICASPL.EQ.'EECP' .OR. ICASPL.EQ.'FLCP' .OR.
     1   ICASPL.EQ.'WACP' .OR. ICASPL.EQ.'E2CP' .OR.
     1   ICASPL.EQ.'DWCP' .OR. ICASPL.EQ.'GVCP' .OR.
     1   ICASPL.EQ.'GZCP' .OR. ICASPL.EQ.'DGCP' .OR.
     1   ICASPL.EQ.'PACP' .OR. ICASPL.EQ.'P2CP' .OR.
     1   ICASPL.EQ.'G5CP'
     1 )THEN
C
        ALOWLM=0.
        AUPPLM=CPUMAX
        IF(ICASPL.EQ.'WECP')THEN
          ADEF1=1.0
          ADEF2=50.0
          IDIST='WEIBULL'
        ELSEIF(ICASPL.EQ.'GACP')THEN
          ADEF1=1.0
          ADEF2=50.0
          IDIST='GAMMA'
        ELSEIF(ICASPL.EQ.'GICP')THEN
          ADEF1=0.5
          ADEF2=25.0
          IDIST='INVERTED GAMMA'
        ELSEIF(ICASPL.EQ.'LGCP')THEN
          ADEF1=0.5
          ADEF2=25.0
          IDIST='LOG GAMMA'
        ELSEIF(ICASPL.EQ.'IWCP')THEN
          ADEF1=0.5
          ADEF2=10.0
          IDIST='INVERTED WEIBULL'
        ELSEIF(ICASPL.EQ.'GECP')THEN
          ALOWLM=CPUMIN
          ADEF1=-3.0
          ADEF2=3.0
          IDIST='GENERALIZED PARETO'
        ELSEIF(ICASPL.EQ.'EECP')THEN
          ADEF1=0.1
          ADEF2=10.0
          IDIST='GEOMETRIC EXTREME EXPONENTIAL'
        ELSEIF(ICASPL.EQ.'FLCP')THEN
          ADEF1=1.0
          ADEF2=50.0
          IDIST='FATIGUE LIFE'
        ELSEIF(ICASPL.EQ.'WACP')THEN
          ADEF1=0.5
          ADEF2=25.0
          IDIST='WALD'
        ELSEIF(ICASPL.EQ.'E2CP')THEN
          ADEF1=1.0
          ADEF2=50.0
          IDIST='FRECHET'
        ELSEIF(ICASPL.EQ.'PACP' .OR. ICASPL.EQ.'P2CP')THEN
          ADEF1=0.2
          ADEF2=5.0
          IDIST='PARETO'
          IF(ICASPL.EQ.'P2CP')IDIST='PARETO SECOND KIND'
C
          IHP='A   '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          ADEF1=1.0
          CALL PARCH2(IHP,IHP2,IDIST,A1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
          IF(A1.LE.0.0)A1=1.0
        ELSEIF(ICASPL.EQ.'DWCP')THEN
          ADEF1=0.5
          ADEF2=10.0
          IDIST='DOUBLE WEIBULL'
        ELSEIF(ICASPL.EQ.'DGCP')THEN
          ADEF1=0.5
          ADEF2=10.0
          IDIST='DOUBLE GAMMA'
        ELSEIF(ICASPL.EQ.'GVCP')THEN
          ALOWLM=CPUMIN
          ADEF1=-5.0
          ADEF2=5.0
          IDIST='GENERALIZED EXTREME VALUE'
        ELSEIF(ICASPL.EQ.'GZCP')THEN
          AUPPLM=5.0
          ADEF1=0.1
          ADEF2=2.5
          IDIST='GENERALIZED HALF LOGISTIC'
        ELSEIF(ICASPL.EQ.'G5CP')THEN
          ALOWLM=CPUMIN
          ADEF1=-5.0
          ADEF2=5.0
          IDIST='GENERALIZED LOGISTIC TYPE 5'
        ENDIF
        IHP='GAMM'
        IHP2='A1  '
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE1=ADEF1
C
        IHP='GAMM'
        IHP2='A2  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE2=ADEF2
      ELSEIF(ICASPL.EQ.'LNCP')THEN
C
        IDIST='LOGNORMAL'
        IHP='SIGM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE1=1.0
C
        IHP='SIGM'
        IHP2='A2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE2=25.0
      ELSEIF(ICASPL.EQ.'LACP' .OR. ICASPL.EQ.'SDCP')THEN
C
        IF(ICASPL.EQ.'LACP')THEN
          IDIST='TUKEY-LAMBDA'
          ADEF1=-2.0
          ADEF2=2.0
        ELSEIF(ICASPL.EQ.'SDCP')THEN
          IDIST='SKEW DOUBLE EXPONENTIAL'
          ADEF1=0.0
          ADEF2=10.0
        ENDIF
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE1=ADEF
C
        IHP='LAMB'
        IHP2='DA2 '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE2=ADEF
      ELSEIF(ICASPL.EQ.'TCP' .OR. ICASPL.EQ.'CSCP' .OR.
     1       ICASPL.EQ.'CHCP' .OR. ICASPL.EQ.'FTCP')THEN
C
        IF(ICASPL.EQ.'TCP')IDIST='T'
        IF(ICASPL.EQ.'CSCP')IDIST='CHI-SQUARE'
        IF(ICASPL.EQ.'CHCP')IDIST='CHI'
        IF(ICASPL.EQ.'FTCP')IDIST='FOLDED T'
        IHP='NU1 '
        IHP2='    '
        ALOWLM=1.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GAMMA1=1.0
        VALUE1=REAL(INT(VALUE1+0.5))
C
        IHP='NU2 '
        IHP2='    '
        ADEF=50.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE2=50.0
        IVAL1=INT(VALUE1+0.5)
        IVAL2=INT(VALUE2+0.5)
        ITEMP=ABS(IVAL2-IVAL1)+1
        IF(ITEMP.LE.NUMDIS)NUMDIS=ITEMP
      ELSEIF(ICASPL.EQ.'BRCP')THEN
        IDIST='BRADFORD'
        IHP='BETA'
        IHP2='1   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'RECP' .OR. ICASPL.EQ.'VMCP')THEN
        IF(ICASPL.EQ.'RECP')THEN
          IDIST='RECIPROCAL'
          ALOWLM=1.0
          LOWLTY='>   '
          ADEF1=1.5
          ADEF2=20.0
        ELSEIF(ICASPL.EQ.'VMCP')THEN
          IDIST='VON MISES'
          ALOWLM=0.0
          LOWLTY='>=  '
          ADEF1=0.5
          ADEF2=25.0
        ENDIF
        IHP='B1  '
        IHP2='    '
        AUPPLM=CPUMAX
        UPPLTY='<=  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='B2  '
        IHP2='    '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'ERCP' .OR. ICASPL.EQ.'LXCP' .OR.
     1       ICASPL.EQ.'GLCP' .OR. ICASPL.EQ.'G2CP' .OR.
     1       ICASPL.EQ.'G3CP')THEN
        IF(ICASPL.EQ.'ERCP')THEN
          IDIST='ERROR'
          ADEF1=1.1
          ADEF2=5.0
          ALOWLM=1.
        ELSEIF(ICASPL.EQ.'LXCP')THEN
          IDIST='LOG LAPLACE'
          ADEF1=0.5
          ADEF2=10.0
          ALOWLM=0.0
        ELSEIF(ICASPL.EQ.'GLCP')THEN
          IDIST='GENERALIZED LOGISTIC'
          ADEF1=0.2
          ADEF2=5.0
          ALOWLM=0.1
        ELSEIF(ICASPL.EQ.'G2CP')THEN
          IDIST='GENERALIZED LOGISTIC TYPE 2'
          ADEF1=0.1
          ADEF2=10.0
          ALOWLM=0.0
        ELSEIF(ICASPL.EQ.'G3CP')THEN
          IDIST='GENERALIZED LOGISTIC TYPE 3'
          ADEF1=0.1
          ADEF2=10.0
          ALOWLM=0.0
        ENDIF
        IHP='ALPH'
        IHP2='A1  '
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
C
        IHP='ALPH'
        IHP2='A2  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'TRCP' .OR. ICASPL.EQ.'PFCP')THEN
        IF(ICASPL.EQ.'TRCP')THEN
          IDIST='TRIANGULAR'
          ADEF1=-1.0
          ADEF2=1.0
          ALOWLM=-1.0
          AUPPLM=1.0
          LOWLTY='>=  '
        ELSE
          IDIST='POWER'
          ADEF1=0.5
          ADEF2=25.0
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
        ENDIF
        UPPLTY='<=  '
        IHP='C1  '
        IHP2='    '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='C2  '
        IHP2='    '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'PNCP' .OR. ICASPL.EQ.'WCCP')THEN
        IF(ICASPL.EQ.'PNCP')THEN
          IDIST='POWER NORMAL'
          AUPPLM=CPUMAX
          ADEF1=1.0
          ADEF2=50.0
          LOWLTY='>   '
          UPPLTY='<=  '
        ELSEIF(ICASPL.EQ.'WCCP')THEN
          IDIST='WRAPPED CAUCHY'
          AUPPLM=1.0
          ADEF1=0.0
          ADEF2=0.99
          LOWLTY='>=  '
          UPPLTY='<   '
        ENDIF
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(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,VALUE1,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,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'ADCP')THEN
        IDIST='ASYMMETRIC LAPLACE'
        IF(IADEDF.EQ.'K')THEN
          IHP='K1  '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          ADEF=0.2
          CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ELSE
          IHP='MU1 '
          IHP2='    '
          ALOWLM=CPUMIN
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          ADEF=-5.0
          CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ENDIF
      ELSE
        PPA0=0.0
        PPA1=1.0
        SHAPE1=1.0
        CORRMX=0.0
        GOTO9000
      ENDIF
C
C               ****************************************************
C               **  STEP 3--                                      **
C               **  GENERATE PPCC    PLOT FOR GIVEN DISTRIBUTION  **
C               ****************************************************
C
      ISTEPN='3'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,213)VALUE1,VALUE2
  213   FORMAT('      VALUE1, VALUE2 = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ANUMDI=NUMDIS
C
      DO1800IDIS=1,NUMDIS
C
        ICNT=0
        AIDIS=IDIS
        VALUE=VALUE1+((AIDIS-1.0)/(ANUMDI-1.0))*(VALUE2-VALUE1)
C
        IF(ICASPL.EQ.'WECP')THEN
          DO1011I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1011
            ICNT=ICNT+1
            CALL WEIPPF(X2(I),VALUE,MINMAX,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1011     CONTINUE
C
        ELSEIF(ICASPL.EQ.'LNCP')THEN
          DO1021I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1021
            ICNT=ICNT+1
            CALL LGNPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1021     CONTINUE
        ELSEIF(ICASPL.EQ.'GACP')THEN
          DO1031I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1031
            ICNT=ICNT+1
            CALL GAMPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1031     CONTINUE
        ELSEIF(ICASPL.EQ.'GICP')THEN
          DO1041I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1041
            ICNT=ICNT+1
            CALL IGAPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1041     CONTINUE
        ELSEIF(ICASPL.EQ.'LGCP')THEN
          DO1051I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1051
            ICNT=ICNT+1
            CALL LGAPPF(X2(I),VALUE,ILGADF,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1051     CONTINUE
        ELSEIF(ICASPL.EQ.'IWCP')THEN
          DO1061I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1061
            ICNT=ICNT+1
            CALL IWEPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1061     CONTINUE
        ELSEIF(ICASPL.EQ.'GECP')THEN
          DO1071I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1071
            ICNT=ICNT+1
            CALL GEPPPF(X2(I),VALUE,MINMAX,IGEPDF,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1071     CONTINUE
        ELSEIF(ICASPL.EQ.'TCP')THEN
          DO1081I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1081
            ICNT=ICNT+1
            CALL TPPF(X2(I),INT(VALUE+0.5),X3(ICNT))
            Y3(ICNT)=Y2(I)
 1081     CONTINUE
        ELSEIF(ICASPL.EQ.'CSCP')THEN
          DO1091I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1091
            ICNT=ICNT+1
            CALL CHSPPF(X2(I),INT(VALUE+0.5),X3(ICNT))
            Y3(ICNT)=Y2(I)
 1091     CONTINUE
        ELSEIF(ICASPL.EQ.'CHCP')THEN
          DO1101I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1101
            ICNT=ICNT+1
            CALL CHPPF(X2(I),INT(VALUE+0.5),X3(ICNT))
            Y3(ICNT)=Y2(I)
 1101     CONTINUE
        ELSEIF(ICASPL.EQ.'FLCP')THEN
          DO1111I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1111
            ICNT=ICNT+1
            CALL FLPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1111     CONTINUE
        ELSEIF(ICASPL.EQ.'WACP')THEN
          DO1121I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1121
            ICNT=ICNT+1
            CALL WALPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1121     CONTINUE
        ELSEIF(ICASPL.EQ.'E2CP')THEN
          DO1131I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1131
            ICNT=ICNT+1
            CALL EV2PPF(X2(I),VALUE,MINMAX,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1131     CONTINUE
        ELSEIF(ICASPL.EQ.'EECP')THEN
          DO1141I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1141
            ICNT=ICNT+1
            CALL GEEPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1141     CONTINUE
        ELSEIF(ICASPL.EQ.'LACP')THEN
          DO1151I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1151
            ICNT=ICNT+1
            CALL LAMPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1151     CONTINUE
        ELSEIF(ICASPL.EQ.'PACP')THEN
          A=A1
          IF(A.GT.XMIN)A=XMIN
          DO1161I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1161
            ICNT=ICNT+1
            CALL PARPPF(X2(I),VALUE,A,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1161     CONTINUE
        ELSEIF(ICASPL.EQ.'P2CP')THEN
          A=A1
          IF(A.GT.XMIN)A=XMIN
          DO1166I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1166
            ICNT=ICNT+1
            CALL PA2PPF(X2(I),VALUE,A,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1166     CONTINUE
        ELSEIF(ICASPL.EQ.'BRCP')THEN
          DO1171I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1171
            ICNT=ICNT+1
            CALL BRAPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1171     CONTINUE
        ELSEIF(ICASPL.EQ.'RECP')THEN
          DO1181I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1181
            ICNT=ICNT+1
            CALL RECPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1181     CONTINUE
        ELSEIF(ICASPL.EQ.'ERCP')THEN
          DO1191I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1191
            ICNT=ICNT+1
            X2IN=X2(I)
            CALL ERRPPF(X2IN,VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1191     CONTINUE
        ELSEIF(ICASPL.EQ.'TRCP')THEN
          ZLOWLM=-1.0
          ZUPPLM=1.0
          DO1201I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1201
            ICNT=ICNT+1
            CALL TRIPPF(X2(I),VALUE,ZLOWLM,ZUPPLM,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1201     CONTINUE
        ELSEIF(ICASPL.EQ.'LLCP')THEN
          DO1211I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1211
            ICNT=ICNT+1
            CALL LLGPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1211     CONTINUE
        ELSEIF(ICASPL.EQ.'DWCP')THEN
          DO1221I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1221
            ICNT=ICNT+1
            CALL DWEPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1221     CONTINUE
        ELSEIF(ICASPL.EQ.'FTCP')THEN
          DO1231I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1231
            ICNT=ICNT+1
            CALL FTPPF(X2(I),INT(VALUE+0.5),X3(ICNT))
            Y3(ICNT)=Y2(I)
 1231     CONTINUE
        ELSEIF(ICASPL.EQ.'SDCP')THEN
          DO1241I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1241
            ICNT=ICNT+1
            CALL SDEPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1241     CONTINUE
        ELSEIF(ICASPL.EQ.'GVCP')THEN
          DO1251I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1251
            ICNT=ICNT+1
            CALL GEVPPF(X2(I),VALUE,MINMAX,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1251     CONTINUE
        ELSEIF(ICASPL.EQ.'LXCP')THEN
          DO1261I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1261
            ICNT=ICNT+1
            CALL LDEPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1261     CONTINUE
        ELSEIF(ICASPL.EQ.'ADCP')THEN
          DO1271I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1271
            ICNT=ICNT+1
            CALL ADEPPF(X2(I),VALUE,IADEDF,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1271     CONTINUE
        ELSEIF(ICASPL.EQ.'PFCP')THEN
          DO1281I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1281
            ICNT=ICNT+1
            CALL POWPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1281     CONTINUE
        ELSEIF(ICASPL.EQ.'VMCP')THEN
          DO1291I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1291
            ICNT=ICNT+1
            CALL VONPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1291     CONTINUE
        ELSEIF(ICASPL.EQ.'WCCP')THEN
          DO1301I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1301
            ICNT=ICNT+1
            CALL WCAPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1301     CONTINUE
        ELSEIF(ICASPL.EQ.'GLCP')THEN
          DO1311I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1311
            ICNT=ICNT+1
            CALL GLOPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1311     CONTINUE
        ELSEIF(ICASPL.EQ.'GZCP')THEN
          DO1321I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1321
            ICNT=ICNT+1
            CALL HFLPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1321     CONTINUE
        ELSEIF(ICASPL.EQ.'DGCP')THEN
          DO1331I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1331
            ICNT=ICNT+1
            CALL DGAPPF(X2(I),VALUE,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1331     CONTINUE
        ELSEIF(ICASPL.EQ.'PNCP')THEN
          S=1.0
          DO1341I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1341
            ICNT=ICNT+1
            CALL PNRPPF(X2(I),VALUE,S,X3(ICNT))
            Y3(ICNT)=Y2(I)
 1341     CONTINUE
        ELSEIF(ICASPL.EQ.'G2CP')THEN
          DO1351I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1351
            ICNT=ICNT+1
            CALL GL2PPF(DBLE(X2(I)),DBLE(VALUE),DPPF)
            X3(ICNT)=REAL(DPPF)
            Y3(ICNT)=Y2(I)
 1351     CONTINUE
        ELSEIF(ICASPL.EQ.'G3CP')THEN
          DO1361I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1361
            ICNT=ICNT+1
            CALL GL3PPF(DBLE(X2(I)),DBLE(VALUE),DPPF)
            X3(ICNT)=REAL(DPPF)
            Y3(ICNT)=Y2(I)
 1361     CONTINUE
        ELSEIF(ICASPL.EQ.'G5CP')THEN
          XPAR(1)=0.0D0
          XPAR(2)=1.0D0
          XPAR(3)=DBLE(VALUE)
          DO1371I=1,N
            IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1371
            ICNT=ICNT+1
            DPPF=QUAGLO(DBLE(X2(I)),XPAR)
            X3(ICNT)=REAL(DPPF)
            Y3(ICNT)=Y2(I)
 1371     CONTINUE
        ENDIF
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  COMPUTE MAXIMUM PPCC TO FIND VALUE OF SHAPE **
C               **  PARAMETER AND THEN                          **
C               **  COMPUTE FITTED LINE TO PROBABILITY PLOT     **
C               **  TO ESTIMATE LOCATION AND SCALE              **
C               **************************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      N2=ICNT
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')THEN
        WRITE(ICOUT,2001)N2
 2001   FORMAT('N2 = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(N2.GE.1)THEN
          DO2110I=1,N2
            WRITE(ICOUT,2011)I,Y3(I),X3(I)
 2011       FORMAT('I,Y3(I),X3(I) = ',I8,2G15.7)
            CALL DPWRST('XXX','BUG ')
 2110     CONTINUE
        ENDIF
      ENDIF
C
      CALL CORR(Y3,X3,N2,IWRITE,CC,IBUGG3,IERROR)
C
      IF(CC.GT.CORRMX)THEN
        CORRMX=CC
        SHAPE1=VALUE
        CALL LINFI2(Y3,X3,N2,
     1              PPA0,PPA1,
     1              ISUBRO,IBUGG3,IERROR)
      ENDIF
C
 1800 CONTINUE
C
C               **************************************************
C               **  STEP 5--                                    **
C               **  COMPUTE SELECTED PERCENTILES                **
C               **************************************************
C
      ISTEPN='5'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NPERC.GT.0)THEN
        IF(ICASPL.EQ.'WECP')THEN
          DO4110I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL WEIPPF(QPTEMP,SHAPE1,MINMAX,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4110     CONTINUE
        ELSEIF(ICASPL.EQ.'LNCP')THEN
          DO4120I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LGNPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4120     CONTINUE
        ELSEIF(ICASPL.EQ.'GACP')THEN
          DO4130I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GAMPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4130     CONTINUE
        ELSEIF(ICASPL.EQ.'GICP')THEN
          DO4140I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL IGAPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4140     CONTINUE
        ELSEIF(ICASPL.EQ.'LGCP')THEN
          DO4150I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LGAPPF(QPTEMP,SHAPE1,ILGADF,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4150     CONTINUE
        ELSEIF(ICASPL.EQ.'GECP')THEN
          DO4160I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GEPPPF(QPTEMP,SHAPE1,MINMAX,IGEPDF,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4160     CONTINUE
        ELSEIF(ICASPL.EQ.'IWCP')THEN
          DO4170I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL IWEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4170     CONTINUE
        ELSEIF(ICASPL.EQ.'CSCP')THEN
          DO4180I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL CHSPPF(QPTEMP,INT(SHAPE1+0.5),XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4180     CONTINUE
        ELSEIF(ICASPL.EQ.'CHCP')THEN
          DO4190I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL CHPPF(QPTEMP,INT(SHAPE1+0.5),XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4190     CONTINUE
        ELSEIF(ICASPL.EQ.'TCP')THEN
          DO4200I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL TPPF(QPTEMP,INT(SHAPE1+0.5),XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4200     CONTINUE
        ELSEIF(ICASPL.EQ.'EECP')THEN
          DO4210I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GEEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4210     CONTINUE
        ELSEIF(ICASPL.EQ.'FLCP')THEN
          DO4220I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL FLPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4220     CONTINUE
        ELSEIF(ICASPL.EQ.'E2CP')THEN
          DO4230I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL EV2PPF(QPTEMP,SHAPE1,MINMAX,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4230     CONTINUE
        ELSEIF(ICASPL.EQ.'WACP')THEN
          DO4240I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL WALPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4240     CONTINUE
        ELSEIF(ICASPL.EQ.'PACP')THEN
          DO4250I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL PARPPF(QPTEMP,SHAPE1,XMIN,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4250     CONTINUE
        ELSEIF(ICASPL.EQ.'P2CP')THEN
          DO4255I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL PA2PPF(QPTEMP,SHAPE1,XMIN,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4255     CONTINUE
        ELSEIF(ICASPL.EQ.'LACP')THEN
          DO4260I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LAMPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4260     CONTINUE
        ELSEIF(ICASPL.EQ.'BRCP')THEN
          DO4270I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL BRAPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4270     CONTINUE
        ELSEIF(ICASPL.EQ.'RECP')THEN
          DO4280I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL RECPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4280     CONTINUE
        ELSEIF(ICASPL.EQ.'ERCP')THEN
          DO4290I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL ERRPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4290     CONTINUE
        ELSEIF(ICASPL.EQ.'TRCP')THEN
          ZLOWLM=PPA0
          ZUPPLM=PPA0 + PPA1
          DO4300I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL TRIPPF(QPTEMP,SHAPE1,ZLOWLM,ZUPPLM,XPERC(I))
CCCCC       XPERC(I)=PPA0 + PPA1*XPERC(I)
 4300     CONTINUE
        ELSEIF(ICASPL.EQ.'LLCP')THEN
          DO4310I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LLGPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4310     CONTINUE
        ELSEIF(ICASPL.EQ.'DWCP')THEN
          DO4320I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL DWEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4320     CONTINUE
        ELSEIF(ICASPL.EQ.'FTCP')THEN
          DO4330I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL FTPPF(QPTEMP,INT(SHAPE1+0.5),XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4330     CONTINUE
        ELSEIF(ICASPL.EQ.'SDCP')THEN
          DO4340I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL SDEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4340     CONTINUE
        ELSEIF(ICASPL.EQ.'ADCP')THEN
          DO4350I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL ADEPPF(QPTEMP,SHAPE1,IADEDF,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4350     CONTINUE
        ELSEIF(ICASPL.EQ.'GVCP')THEN
          DO4360I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GEVPPF(QPTEMP,SHAPE1,MINMAX,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4360     CONTINUE
        ELSEIF(ICASPL.EQ.'LXCP')THEN
          DO4370I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LDEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4370     CONTINUE
        ELSEIF(ICASPL.EQ.'PFCP')THEN
          DO4380I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL POWPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4380     CONTINUE
        ELSEIF(ICASPL.EQ.'VMCP')THEN
          DO4390I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL VONPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4390     CONTINUE
        ELSEIF(ICASPL.EQ.'WCCP')THEN
          DO4400I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL WCAPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4400     CONTINUE
        ELSEIF(ICASPL.EQ.'GLCP')THEN
          DO4410I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GLOPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4410     CONTINUE
        ELSEIF(ICASPL.EQ.'GZCP')THEN
          DO4420I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL HFLPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4420     CONTINUE
        ELSEIF(ICASPL.EQ.'DGCP')THEN
          DO4430I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL DGAPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4430     CONTINUE
        ELSEIF(ICASPL.EQ.'PNCP')THEN
          S=1.0
          DO4440I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL PNRPPF(QPTEMP,SHAPE1,S,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4440     CONTINUE
        ELSEIF(ICASPL.EQ.'G2CP')THEN
          DO4450I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GL2PPF(DBLE(QPTEMP),DBLE(SHAPE1),DPPF)
            XPERC(I)=REAL(DPPF)
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4450     CONTINUE
        ELSEIF(ICASPL.EQ.'G3CP')THEN
          DO4460I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GL3PPF(DBLE(QPTEMP),DBLE(SHAPE1),DPPF)
            XPERC(I)=REAL(DPPF)
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4460     CONTINUE
        ELSEIF(ICASPL.EQ.'G5CP')THEN
          XPAR(1)=DBLE(PPA0)
          XPAR(2)=DBLE(PPA1)
          XPAR(3)=DBLE(SHAPE1)
          DO4470I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GL3PPF(DBLE(QPTEMP),DBLE(SHAPE1),DPPF)
            DPPF=QUAGLO(DBLE(QPTEMP),XPAR)
            XPERC(I)=REAL(DPPF)
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4470     CONTINUE
        ENDIF
      ENDIF
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBC2(Y,X,N,
     1ICASPL,ICENSO,IMETHD,IPPCDP,MAXOBV,MINMAX,
     1Y2,X2,Y3,X3,
     1NHOR1,NHOR2,
     1QP,XPERC,NPERC,
     1PPA0,PPA1,SHAPE1,SHAPE2,CORRMX,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN BOOTSTRAP SAMPLE, GENERATE THE PPCC PLOT
C              TO ESTIMATE THE TWO SHAPE PARAMETER(S) AND THEN THE
C              PROBABILITY PLOT TO ESTIMATE LOCATION (PPA0) AND
C              SCALE (PPA1).  BOTH UNCENSORED AND CENSORED
C              PLOTS ARE SUPPORTED.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/1
C     ORIGINAL VERSION--JANUARY   2005.
C
C              SUPPORTED DISTRIBUTIONS ARE:
C
C              FOLLOWING ARE ACTIVE
C               1) G-AND-H
C               2) INVERSE GAUSSIAN
C               3) GENERALIZED GAMMA
C               4) BETA
C               5) F
C               6) FOLDED NORMAL
C               7) GENERALIZED TUKEY LAMBDA
C               8) BETA NORMAL
C
C              FOLLOWING ARE DISTRIBUTIONS THAT COULD POTENTIALLY
C              BE ADDED
C               9) GOMPERTZ
C              10) EXPONENTIAL POWER
C              11) POWER LOGNORMAL
C              12) ALPHA
C              13) EXPONENTIATED WEIBULL
C              14) JOHNSON SB
C              15) JOHNSON SU
C              16) TWO-SIDED POWER
C              17) RECIPROCAL INVERSE GAUSSIAN
C              18) SKEW T
C              19) INVERTED BETA
C              20) LOG-SKEW-NORMAL
C              21) NON-CENTRAL T
C              22) NON-CENTRAL CHI-SQUARE
C              23) FOLDED CAUCHY
C              24) TRUNCATED EXPONENTIAL
C                  (ASSUME TRUNCATION POINT X0 IS KNOWN)
C              25) GOMPERTZ-MAKEHAM (FOR MEEKER REPARAMETERIZATION TO
C                  CASE WITH TWO SHAPE PARAMETERS AND SCALE PARAMETER)
C              26) GENERALIZED ASYMMETRIC LAPLACE
C              27) GENERALIZED MCLEISH
C                  NOTE: STILL BEING TESTED
C              28) HYPERBOLIC (NOT WORKING)
C
C
C
C             ALL OF THESE SUPPORT BOTH CENSORED AND UNCENSORED DATA
C
C------------------------------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICENSO
      CHARACTER*4 IMETHD
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IGLDDF
C
      DOUBLE PRECISION DP
      DOUBLE PRECISION DPPF
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION Y3(*)
      DIMENSION X3(*)
      DIMENSION QP(*)
      DIMENSION XPERC(*)
C
      CHARACTER*30 IDIST
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 LOWLTY
      CHARACTER*4 UPPLTY
C
      INCLUDE 'DPCOMC.INC'
C
C-------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPJB'
      ISUBN2='C2  '
      IWRITE='OFF'
      IR=0
      IF(NPERC.GT.0)THEN
        DO410I=1,NPERC
          XPERC(I)=0.0
  410   CONTINUE
      ENDIF
C
      IGLDDF='FMKL'
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  IF SET PPCC      Y PLOT DATA POINTS COMMAND **
C               **  WAS ENTERED, THIN DATA SET BY COMPUTING     **
C               **  PERCENTILES OF THE DATA.  ONLY DO THIS FOR  **
C               **  THE UNCENSORED CASE.                        **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPPCDP.GT.0 .AND. ICENSO.EQ.'OFF')THEN
        NP=MAX(20,IPPCDP)
        NP=MIN(NP,N)
        CALL SORT(Y,N,Y2)
        ASTRT=0.0
        ASTOP=100.0
        AINC=(ASTOP - ASTRT)/REAL(NP+1)
        IWRITE='OFF'
        DO100I=1,NP
          P100=ASTRT + REAL(I)*AINC
          CALL PERCEN(P100,Y2,N,IWRITE,X2,MAXOBV,
     1                APERC,IBUGG3,IERROR)
          X2(I)=APERC
  100   CONTINUE
        N=NP
        DO105I=1,N
          Y2(I)=X2(I)
  105   CONTINUE
      ELSE
        DO110I=1,N
          Y2(I)=Y(I)
  110   CONTINUE
      ENDIF
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBCP')THEN
        WRITE(ICOUT,113)IPPCDP,NP,N
  113   FORMAT('      IPPCDP, NP, N = ',3I8)
        CALL DPWRST('XXX','BUG ')
        DO117I=1,N
          WRITE(ICOUT,118)I,Y2(I)
  118     FORMAT('      I, Y2(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
  117   CONTINUE
      ENDIF
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)
  999     FORMAT(1X)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1104)
 1104     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP 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(Y2,X,N,Y2,X)
        CALL UNIME3(N,X2,X,IMETHD)
      ELSE
        CALL SORT(Y2,N,Y2)
        CALL UNIMED(N,X2)
      ENDIF
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  EXTRACT RANGE FOR SHAPE PARAMETER             **
C               ****************************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICNT=0
      CORRMX=CPUMIN
C
      IF(ICASPL.EQ.'GHCP')THEN
C
        NUMDI1=21
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=41
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='G-H'
        IHP='G1  '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=   '
        UPPLTY='<=  '
        ADEF=-1.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='G2  '
        IHP2='    '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              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,VALUE3,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='H2  '
        IHP2='    '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'LDCP')THEN
C
        NUMDI1=21
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=41
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='GENERALIZED TUKEY-LAMBDA'
        IHP='LAMB'
        IHP2='DA31'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=   '
        UPPLTY='<=  '
        ADEF=-5.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,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=-5.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE3,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,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'FCP')THEN
C
        IDIST='F '
        IHP='NU11'
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        IDEF=1
        CALL PARCI2(IHP,IHP2,IDIST,IVAL1,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,IVAL2,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,IVAL3,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,IVAL4,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        VALUE1=REAL(IVAL1)
        VALUE2=REAL(IVAL2)
        VALUE3=REAL(IVAL3)
        VALUE4=REAL(IVAL4)
C
        NUMDI1=IVAL2 - IVAL1 + 1
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        IF(NUMDI1.LT.10)NUMDI1=10
        ANMDI1=NUMDI1
        NUMDI2=IVAL4 - IVAL3 + 1
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        IF(NUMDI2.LT.10)NUMDI2=10
        ANMDI2=NUMDI2
C
      ELSEIF(ICASPL.EQ.'IGCP')THEN
C
        NUMDI1=50
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=50
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='INVERSE GAUSSIAN'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,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,VALUE3,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,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'BECP')THEN
C
        NUMDI1=25
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=25
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='BETA'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,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,VALUE3,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,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'GGCP')THEN
C
        NUMDI1=25
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=25
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='GENERALIZED GAMMA'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,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,VALUE3,ADEF,ALOWLM,AUPPLM,
     1              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,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'FNCP')THEN
C
        NUMDI1=26
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=26
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='FOLDED NORMAL'
        IHP='MU1 '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=0.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,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,VALUE3,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD2 '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSE
        PPA0=0.0
        PPA1=1.0
        SHAPE1=1.0
        CORRMX=0.0
        GOTO9000
      ENDIF
C
C               ****************************************************
C               **  STEP 3--                                      **
C               **  GENERATE PPCC    PLOT FOR GIVEN DISTRIBUTION  **
C               ****************************************************
C
      ISTEPN='3'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,213)VALUE1,VALUE2
  213   FORMAT('      VALUE1, VALUE2 = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ANUMDI=NUMDI1
      ANUMD2=NUMDI2
      DP=-1.0D0
      DPPF=0.0D0
C
      DO1800IDIS=1,NUMDI1
C
        AIDIS=IDIS
        VAL1=VALUE1+((AIDIS-1.0)/(ANUMDI-1.0))*(VALUE2-VALUE1)
C
        DO1890IDIS2=1,NUMDI2
          AIDI2=IDIS2
          VAL2=VALUE3+((AIDI2-1.0)/(ANUMD2-1.0))*(VALUE4-VALUE3)
          ICNT=0
C
          IF(ICASPL.EQ.'GHCP')THEN
            DO1011I=1,N
              IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1011
              ICNT=ICNT+1
              CALL GHPPF(X2(I),VAL1,VAL2,X2OUT,DBLE(X2(I)),DPPF)
              X3(ICNT)=X2OUT
              Y3(ICNT)=Y2(I)
 1011       CONTINUE
C
          ELSEIF(ICASPL.EQ.'FCP')THEN
            DO1021I=1,N
              IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1021
              ICNT=ICNT+1
              CALL FPPF(X2(I),INT(VAL1+0.5),INT(VAL2+0.5),X2OUT)
              X3(ICNT)=X2OUT
              Y3(ICNT)=Y2(I)
 1021       CONTINUE
C
          ELSEIF(ICASPL.EQ.'IGCP')THEN
            DO1031I=1,N
              IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1031
              ICNT=ICNT+1
              CALL IGPPF(X2(I),VAL1,VAL2,X2OUT)
              X3(ICNT)=X2OUT
              Y3(ICNT)=Y2(I)
 1031       CONTINUE
C
          ELSEIF(ICASPL.EQ.'GGCP')THEN
            DO1041I=1,N
              IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1041
              ICNT=ICNT+1
              CALL GGDPPF(X2(I),VAL1,VAL2,X2OUT)
              X3(ICNT)=X2OUT
              Y3(ICNT)=Y2(I)
 1041       CONTINUE
C
          ELSEIF(ICASPL.EQ.'BECP')THEN
            DO1051I=1,N
              IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1051
              ICNT=ICNT+1
              CALL BETPPF(X2(I),VAL1,VAL2,X2OUT)
              X3(ICNT)=X2OUT
              Y3(ICNT)=Y2(I)
 1051       CONTINUE
C
          ELSEIF(ICASPL.EQ.'FNCP')THEN
            DO1061I=1,N
              IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1061
              ICNT=ICNT+1
              CALL FNRPPF(X2(I),VAL1,VAL2,X2OUT)
              X3(ICNT)=X2OUT
              Y3(ICNT)=Y2(I)
 1061       CONTINUE
C
          ELSEIF(ICASPL.EQ.'LDCP')THEN
            DO1071I=1,N
              IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1071
              ICNT=ICNT+1
              CALL GLDPPF(DBLE(X2(I)),DBLE(VAL1),DBLE(VAL2),
     1                    DPPF,IGLDDF,IWRITE)
              X3(ICNT)=REAL(DPPF)
              Y3(ICNT)=Y2(I)
 1071       CONTINUE
C
          ENDIF
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  COMPUTE MAXIMUM PPCC TO FIND VALUE OF SHAPE **
C               **  PARAMETER AND THEN                          **
C               **  COMPUTE FITTED LINE TO PROBABILITY PLOT     **
C               **  TO ESTIMATE LOCATION AND SCALE              **
C               **************************************************
C
          ISTEPN='4'
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')
     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
          N2=ICNT
C
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')THEN
            WRITE(ICOUT,2001)N2
 2001       FORMAT('N2 = ',I8)
            CALL DPWRST('XXX','BUG ')
            IF(N2.GE.1)THEN
              DO2110I=1,N2
                WRITE(ICOUT,2011)I,Y3(I),X3(I)
 2011           FORMAT('I,Y3(I),X3(I) = ',I8,2G15.7)
                CALL DPWRST('XXX','BUG ')
 2110         CONTINUE
            ENDIF
          ENDIF
C
          CALL CORR(Y3,X3,N2,IWRITE,CC,IBUGG3,IERROR)
C
          IF(CC.GT.CORRMX)THEN
            CORRMX=CC
            SHAPE1=VAL1
            SHAPE2=VAL2
            CALL LINFI2(Y3,X3,N2,
     1                  PPA0,PPA1,
     1                  ISUBRO,IBUGG3,IERROR)
          ENDIF
C
 1890   CONTINUE
 1800 CONTINUE
C
C               **************************************************
C               **  STEP 5--                                    **
C               **  COMPUTE SELECTED PERCENTILES                **
C               **************************************************
C
      ISTEPN='5'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NPERC.GT.0)THEN
        IF(ICASPL.EQ.'GHCP')THEN
          DO4110I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GHPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I),DP,DPPF)
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4110     CONTINUE
        ELSEIF(ICASPL.EQ.'IGCP')THEN
          DO4120I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL IGPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4120     CONTINUE
        ELSEIF(ICASPL.EQ.'GGCP')THEN
          DO4130I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GGDPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4130     CONTINUE
        ELSEIF(ICASPL.EQ.'BECP')THEN
          DO4140I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL BETPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4140     CONTINUE
        ELSEIF(ICASPL.EQ.'FCP')THEN
          DO4150I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL FPPF(QPTEMP,INT(SHAPE1+0.5),INT(SHAPE2+0.5),XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4150     CONTINUE
        ELSEIF(ICASPL.EQ.'FNCP')THEN
          DO4160I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL FNRPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I))
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4160     CONTINUE
        ELSEIF(ICASPL.EQ.'LDCP')THEN
          DO4170I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GLDPPF(DBLE(QPTEMP),DBLE(SHAPE1),DBLE(SHAPE2),
     1                  DPPF,IGLDDF,IWRITE)
            XPERC(I)=REAL(DPPF)
            XPERC(I)=PPA0 + PPA1*XPERC(I)
 4170     CONTINUE
        ENDIF
      ENDIF
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBKS(Y,X,N,
     1ICASPL,IMETHD,IPPCDP,MAXOBV,MINMAX,
     1Y2,X2,Y3,X3,
     1NHOR1,IGEPDF,IADEDF,ILGADF,ISKNDF,KSLOC,KSSCAL,
     1QP,XPERC,NPERC,
     1PPA0SV,PPA1SV,SHAPE1,AMINKS,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN BOOTSTRAP SAMPLE, GENERATE THE KS PLOT
C              TO ESTIMATE THE SHAPE, LOCATION, AND SCALE
C              PARAMETERS.  THE LOCATION AND SCALE PARAMETERS CAN
C              OPTIONALLY BE SPECIFIED IN ADVANCE.  ONLY UNCENSORED
C              DATA IS CURRENTLY SUPPORTED.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/1
C     ORIGINAL VERSION--JANUARY   2005.
C
C              SUPPORTED DISTRIBUTIONS ARE:
C
C              1) WEIBULL
C              2) LOGNORMAL
C              3) GAMMA
C              4) INVERTED GAMMA
C              5) LOG GAMMA
C              6) INVERTED WEIBULL
C              7) GENERALIZED PARETO
C              8) T
C              9) CHI-SQUARE
C             10) CHI
C             11) TUKEY-LAMBDA
C             12) FRECHET
C             13) WALD
C             14) FATIGUE LIFE
C             15) PARETO
C             16) PARETO SECOND KIND
C             17) GEOMETRIC EXTREME EXPONENTIAL
C             18) BRADFORD
C             19) RECIPROCAL
C             20) ERROR (SUBBOTIN)
C             21) LOG LOGISTIC
C             22) DOUBLE WEIBULL
C             23) FOLDED T
C             24) SKEW LAPLACE (SKEW DOUBLE EXPONENTIAL)
C             25) ASYMMETRIC LAPLACE (ASYMMETRIC DOUBLE EXPONENTIAL)
C             26) GENERALIZED EXTREME VALUE
C             27) LOG DOUBLE EXPONENTIAL (LOG LAPLACE)
C             28) POWER FUNCTION
C             29) GENERALIZED LOGISTIC
C             30) VON MISES
C             31) GENERALIZED HALF LOGISTIC
C             32) WRAPPED CAUCHY
C             33) POWER NORMAL
C             34) DOUBLE GAMMA
C             35) GENERALIZED TYPE 2
C             36) GENERALIZED TYPE 3
C             37) GENERALIZED TYPE 5
C
C             FOLLOWING COULD POTENTIALLY BE ADDED:
C
C             35) SKEW NORMAL
C             36) MAXWELL
C             37) MCLEISH
C
C             FOR THE KS PLOT, ONLY UNCENSORED DATA IS CURRENTLY
C             SUPPORTED.
C
C------------------------------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IMETHD
      CHARACTER*4 IGEPDF
      CHARACTER*4 IADEDF
      CHARACTER*4 ILGADF
      CHARACTER*4 ISKNDF
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION Y3(*)
      DIMENSION X3(*)
      DIMENSION QP(*)
      DIMENSION XPERC(*)
C
      REAL KSLOC
      REAL KSSCAL
C
      DOUBLE PRECISION DM
      DOUBLE PRECISION DTEMP1
      DOUBLE PRECISION DTEMP2
      DOUBLE PRECISION DPPF
      DOUBLE PRECISION XPAR(3)
C
      CHARACTER*30 IDIST
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 LOWLTY
      CHARACTER*4 UPPLTY
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='DPJB'
      ISUBN2='KS  '
      IWRITE='OFF'
      IF(NPERC.GT.0)THEN
        DO410I=1,NPERC
          XPERC(I)=0.0
  410   CONTINUE
      ENDIF
      AMINKS=CPUMAX
C
      IF(ICASPL.EQ.'P2KS' .OR. ICASPL.EQ.'PAKS')THEN
        IF(KSLOC.EQ.CPUMIN .AND.  KSSCAL.EQ.CPUMIN)THEN
          KSLOC=0.0
          KSSCAL=1.0
        ENDIF
      ENDIF

C               **************************************************
C               **  STEP 1--                                    **
C               **  IF SET PPCC      Y PLOT DATA POINTS COMMAND **
C               **  WAS ENTERED, THIN DATA SET BY COMPUTING     **
C               **  PERCENTILES OF THE DATA.  ONLY DO THIS FOR  **
C               **  THE UNCENSORED CASE.                        **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBKS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPPCDP.GT.0)THEN
        NP=MAX(20,IPPCDP)
        NP=MIN(NP,N)
        CALL SORT(Y,N,Y2)
        ASTRT=0.0
        ASTOP=100.0
        AINC=(ASTOP - ASTRT)/REAL(NP+1)
        IWRITE='OFF'
        DO100I=1,NP
          P100=ASTRT + REAL(I)*AINC
          CALL PERCEN(P100,Y2,N,IWRITE,X3,MAXOBV,
     1                APERC,IBUGG3,IERROR)
          X2(I)=APERC
  100   CONTINUE
        N=NP
        DO105I=1,N
          Y(I)=X2(I)
  105   CONTINUE
      ENDIF
C
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBKS')THEN
        WRITE(ICOUT,113)IPPCDP,NP,N
  113   FORMAT('      IPPCDP, NP, 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
C
  999 FORMAT(1X)
C
      CALL MEDIAN(Y,N,IWRITE,X2,MAXOBV,XMED,IBUGG3,IERROR)
      CALL SORT(Y,N,Y)
      CALL UNIMED(N,X)
      XMIN=Y(1)
      XMAX=Y(N)
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  EXTRACT RANGE FOR SHAPE PARAMETER             **
C               ****************************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBKS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICNT=0
      AMINKS=CPUMAX
      NUMDIS=50
      IF(NHOR1.GT.0)NUMDIS=NHOR1
C
      IF(ICASPL.EQ.'WEKS' .OR. ICASPL.EQ.'IWKS' .OR.
     1   ICASPL.EQ.'GAKS' .OR. ICASPL.EQ.'GIKS' .OR.
     1   ICASPL.EQ.'LGKS' .OR. ICASPL.EQ.'GEKS' .OR.
     1   ICASPL.EQ.'EEKS' .OR. ICASPL.EQ.'FLKS' .OR.
     1   ICASPL.EQ.'WAKS' .OR. ICASPL.EQ.'E2KS' .OR.
     1   ICASPL.EQ.'DWKS' .OR. ICASPL.EQ.'GVKS' .OR.
     1   ICASPL.EQ.'GZKS' .OR. ICASPL.EQ.'DGKS' .OR.
     1   ICASPL.EQ.'PAKS' .OR. ICASPL.EQ.'P2KS' .OR.
     1   ICASPL.EQ.'G5KS'
     1 )THEN
C
        ALOWLM=0.0
        IF(ICASPL.EQ.'WEKS')THEN
          ADEF1=1.0
          ADEF2=50.0
          IDIST='WEIBULL'
        ELSEIF(ICASPL.EQ.'GAKS')THEN
          ADEF1=1.0
          ADEF2=50.0
          IDIST='GAMMA'
        ELSEIF(ICASPL.EQ.'GIKS')THEN
          ADEF1=0.5
          ADEF2=25.0
          IDIST='INVERTED GAMMA'
        ELSEIF(ICASPL.EQ.'LGKS')THEN
          ADEF1=0.5
          ADEF2=25.0
          IDIST='LOG GAMMA'
        ELSEIF(ICASPL.EQ.'IWKS')THEN
          ADEF1=0.5
          ADEF2=10.0
          IDIST='INVERTED WEIBULL'
        ELSEIF(ICASPL.EQ.'GEKS')THEN
          ALOWLM=CPUMIN
          ADEF1=-3.0
          ADEF2=3.0
          IDIST='GENERALIZED PARETO'
        ELSEIF(ICASPL.EQ.'EEKS')THEN
          ADEF1=0.1
          ADEF2=10.0
          IDIST='GEOMETRIC EXTREME EXPONENTIAL'
        ELSEIF(ICASPL.EQ.'FLKS')THEN
          ADEF1=1.0
          ADEF2=50.0
          IDIST='FATIGUE LIFE'
        ELSEIF(ICASPL.EQ.'WAKS')THEN
          ADEF1=0.5
          ADEF2=25.0
          IDIST='WALD'
        ELSEIF(ICASPL.EQ.'E2KS')THEN
          ADEF1=1.0
          ADEF2=50.0
          IDIST='FRECHET'
        ELSEIF(ICASPL.EQ.'PAKS' .OR. ICASPL.EQ.'P2KS')THEN
          ADEF1=0.2
          ADEF2=5.0
          IDIST='PARETO'
          IF(ICASPL.EQ.'P2KS')IDIST='PARETO SECOND KIND'
C
          IHP='A   '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          ADEF1=1.0
          CALL PARCH2(IHP,IHP2,IDIST,A1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
          IF(A1.LE.0.0)A1=1.0
        ELSEIF(ICASPL.EQ.'P2KS')THEN
          ADEF1=0.2
          ADEF2=5.0
          IDIST='PARETO'
        ELSEIF(ICASPL.EQ.'DWKS')THEN
          ADEF1=0.5
          ADEF2=10.0
          IDIST='DOUBLE WEIBULL'
        ELSEIF(ICASPL.EQ.'DGKS')THEN
          ADEF1=0.5
          ADEF2=10.0
          IDIST='DOUBLE GAMMA'
        ELSEIF(ICASPL.EQ.'GVKS')THEN
          ALOWLM=CPUMIN
          ADEF1=-5.0
          ADEF2=5.0
          IDIST='GENERALIZED EXTREME VALUE'
        ELSEIF(ICASPL.EQ.'GZKS')THEN
          AUPPLM=5.0
          ADEF1=0.1
          ADEF2=2.5
          IDIST='GENERALIZED HALF LOGISTIC'
        ELSEIF(ICASPL.EQ.'G5KS')THEN
          ALOWLM=CPUMIN
          ADEF1=-5.0
          ADEF2=5.0
          IDIST='GENERALIZED LOGISTIC TYPE 5'
        ENDIF
        IHP='GAMM'
        IHP2='A1  '
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE1=ADEF1
C
        IHP='GAMM'
        IHP2='A2  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE2=ADEF2
      ELSEIF(ICASPL.EQ.'LNKS')THEN
C
        IDIST='LOGNORMAL'
        IHP='SIGM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE1=1.0
C
        IHP='SIGM'
        IHP2='A2  '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE2=25.0
      ELSEIF(ICASPL.EQ.'LAKS' .OR. ICASPL.EQ.'SDKS')THEN
C
        IF(ICASPL.EQ.'LAKS')THEN
          IDIST='TUKEY-LAMBDA'
          ADEF1=-2.0
          ADEF2=2.0
        ELSEIF(ICASPL.EQ.'SDKS')THEN
          IDIST='SKEW DOUBLE EXPONENTIAL'
          ADEF1=0.0
          ADEF2=10.0
        ENDIF
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE1=ADEF
C
        IHP='LAMB'
        IHP2='DA2 '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE2=ADEF
      ELSEIF(ICASPL.EQ.'TKS' .OR. ICASPL.EQ.'CSKS' .OR.
     1       ICASPL.EQ.'CHKS' .OR. ICASPL.EQ.'FTKS')THEN
C
        IF(ICASPL.EQ.'TKS')IDIST='T'
        IF(ICASPL.EQ.'CSKS')IDIST='CHI-SQUARE'
        IF(ICASPL.EQ.'CHKS')IDIST='CHI'
        IF(ICASPL.EQ.'FTKS')IDIST='FOLDED T'
        IHP='NU1 '
        IHP2='    '
        ALOWLM=1.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GAMMA1=1.0
        VALUE1=REAL(INT(VALUE1+0.5))
C
        IHP='NU2 '
        IHP2='    '
        ADEF=50.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')VALUE2=50.0
        IVAL1=INT(VALUE1+0.5)
        IVAL2=INT(VALUE2+0.5)
        ITEMP=ABS(IVAL2-IVAL1)+1
        IF(ITEMP.LE.NUMDIS)NUMDIS=ITEMP
      ELSEIF(ICASPL.EQ.'BRKS')THEN
        IDIST='BRADFORD'
        IHP='BETA'
        IHP2='1   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'REKS' .OR. ICASPL.EQ.'VMKS')THEN
        IF(ICASPL.EQ.'REKS')THEN
          IDIST='RECIPROCAL'
          ALOWLM=1.0
          LOWLTY='>   '
          ADEF1=1.5
          ADEF2=20.0
        ELSEIF(ICASPL.EQ.'VMKS')THEN
          IDIST='VON MISES'
          ALOWLM=0.0
          LOWLTY='>=  '
          ADEF1=0.5
          ADEF2=25.0
        ENDIF
        IHP='B1  '
        IHP2='    '
        AUPPLM=CPUMAX
        UPPLTY='<=  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='B2  '
        IHP2='    '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'ERKS' .OR. ICASPL.EQ.'LXKS' .OR.
     1       ICASPL.EQ.'GLKS' .OR. ICASPL.EQ.'G2KS' .OR.
     1       ICASPL.EQ.'G3KS')THEN
        IF(ICASPL.EQ.'ERKS')THEN
          IDIST='ERROR'
          ADEF1=1.1
          ADEF2=5.0
          ALOWLM=1.
        ELSEIF(ICASPL.EQ.'LXKS')THEN
          IDIST='LOG LAPLACE'
          ADEF1=0.5
          ADEF2=10.0
          ALOWLM=0.0
        ELSEIF(ICASPL.EQ.'GLKS')THEN
          IDIST='GENERALIZED LOGISTIC'
          ADEF1=0.2
          ADEF2=5.0
          ALOWLM=0.1
        ELSEIF(ICASPL.EQ.'G2KS')THEN
          IDIST='GENERALIZED LOGISTIC TYPE 2'
          ADEF1=0.1
          ADEF2=10.0
          ALOWLM=0.0
        ELSEIF(ICASPL.EQ.'G3KS')THEN
          IDIST='GENERALIZED LOGISTIC TYPE 3'
          ADEF1=0.1
          ADEF2=10.0
          ALOWLM=0.0
        ENDIF
        IHP='ALPH'
        IHP2='A1  '
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
C
        IHP='ALPH'
        IHP2='A2  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'TRKS' .OR. ICASPL.EQ.'PFKS')THEN
        IF(ICASPL.EQ.'TRKS')THEN
          IDIST='TRIANGULAR'
          ADEF1=-1.0
          ADEF2=1.0
          ALOWLM=-1.0
          AUPPLM=1.0
          LOWLTY='>=  '
        ELSEIF(ICASPL.EQ.'PFKS')THEN
          IDIST='POWER FUNCTION'
          ADEF1=0.5
          ADEF2=25.0
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
        ENDIF
        IHP='C1  '
        IHP2='    '
        UPPLTY='<=  '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='C2  '
        IHP2='    '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'PNKS' .OR. ICASPL.EQ.'WCKS')THEN
        IF(ICASPL.EQ.'PNKS')THEN
          IDIST='POWER NORMAL'
          AUPPLM=CPUMAX
          ADEF1=1.0
          ADEF2=50.0
          LOWLTY='>   '
          UPPLTY='<=  '
        ELSEIF(ICASPL.EQ.'WCKS')THEN
          IDIST='WRAPPED CAUCHY'
          AUPPLM=1.0
          ADEF1=0.0
          ADEF2=0.99
          LOWLTY='>=  '
          UPPLTY='<   '
        ENDIF
        IHP='P1  '
        IHP2='    '
        ALOWLM=0.
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF1,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='P2  '
        IHP2='    '
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF2,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'LLKS')THEN
        IDIST='LOG-LOGISTIC'
        IHP='DELT'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.2
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'ADKS')THEN
        IDIST='ASYMMETRIC LAPLACE'
        IF(IADEDF.EQ.'K')THEN
          IHP='K1  '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          ADEF=0.2
          CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ELSE
          IHP='MU1 '
          IHP2='    '
          ALOWLM=CPUMIN
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          ADEF=-5.0
          CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,ADEF,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ENDIF
      ELSE
        PPA0=0.0
        PPA1=1.0
        SHAPE1=1.0
        AMINKS=0.0
        GOTO9000
      ENDIF
C
C               ****************************************************
C               **  STEP 3--                                      **
C               **  GENERATE KS      PLOT FOR GIVEN DISTRIBUTION  **
C               ****************************************************
C
      ISTEPN='3'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBKS')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,213)N,VALUE1,VALUE2
  213   FORMAT('      N,VALUE1, VALUE2 = ',I8,2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ANUMDI=NUMDIS
      IFLAG=0
C
      DO2800IDIS=1,NUMDIS
C
        ICNT=0
        AIDIS=IDIS
        VALUE=VALUE1+((AIDIS-1.0)/(ANUMDI-1.0))*(VALUE2-VALUE1)
C
        IF(ICASPL.EQ.'WEKS')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)GOTO1500
C
          DO1011I=1,N
            ICNT=ICNT+1
            CALL WEIPPF(X(I),VALUE,MINMAX,X2(ICNT))
            Y2(ICNT)=Y(I)
 1011     CONTINUE
C
        ELSEIF(ICASPL.EQ.'LNKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
C
          DO1021I=1,N
            ICNT=ICNT+1
            CALL LGNPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1021     CONTINUE
C
        ELSEIF(ICASPL.EQ.'GAKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1031I=1,N
            ICNT=ICNT+1
            CALL GAMPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1031     CONTINUE
C
        ELSEIF(ICASPL.EQ.'GIKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1041I=1,N
            ICNT=ICNT+1
            CALL IGAPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1041     CONTINUE
C
        ELSEIF(ICASPL.EQ.'LGKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1051I=1,N
            ICNT=ICNT+1
            CALL LGAPPF(X(I),VALUE,ILGADF,X2(ICNT))
            Y2(ICNT)=Y(I)
 1051     CONTINUE
C
        ELSEIF(ICASPL.EQ.'IWKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1061I=1,N
            ICNT=ICNT+1
            CALL IWEPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1061     CONTINUE
C
        ELSEIF(ICASPL.EQ.'GEKS')THEN
          IF(IGEPDF.EQ.'JOHN')THEN
            IF(VALUE.LE.0.0)THEN
              AMIN=0.0
              AMAX=CPUMAX
            ELSE
              AMIN=0.0
              AMAX=(1.0/VALUE)
            ENDIF
          ELSE
            IF(VALUE.GE.0.0)THEN
              AMIN=0.0
              AMAX=CPUMAX
            ELSE
              AMIN=0.0
              AMAX=-(1.0/VALUE)
            ENDIF
          ENDIF
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1071I=1,N
            ICNT=ICNT+1
            CALL GEPPPF(X(I),VALUE,MINMAX,IGEPDF,X2(ICNT))
            Y2(ICNT)=Y(I)
 1071     CONTINUE
C
        ELSEIF(ICASPL.EQ.'TKS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1081I=1,N
            ICNT=ICNT+1
            CALL TPPF(X(I),INT(VALUE+0.5),X2(ICNT))
            Y2(ICNT)=Y(I)
 1081     CONTINUE
C
        ELSEIF(ICASPL.EQ.'CSKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1091I=1,N
            ICNT=ICNT+1
            CALL CHSPPF(X(I),INT(VALUE+0.5),X2(ICNT))
            Y2(ICNT)=Y(I)
 1091     CONTINUE
C
        ELSEIF(ICASPL.EQ.'CHKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1101I=1,N
            ICNT=ICNT+1
            CALL CHPPF(X(I),INT(VALUE+0.5),X2(ICNT))
            Y2(ICNT)=Y(I)
 1101     CONTINUE
C
        ELSEIF(ICASPL.EQ.'EEKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1111I=1,N
            ICNT=ICNT+1
            CALL GEEPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1111     CONTINUE
C
        ELSEIF(ICASPL.EQ.'FLKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1121I=1,N
            ICNT=ICNT+1
            CALL FLPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1121     CONTINUE
C
        ELSEIF(ICASPL.EQ.'E2KS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1131I=1,N
            ICNT=ICNT+1
            CALL EV2PPF(X(I),VALUE,MINMAX,X2(ICNT))
            Y2(ICNT)=Y(I)
 1131     CONTINUE
C
        ELSEIF(ICASPL.EQ.'WAKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1141I=1,N
            ICNT=ICNT+1
            CALL WALPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1141     CONTINUE
C
        ELSEIF(ICASPL.EQ.'PAKS')THEN
          AMU=A1
          IF(AMU.GT.XMIN)AMU=XMIN
          AMIN=AMU
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1151I=1,N
            ICNT=ICNT+1
            CALL PARPPF(X(I),VALUE,AMU,X2(ICNT))
            Y2(ICNT)=Y(I)
 1151     CONTINUE
C
        ELSEIF(ICASPL.EQ.'P2KS')THEN
          AMU=A1
          IF(AMU.GT.XMIN)AMU=XMIN
          AMIN=AMU
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1156I=1,N
            ICNT=ICNT+1
            CALL PA2PPF(X(I),VALUE,AMU,X2(ICNT))
            Y2(ICNT)=Y(I)
 1156     CONTINUE
C
        ELSEIF(ICASPL.EQ.'LAKS')THEN
          IF(VALUE.EQ.0.0)GOTO9000
          IF(VALUE.GT.0.0)THEN
            AMAX=ABS(1.0/VALUE)
            AMIN=-AMAX
          ELSE
            AMIN=CPUMIN
            AMAX=CPUMAX
          ENDIF
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1161I=1,N
            ICNT=ICNT+1
            CALL LAMPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1161     CONTINUE
C
        ELSEIF(ICASPL.EQ.'BRKS')THEN
          AMIN=0.0
          AMAX=1.0
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1171I=1,N
            ICNT=ICNT+1
            CALL BRAPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1171     CONTINUE
        ELSEIF(ICASPL.EQ.'REKS')THEN
          AMIN=1.0/VALUE
          AMAX=1.0
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1181I=1,N
            ICNT=ICNT+1
            CALL RECPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1181     CONTINUE
        ELSEIF(ICASPL.EQ.'ERKS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1191I=1,N
            ICNT=ICNT+1
            XIN=X(I)
            CALL ERRPPF(XIN,VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1191     CONTINUE
        ELSEIF(ICASPL.EQ.'TRKS')THEN
          AMIN=-1.0
          AMAX=1.0
          ZLOWLM=-1.0
          ZUPPLM=1.0
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1201I=1,N
            ICNT=ICNT+1
            CALL TRIPPF(X(I),VALUE,ZLOWLM,ZUPPLM,X2(ICNT))
            Y2(ICNT)=Y(I)
 1201     CONTINUE
        ELSEIF(ICASPL.EQ.'LLKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1211I=1,N
            ICNT=ICNT+1
            CALL LLGPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1211     CONTINUE
        ELSEIF(ICASPL.EQ.'DWKS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1221I=1,N
            ICNT=ICNT+1
            CALL DWEPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1221     CONTINUE
        ELSEIF(ICASPL.EQ.'FTKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1231I=1,N
            ICNT=ICNT+1
            CALL FTPPF(X(I),INT(VALUE+0.5),X2(ICNT))
            Y2(ICNT)=Y(I)
 1231     CONTINUE
        ELSEIF(ICASPL.EQ.'SDKS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1236I=1,N
            ICNT=ICNT+1
            CALL SDEPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1236     CONTINUE
        ELSEIF(ICASPL.EQ.'GVKS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
            IF(VALUE.GT.0.0)THEN
              AMIN=CPUMIN
              AMAX=(1.0/VALUE) - 0.1E-6
            ELSE
              AMIN=(1.0/VALUE) + 0.1E-6
              AMAX=CPUMAX
            ENDIF
          ELSE
            IF(VALUE.GT.0.0)THEN
              AMIN=(-1.0/VALUE) + 0.1E-6
              AMAX=CPUMAX
            ELSE
              AMIN=CPUMIN
              AMAX=(-1.0/VALUE) - 0.1E-6
            ENDIF
          ENDIF
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1241I=1,N
            ICNT=ICNT+1
            CALL GEVPPF(X(I),VALUE,MINMAX,X2(ICNT))
            Y2(ICNT)=Y(I)
 1241     CONTINUE
        ELSEIF(ICASPL.EQ.'LXKS')THEN
          AMIN=0.0
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1251I=1,N
            ICNT=ICNT+1
            CALL LDEPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1251     CONTINUE
        ELSEIF(ICASPL.EQ.'ADKS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1261I=1,N
            ICNT=ICNT+1
            CALL ADEPPF(X(I),VALUE,IADEDF,X2(ICNT))
            Y2(ICNT)=Y(I)
 1261     CONTINUE
        ELSEIF(ICASPL.EQ.'PFKS')THEN
          AMIN=0.0
          AMAX=1.0
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1271I=1,N
            ICNT=ICNT+1
            CALL POWPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1271     CONTINUE
        ELSEIF(ICASPL.EQ.'VMKS')THEN
          AMIN=-PI
          AMAX=PI
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1281I=1,N
            ICNT=ICNT+1
            CALL VONPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1281     CONTINUE
        ELSEIF(ICASPL.EQ.'WCKS')THEN
          AMIN=0.0
          AMAX=2.0*PI
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1291I=1,N
            ICNT=ICNT+1
            CALL WCAPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1291     CONTINUE
        ELSEIF(ICASPL.EQ.'GLKS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1301I=1,N
            ICNT=ICNT+1
            CALL GLOPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1301     CONTINUE
        ELSEIF(ICASPL.EQ.'GZKS')THEN
          AMIN=0.0
          AMAX=1.0/VALUE
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1311I=1,N
            ICNT=ICNT+1
            CALL HFLPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1311     CONTINUE
        ELSEIF(ICASPL.EQ.'DGKS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1321I=1,N
            ICNT=ICNT+1
            CALL DGAPPF(X(I),VALUE,X2(ICNT))
            Y2(ICNT)=Y(I)
 1321     CONTINUE
        ELSEIF(ICASPL.EQ.'PNKS')THEN
          S=1.0
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1331I=1,N
            ICNT=ICNT+1
            CALL PNRPPF(X(I),VALUE,S,X2(ICNT))
            Y2(ICNT)=Y(I)
 1331     CONTINUE
        ELSEIF(ICASPL.EQ.'G2KS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1341I=1,N
            ICNT=ICNT+1
            CALL GL2PPF(DBLE(X(I)),DBLE(VALUE),DPPF)
            X2(ICNT)=REAL(DPPF)
            Y2(ICNT)=Y(I)
 1341     CONTINUE
        ELSEIF(ICASPL.EQ.'G3KS')THEN
          AMIN=CPUMIN
          AMAX=CPUMAX
          IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
          DO1351I=1,N
            ICNT=ICNT+1
            CALL GL3PPF(DBLE(X(I)),DBLE(VALUE),DPPF)
            X2(ICNT)=REAL(DPPF)
            Y2(ICNT)=Y(I)
 1351     CONTINUE
        ENDIF
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  COMPUTE MAXIMUM PPCC TO FIND VALUE OF SHAPE **
C               **  PARAMETER AND THEN                          **
C               **  COMPUTE FITTED LINE TO PROBABILITY PLOT     **
C               **  TO ESTIMATE LOCATION AND SCALE              **
C               **************************************************
C
        ISTEPN='4'
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBKS')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 1500   CONTINUE
        NTEMP=ICNT
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBKS')THEN
          WRITE(ICOUT,2001)ICNT,NTEMP
 2001     FORMAT('ICNT,NTEMP = ',2I8)
          CALL DPWRST('XXX','BUG ')
          IF(NTEMP.GE.1)THEN
            DO2110I=1,NTEMP
              WRITE(ICOUT,2011)I,Y2(I),X2(I)
 2011         FORMAT('I,Y2(I),X2(I) = ',I8,2G15.7)
              CALL DPWRST('XXX','BUG ')
 2110       CONTINUE
          ENDIF
        ENDIF
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
        IF((KSLOC.EQ.CPUMIN .OR. KSSCAL.EQ.CPUMIN) .AND.
     1      IFLAG.EQ.0)THEN
C
C  HANDLE TUKEY-LAMBDA SEPARATELY
C
           IF(ICASPL.EQ.'LAKS' .AND. VALUE.GT.0.0)THEN
             CALL LINFI2(Y2,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=VALUE*ABS(XMAX-A0TEMP) + 0.1
                ATEMP2=VALUE*ABS(XMIN-A0TEMP) + 0.1
                A1TEMP=MAX(ATEMP1,ATEMP2)
             ENDIF
C
C  HANDLE VON-MISES, WRAPPED CAUCHY SEPARATELY
C
           ELSEIF(ICASPL.EQ.'VMKS' .OR. ICASPL.EQ.'WCKS')THEN
             CALL LINFI2(Y2,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
                A1TEMP=(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
           ELSEIF(AMIN.GT.CPUMIN .AND. AMAX.LT.CPUMAX)THEN
             CALL LINFI2(Y2,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
               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,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(Y2,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(Y2,X2,NTEMP,
     1                   A0TEMP,A1TEMP,
     1                   ISUBRO,IBUGG3,IERROR)
           ENDIF
C
        ELSE
          A0TEMP=KSLOC
          A1TEMP=KSSCAL
        ENDIF
C
        J=1
        X3(J)=Y(1)
        Y3(J)=0.0
        J=2
        X3(J)=Y(1)
        Y3(J)=1.0/REAL(N)
        DO200I=2,N
          J=J+1
          X3(J)=Y(I)
          Y3(J)=REAL(I-1)/REAL(N)
          J=J+1
          X3(J)=Y(I)
          Y3(J)=REAL(I)/REAL(N)
  200   CONTINUE
        NTEMP=J
C
        PPA0=A0TEMP
        PPA1=A1TEMP
        DM=0.0D0
C
        IF(ICASPL.EQ.'WEKS')THEN
          DO1610I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL WEICDF(XL,VALUE,MINMAX,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1610     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'LNKS')THEN
          DO1620I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL LGNCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1620     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'GAKS')THEN
          DO1630I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL GAMCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1630     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'GIKS')THEN
          DO1640I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL IGACDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1640     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'LGKS')THEN
          DO1650I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL LGACDF(XL,VALUE,ILGADF,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1650     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'IWKS')THEN
          DO1660I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL IWECDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1660     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'GEKS')THEN
          DO1670I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL GEPCDF(XL,VALUE,MINMAX,IGEPDF,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1670     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'TKS')THEN
          DO1680I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL TCDF(XL,INT(VALUE+0.5),XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1680     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'CSKS')THEN
          DO1690I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL CHSCDF(XL,INT(VALUE+0.5),XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1690     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'CHKS')THEN
          DO1700I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL CHCDF(XL,INT(VALUE+0.5),XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1700     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'EEKS')THEN
          DO1710I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL GEECDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1710     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'FLKS')THEN
          DO1720I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL FLCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1720     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'WAKS')THEN
          DO1730I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL WALCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1730     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'E2KS')THEN
          DO1740I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL EV2CDF(XL,VALUE,MINMAX,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1740     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'PAKS')THEN
          AMU=A1
          IF(AMU.GT.XMIN)AMU=XMIN
          DO1750I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL PARCDF(XL,VALUE,AMU,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1750     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'P2KS')THEN
          AMU=A1
          IF(AMU.GT.XMIN)AMU=XMIN
          DO1755I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL PA2CDF(XL,VALUE,AMU,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1755     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'LAKS')THEN
          DO1760I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL LAMCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1760     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'BRKS')THEN
          DO1770I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL BRACDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1770     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'REKS')THEN
          DO1780I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL RECCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1780     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'ERKS')THEN
          DO1790I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL ERRCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1790     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'TRKS')THEN
          ZLOWLM=PPA0
          ZUPPLIM=PPA0 + PPA1
          DO1800I=1,NTEMP
            XL=X3(I)
CCCCC       XL=(XL-PPA0)/PPA1
            CALL TRICDF(XL,VALUE,ZLOWLM,ZUPPLM,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1800     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'LLKS')THEN
          DO1810I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL LLGCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1810     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'DWKS')THEN
          DO1820I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL DWECDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1820     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'FTKS')THEN
          DO1830I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL FTCDF(XL,INT(VALUE+0.5),XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1830     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'SDKS')THEN
          DO1840I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL SDECDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1840     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'GVKS')THEN
          DO1850I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL GEVCDF(XL,VALUE,MINMAX,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1850     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'ADKS')THEN
          DO1860I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL ADECDF(XL,VALUE,IADEDF,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1860     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'LXKS')THEN
          DO1870I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL LDECDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1870     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'PFKS')THEN
          DO1880I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL POWCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1880     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'VMKS')THEN
          DO1890I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL VONCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1890     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'WCKS')THEN
          DO1900I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL WCACDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1900     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'GLKS')THEN
          DO1910I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL GLOCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1910     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'GZKS')THEN
          DO1920I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL HFLCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1920     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'DGKS')THEN
          DO1930I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL DGACDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1930     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'PNKS')THEN
          DO1940I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL PNRCDF(XL,VALUE,XOUT1)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1940     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'G2KS')THEN
          DO1950I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL GL2CDF(DBLE(XL),DBLE(VALUE),DPPF)
            XOUT1=REAL(DPPF)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1950     CONTINUE
          STAT=REAL(DM)
        ELSEIF(ICASPL.EQ.'G3KS')THEN
          DO1960I=1,NTEMP
            XL=X3(I)
            XL=(XL-PPA0)/PPA1
            CALL GL3CDF(DBLE(XL),DBLE(VALUE),DPPF)
            XOUT1=REAL(DPPF)
            DTEMP1=DBLE(Y3(I))
            DTEMP2=DBLE(XOUT1)
            DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1960     CONTINUE
          STAT=REAL(DM)
        ENDIF
C
        IF(STAT.LT.AMINKS)THEN
          AMINKS=STAT
          SHAPE1=VALUE
          PPA0SV=PPA0
          PPA1SV=PPA1
        ENDIF
C
 2800 CONTINUE
C
C               **************************************************
C               **  STEP 5--                                    **
C               **  COMPUTE SELECTED PERCENTILES                **
C               **************************************************
C
      ISTEPN='5'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBKS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NPERC.GT.0)THEN
        IF(ICASPL.EQ.'WEKS')THEN
          DO4110I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL WEIPPF(QPTEMP,SHAPE1,MINMAX,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4110     CONTINUE
        ELSEIF(ICASPL.EQ.'LNKS')THEN
          DO4120I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LGNPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4120     CONTINUE
        ELSEIF(ICASPL.EQ.'GAKS')THEN
          DO4130I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GAMPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4130     CONTINUE
        ELSEIF(ICASPL.EQ.'GIKS')THEN
          DO4140I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL IGAPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4140     CONTINUE
        ELSEIF(ICASPL.EQ.'LGKS')THEN
          DO4150I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LGAPPF(QPTEMP,SHAPE1,ILGADF,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4150     CONTINUE
        ELSEIF(ICASPL.EQ.'GEKS')THEN
          DO4160I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GEPPPF(QPTEMP,SHAPE1,MINMAX,IGEPDF,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4160     CONTINUE
        ELSEIF(ICASPL.EQ.'IWKS')THEN
          DO4170I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL IWEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4170     CONTINUE
        ELSEIF(ICASPL.EQ.'CSKS')THEN
          DO4180I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL CHSPPF(QPTEMP,INT(SHAPE1+0.5),XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4180     CONTINUE
        ELSEIF(ICASPL.EQ.'CHKS')THEN
          DO4190I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL CHPPF(QPTEMP,INT(SHAPE1+0.5),XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4190     CONTINUE
        ELSEIF(ICASPL.EQ.'TKS')THEN
          DO4200I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL TPPF(QPTEMP,INT(SHAPE1+0.5),XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4200     CONTINUE
        ELSEIF(ICASPL.EQ.'EEKS')THEN
          DO4210I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GEEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4210     CONTINUE
        ELSEIF(ICASPL.EQ.'FLKS')THEN
          DO4220I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL FLPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4220     CONTINUE
        ELSEIF(ICASPL.EQ.'E2KS')THEN
          DO4230I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL EV2PPF(QPTEMP,SHAPE1,MINMAX,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4230     CONTINUE
        ELSEIF(ICASPL.EQ.'WAKS')THEN
          DO4240I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL WALPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4240     CONTINUE
        ELSEIF(ICASPL.EQ.'PAKS')THEN
          DO4250I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL PARPPF(QPTEMP,SHAPE1,AMU,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4250     CONTINUE
        ELSEIF(ICASPL.EQ.'P2KS')THEN
          DO4255I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL PA2PPF(QPTEMP,SHAPE1,AMU,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4255     CONTINUE
        ELSEIF(ICASPL.EQ.'LAKS')THEN
          DO4260I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LAMPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4260     CONTINUE
        ELSEIF(ICASPL.EQ.'BRKS')THEN
          DO4270I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL BRAPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4270     CONTINUE
        ELSEIF(ICASPL.EQ.'REKS')THEN
          DO4280I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL RECPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4280     CONTINUE
        ELSEIF(ICASPL.EQ.'ERKS')THEN
          DO4290I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL ERRPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4290     CONTINUE
        ELSEIF(ICASPL.EQ.'TRKS')THEN
          ZLOWLM=PPA0
          ZUPPLM=PPA0 + PPA1
          DO4300I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL TRIPPF(QPTEMP,SHAPE1,ZLOWLM,ZUPPLM,XPERC(I))
CCCCC       XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4300     CONTINUE
        ELSEIF(ICASPL.EQ.'LLKS')THEN
          DO4310I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LLGPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4310     CONTINUE
        ELSEIF(ICASPL.EQ.'DWKS')THEN
          DO4320I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL DWEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4320     CONTINUE
        ELSEIF(ICASPL.EQ.'FTKS')THEN
          DO4330I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL FTPPF(QPTEMP,INT(SHAPE1+0.5),XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4330     CONTINUE
        ELSEIF(ICASPL.EQ.'SDKS')THEN
          DO4340I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL SDEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4340     CONTINUE
        ELSEIF(ICASPL.EQ.'ADKS')THEN
          DO4350I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL ADEPPF(QPTEMP,SHAPE1,IADEDF,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4350     CONTINUE
        ELSEIF(ICASPL.EQ.'GVKS')THEN
          DO4360I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GEVPPF(QPTEMP,SHAPE1,MINMAX,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4360     CONTINUE
        ELSEIF(ICASPL.EQ.'LXKS')THEN
          DO4370I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL LDEPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4370     CONTINUE
        ELSEIF(ICASPL.EQ.'PFKS')THEN
          DO4380I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL POWPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4380     CONTINUE
        ELSEIF(ICASPL.EQ.'VMKS')THEN
          DO4390I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL VONPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4390     CONTINUE
        ELSEIF(ICASPL.EQ.'WCKS')THEN
          DO4400I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL WCAPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4400     CONTINUE
        ELSEIF(ICASPL.EQ.'GLKS')THEN
          DO4410I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GLOPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4410     CONTINUE
        ELSEIF(ICASPL.EQ.'GZKS')THEN
          DO4420I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL HFLPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4420     CONTINUE
        ELSEIF(ICASPL.EQ.'DGKS')THEN
          DO4430I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL DGAPPF(QPTEMP,SHAPE1,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4430     CONTINUE
        ELSEIF(ICASPL.EQ.'PNKS')THEN
          S=1.0
          DO4440I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL PNRPPF(QPTEMP,SHAPE1,S,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4440     CONTINUE
        ELSEIF(ICASPL.EQ.'G2KS')THEN
          DO4450I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GL2PPF(DBLE(QPTEMP),DBLE(SHAPE1),DPPF)
            XPERC(I)=REAL(DPPF)
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4450     CONTINUE
        ELSEIF(ICASPL.EQ.'G3KS')THEN
          DO4460I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GL3PPF(DBLE(QPTEMP),DBLE(SHAPE1),DPPF)
            XPERC(I)=REAL(DPPF)
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4460     CONTINUE
        ENDIF
      ENDIF
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBK2(Y,X,N,
     1ICASPL,IMETHD,IPPCDP,MAXOBV,MINMAX,
     1Y2,X2,Y3,X3,
     1NHOR1,NHOR2,KSLOC,KSSCAL,
     1QP,XPERC,NPERC,
     1PPA0SV,PPA1SV,SHAPE1,SHAPE2,AMINKS,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN BOOTSTRAP SAMPLE, GENERATE THE KS PLOT
C              TO ESTIMATE THE TWO SHAPE, LOCATION, AND SCALE
C              PARAMETERS.  THE LOCATION AND SCALE PARAMETERS CAN
C              OPTIONALLY BE SPECIFIED IN ADVANCE.  ONLY UNCENSORED
C              DATA IS CURRENTLY SUPPORTED.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C              SUPPORTED DISTRIBUTIONS ARE:
C
C              FOLLOWING ARE ACTIVE
C               1) G-AND-H
C               2) INVERSE GAUSSIAN
C               3) GENERALIZED GAMMA
C               4) BETA
C               5) F
C               6) FOLDED NORMAL
C
C              FOLLOWING ARE DISTRIBUTIONS THAT COULD POTENTIALLY
C              BE ADDED
C               7) GOMPERTZ
C               8) EXPONENTIAL POWER
C               9) POWER LOGNORMAL
C              10) ALPHA
C              11) EXPONENTIATED WEIBULL
C              12) JOHNSON SB
C              13) JOHNSON SU
C              14) TWO-SIDED POWER
C              15) RECIPROCAL INVERSE GAUSSIAN
C              16) SKEW T
C              17) INVERTED BETA
C              18) LOG-SKEW-NORMAL
C              19) NON-CENTRAL T
C              20) NON-CENTRAL CHI-SQUARE
C              21) FOLDED CAUCHY
C              22) TRUNCATED EXPONENTIAL
C                  (ASSUME TRUNCATION POINT X0 IS KNOWN)
C              23) GOMPERTZ-MAKEHAM (FOR MEEKER REPARAMETERIZATION TO
C                  CASE WITH TWO SHAPE PARAMETERS AND SCALE PARAMETER)
C              24) GENERALIZED ASYMMETRIC LAPLACE
C              25) GENERALIZED MCLEISH
C              26) GENERALIZED LAMBDA
C                  NOTE: STILL BEING TESTED
C              27) HYPERBOLIC (NOT WORKING)
C
C             FOR THE KS PLOT, ONLY UNCENSORED DATA IS CURRENTLY
C             SUPPORTED.
C
C------------------------------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IMETHD
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION Y3(*)
      DIMENSION X3(*)
      DIMENSION QP(*)
      DIMENSION XPERC(*)
C
      REAL KSLOC
      REAL KSSCAL
C
      DOUBLE PRECISION DP
      DOUBLE PRECISION DPPF
C
      DOUBLE PRECISION DM
      DOUBLE PRECISION DTEMP1
      DOUBLE PRECISION DTEMP2
C
      CHARACTER*30 IDIST
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 LOWLTY
      CHARACTER*4 UPPLTY
C
      INCLUDE 'DPCOMC.INC'
C
C-------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPJB'
      ISUBN2='K2  '
      IWRITE='OFF'
      IF(NP.GT.0)THEN
        DO410I=1,NP
          XPERC(I)=0.0
  410   CONTINUE
      ENDIF
      AMINKS=CPUMAX
C
      IF(ICASPL.EQ.'P2KS' .OR. ICASPL.EQ.'PAKS')THEN
        IF(KSLOC.EQ.CPUMIN .AND.  KSSCAL.EQ.CPUMIN)THEN
          KSLOC=0.0
          KSSCAL=1.0
        ENDIF
      ENDIF

C               **************************************************
C               **  STEP 1--                                    **
C               **  IF SET PPCC      Y PLOT DATA POINTS COMMAND **
C               **  WAS ENTERED, THIN DATA SET BY COMPUTING     **
C               **  PERCENTILES OF THE DATA.  ONLY DO THIS FOR  **
C               **  THE UNCENSORED CASE.                        **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBK2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPPCDP.GT.0)THEN
        NP=MAX(20,IPPCDP)
        NP=MIN(NP,N)
        CALL SORT(Y,N,Y2)
        ASTRT=0.0
        ASTOP=100.0
        AINC=(ASTOP - ASTRT)/REAL(NP+1)
        IWRITE='OFF'
        DO100I=1,NP
          P100=ASTRT + REAL(I)*AINC
          CALL PERCEN(P100,Y2,N,IWRITE,X3,MAXOBV,
     1                APERC,IBUGG3,IERROR)
          X2(I)=APERC
  100   CONTINUE
        N=NP
        DO105I=1,N
          Y(I)=X2(I)
  105   CONTINUE
      ENDIF
C
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBK2')THEN
        WRITE(ICOUT,113)IPPCDP,NP,N
  113   FORMAT('      IPPCDP, NP, 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
C
  999 FORMAT(1X)
C
      CALL MEDIAN(Y,N,IWRITE,X2,MAXOBV,XMED,IBUGG3,IERROR)
      CALL SORT(Y,N,Y)
      CALL UNIMED(N,X)
      XMIN=Y(1)
      XMAX=Y(N)
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  EXTRACT RANGE FOR SHAPE PARAMETER             **
C               ****************************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBK2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICNT=0
      AMINKS=CPUMAX
C
      IF(ICASPL.EQ.'GHKS')THEN
C
        NUMDI1=21
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=41
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='G-H'
        IHP='G1  '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=   '
        UPPLTY='<=  '
        ADEF=-1.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='G2  '
        IHP2='    '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              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,VALUE3,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='H2  '
        IHP2='    '
        ADEF=1.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'FKS')THEN
C
        IDIST='F '
        IHP='NU11'
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        IDEF=1
        CALL PARCI2(IHP,IHP2,IDIST,IVAL1,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,IVAL2,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,IVAL3,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,IVAL4,IDEF,ILOWLM,IUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        VALUE1=REAL(IVAL1)
        VALUE2=REAL(IVAL2)
        VALUE3=REAL(IVAL3)
        VALUE4=REAL(IVAL4)
C
        NUMDI1=IVAL2 - IVAL1 + 1
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        IF(NUMDI1.LT.10)NUMDI1=10
        ANMDI1=NUMDI1
        NUMDI2=IVAL4 - IVAL3 + 1
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        IF(NUMDI2.LT.10)NUMDI2=10
        ANMDI2=NUMDI2
C
      ELSEIF(ICASPL.EQ.'IGKS')THEN
C
        NUMDI1=50
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=50
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='INVERSE GAUSSIAN'
        IHP='GAMM'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,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,VALUE3,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,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'BEKS')THEN
C
        NUMDI1=25
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=25
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='BETA'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,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,VALUE3,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,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'GGKS')THEN
C
        NUMDI1=25
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=25
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='GENERALIZED GAMMA'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        ADEF=0.5
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,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,VALUE3,ADEF,ALOWLM,AUPPLM,
     1              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,VALUE2,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(ICASPL.EQ.'FNKS')THEN
C
        NUMDI1=51
        IF(NHOR1.GT.0)NUMDI1=NHOR1
        ANMDI1=NUMDI1
        NUMDI2=51
        IF(NHOR2.GT.0)NUMDI2=NHOR2
        ANMDI2=NUMDI2
        IF(NHOR1.GT.0)NUMDIS=NHOR1
C
        IDIST='FOLDED NORMAL'
        IHP='MU1 '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        ADEF=-25.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE1,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,VALUE2,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,VALUE3,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD2 '
        IHP2='    '
        ADEF=25.0
        CALL PARCH2(IHP,IHP2,IDIST,VALUE4,ADEF,ALOWLM,AUPPLM,
     1              LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSE
        PPA0=0.0
        PPA1=1.0
        SHAPE1=1.0
        CORRMX=0.0
        GOTO9000
      ENDIF
C
C               ****************************************************
C               **  STEP 3--                                      **
C               **  GENERATE KS      PLOT FOR GIVEN DISTRIBUTION  **
C               ****************************************************
C
      ISTEPN='3'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBK2')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,213)N,VALUE1,VALUE2
  213   FORMAT('      N,VALUE1, VALUE2 = ',I8,2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IFLAG=0
      ANUMDI=NUMDI1
      ANUMD2=NUMDI2
      DP=-1.0D0
      DPPF=0.0D0
C
      DO1800IDIS=1,NUMDI1
C
        AIDIS=IDIS
        VAL1=VALUE1+((AIDIS-1.0)/(ANUMDI-1.0))*(VALUE2-VALUE1)
C
        DO1890IDIS2=1,NUMDI2
          AIDI2=IDIS2
          VAL2=VALUE3+((AIDI2-1.0)/(ANUMD2-1.0))*(VALUE4-VALUE3)
          ICNT=0
C
          IF(ICASPL.EQ.'GHKS')THEN
            AMIN=CPUMIN
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
C
            DO1011I=1,N
              ICNT=ICNT+1
              CALL GHPPF(X(I),VAL1,VAL2,X2(ICNT),DBLE(X(I)),DPPF)
              Y2(ICNT)=Y(I)
 1011       CONTINUE
C
          ELSEIF(ICASPL.EQ.'FKS')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
C
            DO1021I=1,N
              ICNT=ICNT+1
              CALL FPPF(X(I),INT(VAL1+0.5),INT(VAL2+0.5),X2(ICNT))
              Y2(ICNT)=Y(I)
 1021       CONTINUE
C
          ELSEIF(ICASPL.EQ.'IGKS')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
C
            DO1031I=1,N
              ICNT=ICNT+1
              CALL IGPPF(X(I),VAL1,VAL2,X2(ICNT))
              Y2(ICNT)=Y(I)
 1031       CONTINUE
C
          ELSEIF(ICASPL.EQ.'GGKS')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
C
            DO1041I=1,N
              ICNT=ICNT+1
              CALL GGDPPF(X(I),VAL1,VAL2,X2(ICNT))
              Y2(ICNT)=Y(I)
 1041       CONTINUE
C
          ELSEIF(ICASPL.EQ.'BEKS')THEN
            AMIN=0.0
            AMAX=1.0
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
C
            DO1051I=1,N
              ICNT=ICNT+1
              CALL BETPPF(X(I),VAL1,VAL2,X2(ICNT))
              Y2(ICNT)=Y(I)
 1051       CONTINUE
C
          ELSEIF(ICASPL.EQ.'FNKS')THEN
            AMIN=0.0
            AMAX=CPUMAX
            IF(KSLOC.NE.CPUMIN .AND.  KSSCAL.NE.CPUMIN)GOTO1500
C
            DO1061I=1,N
              ICNT=ICNT+1
              CALL FNRPPF(X(I),VAL1,VAL2,X2(ICNT))
              Y2(ICNT)=Y(I)
 1061       CONTINUE
C
          ENDIF
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  COMPUTE MINIMUM KS   TO FIND VALUE OF SHAPE **
C               **  PARAMETERS AND THEN                         **
C               **  COMPUTE FITTED LINE TO PROBABILITY PLOT     **
C               **  TO ESTIMATE LOCATION AND SCALE              **
C               **************************************************
C
          ISTEPN='4'
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBK2')
     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 1500     CONTINUE
          NTEMP=ICNT
C
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBK2')THEN
            WRITE(ICOUT,2001)ICNT,NTEMP
 2001       FORMAT('ICNT,NTEMP = ',2I8)
            CALL DPWRST('XXX','BUG ')
            IF(NTEMP.GE.1)THEN
              DO2110I=1,NTEMP
                WRITE(ICOUT,2011)I,Y2(I),X2(I)
 2011           FORMAT('I,Y2(I),X2(I) = ',I8,2G15.7)
                CALL DPWRST('XXX','BUG ')
 2110         CONTINUE
            ENDIF
          ENDIF
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
          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 CASE WHERE DOMAIN BOUNDED BOTH ABOVE AND BELOW.  SOLVE
C
C     (XMIN-A0)/A1 = AMIN
C     (XMAX-A0)/A1 = AMAX
C
             ELSEIF(AMIN.GT.CPUMIN .AND. AMAX.LT.CPUMAX)THEN
               CALL LINFI2(Y2,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
                 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,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(Y2,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(Y2,X2,NTEMP,
     1                     A0TEMP,A1TEMP,
     1                     ISUBRO,IBUGG3,IERROR)
             ENDIF
C
          ELSE
            A0TEMP=KSLOC
            A1TEMP=KSSCAL
          ENDIF
C
          J=1
          X3(J)=Y(1)
          Y3(J)=0.0
          J=2
          X3(J)=Y(1)
          Y3(J)=1.0/REAL(N)
          DO200I=2,N
            J=J+1
            X3(J)=Y(I)
            Y3(J)=REAL(I-1)/REAL(N)
            J=J+1
            X3(J)=Y(I)
            Y3(J)=REAL(I)/REAL(N)
  200     CONTINUE
          NTEMP=J
C
          PPA0=A0TEMP
          PPA1=A1TEMP
          DM=0.0D0
C
          IF(ICASPL.EQ.'GHKS')THEN
            DO1610I=1,NTEMP
              XL=X3(I)
              XL=(XL-PPA0)/PPA1
              CALL GHCDF(XL,VAL1,VAL2,XOUT1)
              DTEMP1=DBLE(Y3(I))
              DTEMP2=DBLE(XOUT1)
              DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1610       CONTINUE
            STAT=REAL(DM)
          ELSEIF(ICASPL.EQ.'IGKS')THEN
            DO1620I=1,NTEMP
              XL=X3(I)
              XL=(XL-PPA0)/PPA1
              CALL IGCDF(XL,VAL1,VAL2,XOUT1)
              DTEMP1=DBLE(Y3(I))
              DTEMP2=DBLE(XOUT1)
              DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1620       CONTINUE
            STAT=REAL(DM)
          ELSEIF(ICASPL.EQ.'GDKS')THEN
            DO1630I=1,NTEMP
              XL=X3(I)
              XL=(XL-PPA0)/PPA1
              CALL GGDCDF(XL,VAL1,VAL2,XOUT1)
              DTEMP1=DBLE(Y3(I))
              DTEMP2=DBLE(XOUT1)
              DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1630       CONTINUE
            STAT=REAL(DM)
          ELSEIF(ICASPL.EQ.'BEKS')THEN
            DO1640I=1,NTEMP
              XL=X3(I)
              XL=(XL-PPA0)/PPA1
              CALL BETCDF(XL,VAL1,VAL2,XOUT1)
              DTEMP1=DBLE(Y3(I))
              DTEMP2=DBLE(XOUT1)
              DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1640       CONTINUE
            STAT=REAL(DM)
          ELSEIF(ICASPL.EQ.'FKS')THEN
            DO1650I=1,NTEMP
              XL=X3(I)
              XL=(XL-PPA0)/PPA1
              CALL FCDF(XL,VAL1,VAL2,XOUT1)
              DTEMP1=DBLE(Y3(I))
              DTEMP2=DBLE(XOUT1)
              DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1650       CONTINUE
            STAT=REAL(DM)
          ELSEIF(ICASPL.EQ.'FNKS')THEN
            DO1660I=1,NTEMP
              XL=X3(I)
              XL=(XL-PPA0)/PPA1
              CALL FNRCDF(XL,VAL1,VAL2,XOUT1)
              DTEMP1=DBLE(Y3(I))
              DTEMP2=DBLE(XOUT1)
              DM=MAX(DABS(DTEMP1-DTEMP2),DM)
 1660       CONTINUE
            STAT=REAL(DM)
          ENDIF
C
          IF(STAT.LT.AMINKS)THEN
            AMINKS=STAT
            SHAPE1=VAL1
            SHAPE2=VAL2
            PPA0SV=PPA0
            PPA1SV=PPA1
          ENDIF
C
 1890   CONTINUE
 1800 CONTINUE
C
C               **************************************************
C               **  STEP 5--                                    **
C               **  COMPUTE SELECTED PERCENTILES                **
C               **************************************************
C
      ISTEPN='5'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBK2')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NPERC.GT.0)THEN
        IF(ICASPL.EQ.'GHKS')THEN
          DO4110I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GHPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I),DBLE(QPTEMP),DPPF)
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4110     CONTINUE
        ELSEIF(ICASPL.EQ.'IGKS')THEN
          DO4120I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL IGPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4120     CONTINUE
        ELSEIF(ICASPL.EQ.'GGKS')THEN
          DO4130I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GGDPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4130     CONTINUE
        ELSEIF(ICASPL.EQ.'BEKS')THEN
          DO4140I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL BETPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4140     CONTINUE
        ELSEIF(ICASPL.EQ.'FKS')THEN
          DO4150I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL FPPF(QPTEMP,INT(SHAPE1+0.5),INT(SHAPE2+0.5),XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4150     CONTINUE
        ELSEIF(ICASPL.EQ.'FNKS')THEN
          DO4160I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL FNRPPF(QPTEMP,SHAPE1,SHAPE2,XPERC(I))
            XPERC(I)=PPA0SV + PPA1SV*XPERC(I)
 4160     CONTINUE
        ENDIF
      ENDIF
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBML(Y,X,N,ICASPL,ICENSO,MAXNXT,MINMAX,
     1Y2,X2,
     1DTEMP1,
     1ALOC,SCALE,
     1QP,XQP,NP,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN BOOTSTRAP SAMPLE, GENERATE MAXIMUM
C              LIKELIHOOD ESTIMATES FOR LOCATION (ALOC) AND
C              SCALE (SCALE).  CENSORED ML ESTIMATES ARE SUPPORTED
C              FOR A FEW DISTRIBUTIONS
C
C              SUPPORTED DISTRIBUTIONS ARE:
C
C              1) NORMAL
C              2) UNIFORM
C              3) CAUCHY
C              4) LAPLACE (DOUBLE EXPONENTIAL)
C              5) LOGISTIC
C              6) GUMBEL (EXTREME VALUE TYPE 1)
C              7) EXPONENTIAL
C              8) RAYLEIGH
C              9) FOLDED NORMAL
C             10) MAXWELL
C
C              1) CENSORED NORMAL
C              2) CENSORED EXPONENTIAL
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/1
C     ORIGINAL VERSION--JANUARY   2005.
C     UPDATED         --AUGUST    2005. ADD MAXWELL
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICENSO
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
      CHARACTER*4 ICENS2
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION QP(*)
      DIMENSION XQP(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DTEMP
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DX
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DAE
      DOUBLE PRECISION DRE
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
      DOUBLE PRECISION XLOWSV
      DOUBLE PRECISION XUPSV
C
      INTEGER IN 
      DOUBLE PRECISION XBAR
      COMMON/EV1CO2/XBAR,MINMX2,IN
      COMMON/NORCML/IR
C
      DOUBLE PRECISION EV1FU2
      EXTERNAL LOGFUN
      EXTERNAL CAUFUN
      EXTERNAL EV1FU2
      EXTERNAL NORFUN
C
      EXTERNAL FNRFUN
      EXTERNAL RANGE
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
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.14159265358979/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPJB'
      ISUBN2='ML  '
      IWRITE='OFF'
      IF(NP.GT.0)THEN
        DO410I=1,NP
          XQP(I)=0.0
  410   CONTINUE
      ENDIF
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  PROCESS THE CENSORING VARIABLE.             **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBML')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1000I=1,N
        Y2(I)=Y(I)
 1000 CONTINUE
C
      IF(ICENSO.EQ.'ON')THEN
        IR=0
        CALL DISTIN(X,N,IWRITE,X2,NDIST,IBUGG3,IERROR)
        IF(NDIST.EQ.1)THEN
          DO1102I=1,N
            X(I)=1.0
 1102     CONTINUE
          IR=N
        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)THEN
                X(I)=2.0
              ELSE
                IR=IR+1
              ENDIF
 1103       CONTINUE
          ELSE
            ATEMP1=MIN(X2(1),X2(2))
            ATEMP2=MAX(X2(1),X2(2))
            DO1108I=1,N
              IF(X(I).EQ.ATEMP1)THEN
                IR=IR+1
                X(I)=1.0
              ENDIF
              IF(X(I).EQ.ATEMP2)X(I)=2.0
 1108       CONTINUE
          ENDIF
        ELSE
          WRITE(ICOUT,999)
  999     FORMAT(1X)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1104)
 1104     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          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(Y2,X,N,Y,X)
      ELSE
        CALL SORT(Y2,N,Y)
      ENDIF
      ICENS2=ICENSO
      IF(IR.EQ.N)ICENS2='OFF'
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  GENERATE MAXIMUM LIKELIHOOD ESTIMATES         **
C               **  FOR GIVEN DISTRIBUTION                        **
C               ****************************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBML')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'UNML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1201)
 1201     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1203)
 1203     FORMAT('      CENSORING NOT SUPPORTED FOR THE UNIFORM ',
     1           'DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MIDRAN(Y,N,IWRITE,XMIDR,IBUGG3,IERROR)
          CALL RANGE(Y,N,IWRITE,XRANG,IBUGG3,IERROR)
          HHAT=0.5*XRANG
          AHAT=XMIDR
          ALOC=AHAT - HHAT
          SCALE=AHAT + HHAT
        ENDIF
      ELSEIF(ICASPL.EQ.'NOML')THEN
        IF(ICENS2.EQ.'ON')THEN
          IF(IR.LT.1)THEN
            IERROR='YES'
          ELSE
            CALL MEAN(Y,IR,IWRITE,XMEAN,IBUGG3,IERROR)
            CALL SD(Y,IR,IWRITE,XSD,IBUGG3,IERROR)
            XPAR(1)=DBLE(XMEAN)
            XPAR(2)=DBLE(XSD)
            IOPT=2
            TOL=1.0D-6
            NVAR=2
            NPRINT=-1
            INFO=0
            LWA=MAXNXT
            CALL DNSQE(NORFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,
     1             NPRINT,INFO,
     1             DTEMP1,MAXNXT,Y,N)
            ALOC=REAL(XPAR(1))
            SCALE=REAL(XPAR(2))
          ENDIF
        ELSE
          CALL MEAN(Y,N,IWRITE,ALOC,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,SCALE,IBUGG3,IERROR)
        ENDIF
      ELSEIF(ICASPL.EQ.'LOML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1201)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1211)
 1211     FORMAT('      CENSORING NOT SUPPORTED FOR THE LOGISTIC ',
     1           'DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
          XPAR(1)=DBLE(XMEAN)
          XPAR(2)=DBLE((SQRT(3.0)/PI)*XSD)
          IOPT=2
          TOL=1.0D-6
          NVAR=2
          NPRINT=-1
          INFO=0
          LWA=MAXNXT
          CALL DNSQE(LOGFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1               DTEMP1,MAXNXT,Y,N)
C
          ALOC=REAL(XPAR(1))
          SCALE=REAL(XPAR(2))
        ENDIF
      ELSEIF(ICASPL.EQ.'LAML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1201)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1213)
 1213     FORMAT('      CENSORING NOT SUPPORTED FOR THE LAPLACE ',
     1           'DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MEDIAN(Y,N,IWRITE,X2,MAXNXT,XMED,IBUGG3,IERROR)
          ALOC=XMED
          DSUM=0.0D0
          DO2110I=1,N
             DSUM=DSUM + DBLE(ABS(Y(I) - XMED))
 2110     CONTINUE
          SCALE=REAL(DSUM)/REAL(N)
        ENDIF
      ELSEIF(ICASPL.EQ.'CAML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1201)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1215)
 1215     FORMAT('      CENSORING NOT SUPPORTED FOR THE CAUCHY ',
     1           'DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MEDIAN(Y,N,IWRITE,X2,MAXNXT,XMED,IBUGG3,IERROR)
          CALL MAD(Y,N,IWRITE,X2,MAXNXT,XMAD,IBUGG3,IERROR)
          AN=REAL(N)
C
          IF(N.EQ.3)THEN
            CALL SORT(Y,N,X2)
            X1Z=X2(1)
            X2Z=X2(2)
            X3Z=X2(3)
            TERM1=X1Z*(X3Z-X2Z)**2 + X2Z*(X3Z-X1Z)**2 +
     1            X3Z*(X2Z-X1Z)**2
            TERM2=(X3Z-X2Z)**2 + (X3Z-X1Z)**2 + (X2Z-X1Z)**2
            ALOC=TERM1/TERM2
            TERM1=SQRT(3.0)*(X3Z-X2Z)*(X3Z-X1Z)*(X2Z-X1Z)
            SCALE=TERM1/TERM2
          ELSEIF(N.EQ.3)THEN
            CALL SORT(Y,N,X2)
            X1Z=X2(1)
            X2Z=X2(2)
            X3Z=X2(3)
            X4Z=X2(4)
            TERM1=X2Z*X4Z - X1Z*X3Z
            TERM2=X4Z - X3Z + X2Z - X1Z
            ALOC=TERM1/TERM2
            TERM1=(X4Z-X3Z)*(X3Z-X2Z)*(X2Z-X1Z)*(X4Z-X1Z)
            TERM2=(X4Z - X3Z + X2Z - X1Z)**2
            ASCALE=TERM1/TERM2
          ELSE
            XPAR(1)=DBLE(XMED)
            XPAR(2)=DBLE(XMAD)
C
            IOPT=2
            TOL=1.0D-6
            NVAR=2
            NPRINT=-1
            INFO=0
            LWA=MAXNXT
            CALL DNSQE(CAUFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,
     1                 NPRINT,INFO,
     1                 DTEMP1,MAXNXT,Y,N)
c
            ALOC=REAL(XPAR(1))
            SCALE=REAL(XPAR(2))
          ENDIF
        ENDIF
      ELSEIF(ICASPL.EQ.'EXML')THEN
        IF(ICENS2.EQ.'ON')THEN
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
          ALOC=XMIN
          DSUM1=0.0D0
          DO3020I=1,N
            DSUM1=DSUM1 + DBLE(Y(I) - XMIN)
 3020     CONTINUE
          IF(IR.GT.0)THEN
            SCALE=REAL(DSUM1/DBLE(IR))
          ELSE
            SCALE=REAL(DSUM1/DBLE(N))
          ENDIF
        ELSE
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
          ALOC=XMIN
          SCALE=XMEAN-XMIN
        ENDIF
      ELSEIF(ICASPL.EQ.'GUML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1201)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1219)
 1219     FORMAT('      CENSORING NOT SUPPORTED FOR THE GUMBEL ',
     1           'DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          AN=REAL(N)
C
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
          CALL MAXIM(Y,N,IWRITE,XMAX,IBUGG3,IERROR)
C
C  MOMENT ESTIMATES (USED FOR STARTING VALUES) ARE:
C
C    MUHAT = XBAR - 0.45006*SD
C    SHAT  = 0.77970*SD
C
C  THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
C
C  THE ML ESTIMATE OF THE SCALE PARAMETER IS THE SOLUTION TO
C  THE FOLLOWING EQUATION:
C
C              FOR THE MAXIMUM CASE:
C
C                 SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(-X(I)/SHAT)]/
C                        SUM[i=1 to N][EXP(-X(I)/SHAT)] = 0
C
C              FOR THE MINIMUM CASE:
C
C                 SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(X(I)/SHAT)]/
C                        SUM[i=1 to N][EXP(X(I)/SHAT)] = 0
C
C              WITH
C
C                 SHAT     = CURRENT ESTIMATE OF SCALE PARAMETER
C                 XBAR     = SAMPLE MEAN
C                 N        = SAMPLE SIZE
C                 MINMAX   = SPECIFY WHETHER MAXIMUM OR MINIMUM
C                            CASE IS BEING ESTIMATED
C
C THE ML ESTIMATE OF LOCATION FOR THE MAXIMUM CASE IS
C
C   MUHAT = -SHAT*LOG(SUM[i=1 to N][EXP(-X(I)/SHAT)]/N)
C
C THE ML ESTIMATE OF LOCATION FOR THE MINIMUM CASE IS
C
C   MUHAT = -SHAT*LOG(SUM[i=1 to N][EXP(X(I)/SHAT)]/N)
C
C
          AN=REAL(N)
          DN=DBLE(N)
          IF(MINMAX.EQ.2)THEN
            UHATMO=XMEAN - 0.45006*XSD
          ELSE
            UHATMO=XMEAN + 0.45006*XSD
          ENDIF
          SCALMO=0.77970*XSD
C
          XBAR=DBLE(XMEAN)
          MINMX2=MINMAX
          IN=N
C
          DXSTRT=DBLE(SCALMO)
          DAE=2.0*0.000001D0*DXSTRT
          DRE=DAE
          IFLAG=0
          DXLOW=DXSTRT/2.0D0
          DXUP=2.0D0*DXSTRT
          ITBRAC=0
          DO3104I=1,N
            DTEMP1(I)=DBLE(Y(I))
 3104     CONTINUE
C
 3105     CONTINUE
          XLOWSV=DXLOW
          XUPSV=DXUP
          CALL DFZER2(EV1FU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
C
          IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
            DXLOW=XLOWSV/2.0D0
            DXUP=2.0D0*XUPSV
            ITBRAC=ITBRAC+1
            GOTO3105
          ENDIF
C
          IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3111)
C3111       FORMAT('***** WARNING FROM GUMBEL MAXIMUM ',
CCCCC1             'LIKELIHOOD--')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3113)
C3113       FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1             'DESIRED TOLERANCE.')
CCCCC       CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3121)
 3121       FORMAT('***** WARNING FROM GUMBEL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3123)
 3123       FORMAT('      ESTIMATE OF SCALE MAY BE NEAR A ',
     1             'SINGULAR POINT.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.4)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3131)
 3131       FORMAT('***** ERROR FROM GUMBEL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3133)
 3133       FORMAT('      APPROPRIATE BRACKETING INTERVAL ',
     1             'NOT FOUND.')
           CALL DPWRST('XXX','BUG ')
         ELSEIF(IFLAG.EQ.5)THEN
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,3141)
 3141      FORMAT('***** WARNING FROM GUMBEL MAXIMUM LIKELIHOOD--')
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,3143)
 3143      FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
           CALL DPWRST('XXX','BUG ')
          ENDIF
C
          SCALE=REAL(DXLOW)
C
          DSUM1=0.0D0
          IF(MINMAX.EQ.2)THEN
            DO3108I=1,N
              DX=-DBLE(Y(I))
              DSUM1=DSUM1 + DEXP(DX/DBLE(SCALE))
 3108       CONTINUE
            DTERM1=-DBLE(SCALE)*DLOG(DSUM1/DN)
          ELSE
            DO3109I=1,N
              DX=DBLE(Y(I))
              DSUM1=DSUM1 + DEXP(DX/DBLE(SCALE))
 3109       CONTINUE
            DTERM1=DBLE(SCALE)*DLOG(DSUM1/DN)
          ENDIF
          ALOC=REAL(DTERM1)
        ENDIF
      ELSEIF(ICASPL.EQ.'RAML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1201)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1217)
 1217     FORMAT('      CENSORING NOT SUPPORTED FOR THE RAYLEIGH ',
     1           'DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
          ALOC=XMIN
          DSUM=0.0D0
          DO2910I=1,N
            DSUM=DSUM + DBLE(Y(I) - ALOC)**2
 2910     CONTINUE
          SCALE=REAL(DSQRT(DSUM/(2.0D0*DBLE(N))))
        ENDIF
      ELSEIF(ICASPL.EQ.'MAML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1201)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3117)
 3117     FORMAT('      CENSORING NOT SUPPORTED FOR THE MAXWELL ',
     1           'DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
          ALOC=XMIN
          DSUM=0.0D0
          DSUM2=0.0D0
          DO3120I=1,N
            DSUM=DSUM + DBLE(Y(I) - ALOC)**2
            DSUM2=DSUM2 + DBLE(Y(I) - AZERO)**2
 3120     CONTINUE
          DTEMP=DSQRT(DSUM/(3.0D0*DBLE(N)))
          SCALE=REAL(DTEMP)
CCCCC     DTEMP=DSQRT(DSUM2/(3.0D0*DBLE(N)))
CCCCC     SCALEM2=REAL(DTEMP)
        ENDIF
      ELSEIF(ICASPL.EQ.'FNML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1201)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3003)
 3003     FORMAT('      CENSORING NOT SUPPORTED FOR THE FOLED ',
     1           'NORMAL DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
C
          XPAR(1)=DBLE(XMEAN)
          XPAR(2)=DBLE(XSD*XSD)
C
          IOPT=2
          TOL=1.0D-5
          NVAR=2
          NPRINT=-1
          INFO=0
          LWA=MAXNXT
          CALL DNSQE(FNRFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1               DTEMP1,MAXNXT,Y,N)
C
          ALOC=REAL(XPAR(1))
          SCALE=REAL(DSQRT(XPAR(2)))
        ENDIF
      ELSE
        ALOC=0.0
        SCALE=1.0
        GOTO9000
      ENDIF
      IF(IERROR.EQ.'YES')GOTO9000
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  COMPUTE SELECTED PERCENTILES                **
C               **************************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NP.GT.0)THEN
        IF(ICASPL.EQ.'NOML')THEN
          DO4110I=1,NP
            QPTEMP=QP(I)/100.0
            CALL NORPPF(QPTEMP,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4110     CONTINUE
        ELSEIF(ICASPL.EQ.'UNML')THEN
          DO4120I=1,NP
            QPTEMP=QP(I)/100.0
            CALL UNIPPF(QPTEMP,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4120     CONTINUE
        ELSEIF(ICASPL.EQ.'LOML')THEN
          DO4130I=1,NP
            QPTEMP=QP(I)/100.0
            CALL LOGPPF(QPTEMP,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4130     CONTINUE
        ELSEIF(ICASPL.EQ.'LAML')THEN
          DO4140I=1,NP
            QPTEMP=QP(I)/100.0
            CALL DEXPPF(QPTEMP,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4140     CONTINUE
        ELSEIF(ICASPL.EQ.'CAML')THEN
          DO4150I=1,NP
            QPTEMP=QP(I)/100.0
            CALL CAUPPF(QPTEMP,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4150     CONTINUE
        ELSEIF(ICASPL.EQ.'EXML')THEN
          DO4170I=1,NP
            QPTEMP=QP(I)/100.0
            CALL EXPPPF(QPTEMP,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4170     CONTINUE
        ELSEIF(ICASPL.EQ.'GUML')THEN
          DO4180I=1,NP
            QPTEMP=QP(I)/100.0
            CALL EV1PPF(QPTEMP,MINMAX,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4180     CONTINUE
        ELSEIF(ICASPL.EQ.'COML')THEN
          DO4200I=1,NP
            QPTEMP=QP(I)/100.0
            CALL COSPPF(QPTEMP,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4200     CONTINUE
        ELSEIF(ICASPL.EQ.'RAML')THEN
          DO4210I=1,NP
            QPTEMP=QP(I)/100.0
            CALL RAYPPF(QPTEMP,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4210     CONTINUE
        ELSEIF(ICASPL.EQ.'FNML')THEN
          DO4220I=1,NP
            QPTEMP=QP(I)/100.0
            CALL FNRPPF(QPTEMP,ALOC,SCALE,XQP(I))
 4220     CONTINUE
        ELSEIF(ICASPL.EQ.'MAML')THEN
          DO4230I=1,NP
            QPTEMP=QP(I)/100.0
            CALL MAXPPF(QPTEMP,SCALE,XQP(I))
            XQP(I)=ALOC + 1.0*XQP(I)
 4230     CONTINUE
        ENDIF
      ENDIF
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBM2(Y,X,N,ICASPL,ICENSO,MAXNXT,MINMAX,IGEPDF,
     1Y2,X2,
     1DTEMP1,
     1SCALE,SHAPE,
     1QP,XQP,NP,
     1IPOTTO,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN BOOTSTRAP SAMPLE, GENERATE MAXIMUM
C              LIKELIHOOD ESTIMATES FOR ONE SHAPE (SHAPE) AND
C              SCALE (SCALE).  CENSORED ML ESTIMATES ARE SUPPORTED
C              FOR A FEW DISTRIBUTIONS
C
C              ALSO SUPPORT CASE FOR TWO SHAPE PARAMETERS BUT
C              NO LOCATION OR SCALE PARAMETERS.
C
C              SUPPORTED DISTRIBUTIONS ARE:
C
C              1) LOGNORMAL
C              2) WEIBULL (MINIMUM)
C              3) GAMMA
C              4) GEOMETRIC EXTREME EXPONENTIAL
C              5) FATIGUE LIFE
C              6) INVERSE GAUSSIAN
C              7) PARETO
C              8) BETA
C              9) GENERALIZED PARETO
C                 A) MAXIMUM LIKELIHOOD
C                 B) METHOD OF MOMENTS
C                 C) DEHAAN
C                 D) CME
C             10) FRECHET (MAXIMUM)
C             11) WEIBULL
C
C              1) CENSORED LOGNORMAL
C              2) CENSORED WEIBULL
C              3) CENSORED GAMMA
C              4) CENSORED INVERTED WEIBULL
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/1
C     ORIGINAL VERSION--JANUARY   2005.
C     UPDATED         --MARCH     2005. GENERALIZED PARETO
C                                       (ML, MOMENTS)
C     UPDATED         --MAY       2005. GENERALIZED PARETO
C                                       (DEHAAN, CME)
C     UPDATED         --AUGUST    2005. FIX TO PERCENT POINT OF PARETO
C     UPDATED         --AUGUST    2005. INVERTED WEIBULL (THIS BASICALLY
C                                       USES THE WEIBULL CODE)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICENSO
      CHARACTER*4 IGEPDF
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION QP(*)
      DIMENSION XQP(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DR
      DOUBLE PRECISION DX
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DAE
      DOUBLE PRECISION DRE
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
      DOUBLE PRECISION XSTRT
      DOUBLE PRECISION XSTART
      DOUBLE PRECISION XLOW
      DOUBLE PRECISION XUP
      DOUBLE PRECISION XLOWSV
      DOUBLE PRECISION XUPSV
      DOUBLE PRECISION AE
      DOUBLE PRECISION RE
      DOUBLE PRECISION DGAMM1
      DOUBLE PRECISION DGAMM2
      DOUBLE PRECISION DALPHA
      DOUBLE PRECISION DALPH2
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DSUM3
      DOUBLE PRECISION DSUM4
      DOUBLE PRECISION TBAR
      DOUBLE PRECISION H
      DOUBLE PRECISION DK
C
      DOUBLE PRECISION WEIFUN
      DOUBLE PRECISION GAMFUN
      DOUBLE PRECISION GC1FUN
      DOUBLE PRECISION LG1FUN
      DOUBLE PRECISION GEEFUN
      DOUBLE PRECISION BETFUN
      DOUBLE PRECISION FLFUN
      DOUBLE PRECISION EV2UN
      EXTERNAL WEIFUN
      EXTERNAL GAMFUN
      EXTERNAL GC1FUN
      EXTERNAL LG1FUN
      EXTERNAL GEEFUN
      EXTERNAL BETFUN
      EXTERNAL FLFUN
      EXTERNAL GPAFUN
      EXTERNAL EV2FUN
      EXTERNAL SUM
      INTEGER IN
      DOUBLE PRECISION DWEISM
      COMMON/WEICOM/DWEISM,IN
      DOUBLE PRECISION DLOGGM
      COMMON/GAMCOM/DLOGGM
      DOUBLE PRECISION XBAR
      DOUBLE PRECISION DGEOME
      INTEGER IN2
      INTEGER IR2
      COMMON/GC1COM/XBAR,DGEOME,IN2,IR2
      DOUBLE PRECISION C
      INTEGER IN3
      INTEGER IM
      COMMON/LG1COM/C,IN3,IM
      COMMON /BETAML/ BETALL, BETAUL
      DOUBLE PRECISION DEV2SM
      COMMON/EV2COM/DEV2SM,INEV2
C
      CHARACTER*4 ICENS2
      CHARACTER*4 IWRITE
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 IFEESV
      CHARACTER*4 IPRISV
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
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.14159265358979/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPJB'
      ISUBN2='M2  '
      IWRITE='OFF'
      SCALE=1.0
      SHAPE=1.0
      IR=0
      IF(NP.GT.0)THEN
        DO410I=1,NP
          XQP(I)=0.0
  410   CONTINUE
      ENDIF
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  PROCESS THE CENSORING VARIABLE.             **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBM2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1000I=1,N
        Y2(I)=Y(I)
 1000 CONTINUE
C
      IF(ICENSO.EQ.'ON')THEN
        IR=0
        CALL DISTIN(X,N,IWRITE,X2,NDIST,IBUGG3,IERROR)
        IF(NDIST.EQ.1)THEN
          DO1102I=1,N
            X(I)=1.0
 1102     CONTINUE
          IR=N
        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)THEN
                X(I)=2.0
              ELSE
                IR=IR+1
              ENDIF
 1103       CONTINUE
          ELSE
            ATEMP1=MIN(X2(1),X2(2))
            ATEMP2=MAX(X2(1),X2(2))
            DO1108I=1,N
              IF(X(I).EQ.ATEMP1)THEN
                IR=IR+1
                X(I)=1.0
              ENDIF
              IF(X(I).EQ.ATEMP2)X(I)=2.0
 1108       CONTINUE
          ENDIF
        ELSE
          WRITE(ICOUT,999)
  999     FORMAT(1X)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1104)
 1104     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          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(Y2,X,N,Y,X)
        IF(ICASPL.EQ.'LNML')THEN
          IF(IR.LT.N)THEN
            AHOLD=Y(IR+1)
            DO1240I=IR+1,N
              IF(Y(I).NE.AHOLD)THEN
                WRITE(ICOUT,999)
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,1241)
 1241           FORMAT('***** ERROR FROM CENSORED LOGNORMAL MAXIMUM ',
     1                 'LIKELIHOOD--')
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,1243)
 1243           FORMAT('      CURRENTLY, ONLY SINGLY CENSORED DATA ',
     1                 'IS SUPPORTED FOR THE LOGNORMAL DISTRIBUTION.')
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,1245)
 1245           FORMAT('      MULTIPLY CENSORED DATA WAS DETECTED.')
                CALL DPWRST('XXX','WRIT')
                IERROR='YES'
                GOTO9000
              ENDIF
 1240       CONTINUE
            C=DBLE(AHOLD)
          ENDIF
        ENDIF
C
      ELSE
        CALL SORT(Y2,N,Y)
      ENDIF
C
      ICENS2=ICENSO
      IF(IR.EQ.N)ICENS2='OFF'
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  GENERATE MAXIMUM LIKELIHOOD ESTIMATES         **
C               **  FOR GIVEN DISTRIBUTION                        **
C               ****************************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBM2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'LNML')THEN
        IF(ICENS2.EQ.'ON')THEN
          AN=REAL(N)
C
C  USE PARAMETERS ESTIMATED FROM FAILURE DATA AS STARTING VALUES
C  FOR EQUATION SOLVER.
C
          DO1903I=1,IR
            X2(I)=LOG(Y(I))
 1903     CONTINUE
C
          CALL MEAN(X2,IR,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(X2,IR,IWRITE,XSD,IBUGG3,IERROR)
C
          XPAR(1)=DBLE(XMEAN)
          XPAR(2)=DBLE(XSD)
C
          IN3=N
          IM=N-IR
          JAC=0
          IOPT=2
          TOL=1.0D-6
          NVAR=2
          NPRINT=-1
          INFO=0
          LWA=MAXNXT
          FVEC(1)=0.0D0
          FVEC(2)=0.0D0
          IF(IR.LT.N)THEN
            CALL DNSQE(LG1FUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1                 DTEMP1,MAXNXT,Y,IR)
            UHATML=REAL(XPAR(1))
            SCALE=EXP(UHATML)
            SHAPE=REAL(XPAR(2))
          ELSE
            UHAT=XMEAN
            SCALE=EXP(XMEAN)
            SHAPE=XSD
          ENDIF
C
        ELSE
C
C  THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
C
C  NOTE THAT A COMMON PARAMETERIZATION USES
C
C    U = LOG(SCALE)
C
C    UHAT      = (1/N)*SUM[i=1 to N][LOG(Y(I))]
C    SCALEHAT  = EXP(UHAT)
C    SIGMAHAT  = SQRT((1/N)*SUM[i=1 to N][(LOG(Y(I)) - UHAT)**2]
C
          AN=REAL(N)
          DO2003I=1,N
            X2(I)=LOG(Y(I))
 2003     CONTINUE
C
          CALL MEAN(X2,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(X2,N,IWRITE,XSD,IBUGG3,IERROR)
          UHAT=XMEAN
          SCALE=EXP(XMEAN)
          SHAPE=XSD
        ENDIF
      ELSEIF(ICASPL.EQ.'WEML')THEN
        IF(ICENS2.EQ.'ON')THEN
C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C    (1/GHAT) -
C    SUM[i=1 to n][Y(I)**GHAT*LN(Y(I))]/SUM[i=1 to n][[Y(I)**GHAT] +
C    (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
C
C  THEN
C
C    SCALE = ((1/N)*SUM[i=1 to n][Y(I)**GHAT])
C
C  FOR STARTING VALUE, USE
C
C    GHAT = 1.28/(STD DEV OF LOG(Y))
C    
          DO2160I=1,N
            IF(Y(I).LE.0.0)THEN
              IERROR='YES'
              GOTO9000
            ENDIF
            X2(I)=LOG(Y(I))
 2160     CONTINUE
C
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
          CALL SD(X2,N,IWRITE,XLOGSD,IBUGG3,IERROR)
C
          DSUM1=0.0D0
          DO2161I=1,N
            DTEMP1(I)=DBLE(Y(I))
            IF(X(I).EQ.1.0)DSUM1=DSUM1 + DLOG(DTEMP1(I))
 2161     CONTINUE
          DWEISM=DSUM1/DBLE(IR)
          XSTART=DBLE(1.28/XLOGSD)
          AE=2.0*0.000001D0*XSTART
          RE=AE
          IN=N
          IFLAG=0
          XLOW=XSTART/2.0D0
          XUP=2.0D0*XSTART
          ITBRAC=0
 2165     CONTINUE
          XLOWSV=XLOW
          XUPSV=XUP
          CALL DFZER2(WEIFUN,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP1)
C
          IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
            XLOW=XLOWSV/2.0D0
            XUP=2.0D0*XUPSV
            ITBRAC=ITBRAC+1
            GOTO2165
          ENDIF
C
          IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2111)
C2111       FORMAT('***** WARNING FROM CENSORED WEIBULL MAXIMUM ',
CCCCC1             'LIKELIHOOD--')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2113)
C2113       FORMAT('      ESTIMATE OF GAMMA MAY NOT BE COMPUTED TO ',
CCCCC1             'DESIRED TOLERANCE.')
CCCCC       CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2171)
 2171       FORMAT('***** WARNING FROM CENSORED WEIBULL MAXIMUM ',
     1             'LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2173)
 2173       FORMAT('      ESTIMATE OF SHAPE PARAMETER MAY BE NEAR ',
     1             'A SINGULAR POINT.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.4)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2181)
 2181       FORMAT('***** ERROR FROM CENSORED WEIBULL MAXIMUM ',
     1             'LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2183)
 2183       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.5)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2171)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2193)
 2193       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          SHAPE=XLOW
          DSUM1=0.0D0
          DO2168I=1,N
            DSUM1=DSUM1 + DBLE(Y(I)**SHAPE)
 2168     CONTINUE
          SCALE=REAL((DSUM1/DBLE(IR))**DBLE(1.0D0/DBLE(SHAPE)))
        ELSE
C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C    (1/GHAT) -
C    SUM[i=1 to n][Y(I)**GHAT*LN(Y(I))]/SUM[i=1 to n][[Y(I)**GHAT] +
C    (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
C
C  THEN
C
C    SCALE = ((1/N)*SUM[i=1 to n][Y(I)**GHAT])
C
C  FOR STARTING VALUE, USE
C
C    GHAT = 1.28/(STD DEV OF LOG(Y))
C    
          DO2110I=1,N
            IF(Y(I).LE.0.0)THEN
              IERROR='YES'
              GOTO9000
            ENDIF
            X2(I)=LOG(Y(I))
 2110     CONTINUE
C
          AN=REAL(N)
C
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
          CALL SD(X2,N,IWRITE,XLOGSD,IBUGG3,IERROR)
          CALL SUM(X2,N,IWRITE,XLOGSM,IBUGG3,IERROR)
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
C
C  ESTIMATES FOR 2-PARAMETER MODEL.  USE DFZER2 TO FIND ROOT OF
C  THE EQUATION GIVEN ABOVE.
C
          DO2101I=1,N
            DTEMP1(I)=DBLE(Y(I))
 2101     CONTINUE
          DWEISM=DBLE(XLOGSM/AN)
          DXSTRT=1.28D0/DBLE(XLOGSD)
          DAE=2.0*0.000001D0*DXSTRT
          DRE=DAE
          IN=N
          IFLAG=0
          DXLOW=DXSTRT/2.0D0
          DXUP=2.0D0*DXSTRT
          ITBRAC=0
 2105     CONTINUE
          XLOWSV=DXLOW
          XUPSV=DXUP
          CALL DFZER2(WEIFUN,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
C
          IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
            DXLOW=XLOWSV/2.0D0
            DXUP=2.0D0*XUPSV
            ITBRAC=ITBRAC+1
            GOTO2105
          ENDIF
C
          IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2111)
C2111       FORMAT('***** WARNING FROM WEIBULL MAXIMUM ',
CCCCC1             'LIKELIHOOD--')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2113)
C2113       FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1             'DESIRED TOLERANCE.')
CCCCC       CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2121)
 2121       FORMAT('***** WARNING FROM WEIBULL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2123)
 2123       FORMAT('      ESTIMATE OF SHAPE PARAMETER MAY BE NEAR ',
     1             'A SINGULAR POINT.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.4)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2131)
 2131       FORMAT('***** ERROR FROM WEIBULL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2133)
 2133       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.5)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2141)
 2141       FORMAT('***** WARNING FROM WEIBULL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2143)
 2143       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          SHAPE=REAL(DXLOW)
          DSUM=0.0D0
          DO2108I=1,N
            DSUM=DSUM + DBLE(Y(I)**SHAPE)
 2108     CONTINUE
          SCALE=REAL((DSUM/DBLE(N))**DBLE(1.0D0/DBLE(SHAPE)))
CCCCC     BN=1.0 + 2.2/AN**1.13
CCCCC     GAMMBC=SHAPE/BN
        ENDIF
      ELSEIF(ICASPL.EQ.'GAML')THEN
        IF(ICENS2.EQ.'ON')THEN
          IM=N-IR
          IR2=IR
C
          AR=REAL(IR)
          DR=DBLE(IR)
          AN=REAL(N)
          AM=REAL(IM)
C
C
C  THE MAXIMUM LIKELIHOOD EQUATIONS FOR THE CENSORED CASE ARE:
C
C      R*XBAR/SHAT - R*GHAT + SUM[i=1 to M]
C        [Z(j)**GHAT*EXP(Z(j)/(GAMMA(GHAT) - G(Z(j),GHAT))] = 0
C
C      R*LOG(GEOMEAN/SHAT)  - N*DIGAMMA(GHAT) + SUM[i=1 to M]
C        [(GAMMA(GHAT)*DIGAMMA(GHAT) J(Z(j),GHAT))/
C        (GAMMA(GHAT) - G(Z(j),GHAT))] = 0
C
C      WHERE
C
C
C         XBAR = MEAN OF FAILURE DATA
C         GEOMEAN  = GEOMETRIC MEAN OF FAILURE DATA
C         R        = NUMBER OF FAILURES
C         M        = NUMBER OF CENSORING TIMES
C         SHAT     = FVEC(1) = CURRENT ESTIMATE OF SCALE PARAMETER
C         GHAT     = FVEC(2) = CURRENT ESTIMATE OF SHAPE PARAMETER
C         Z(j)     = jth CENSORING TIME
C         GAMMA    = GAMMA FUNCTION
C         DIGAMMA  = DIGAMMA FUNCTION
C         G(x,a)   = INCOMPLETE GAMMA FUNCTION
C         J(X,a)   = INTEGRAL[0 to x][t**(A-1)*LOG(t)*EXP(-t)]dt
C
C  THESE ARE SOLVED USING THE DNSQE ROUTINE.
C
          CALL MEAN(Y,IR,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,IR,IWRITE,XSD,IBUGG3,IERROR)
          CALL GEOMEA(Y,IR,IWRITE,XGEOM,IBUGG3,IERROR)
          XCOEFV=XSD/XMEAN
C
C  USE MOMENT ESTIMATES OF FAILURE DATA AS STARTING VALUES FOR
C  EQUATION SOLVER.
C
          GAMMMO=(XMEAN/XSD)**2
          SCALMO=XSD**2/XMEAN
C
          XBAR=DBLE(XMEAN)
          DGEOME=DBLE(XGEOM)
          XPAR(1)=DBLE(GAMMMO)
          XPAR(2)=DBLE(SCALMO)
C
          IN2=N
          JAC=0
          IOPT=2
          TOL=1.0D-6
          NVAR=2
          NPRINT=-1
          INFO=0
          LWA=MAXNXT
          FVEC(1)=0.0D0
          FVEC(2)=0.0D0
          CALL DNSQE(GC1FUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1               DTEMP1,MAXNXT,Y(IR+1),IM)
C
          SHAPE=REAL(XPAR(1))
          SCALE=REAL(XPAR(2))
        ELSE
C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C    LOG(GAMMAHAT) - PHI(GAMMAHAT) - LOG(XBAR/G) = 0
C
C  WITH G DENOTING THE GEOMETRIC MEAN (PRODUCT[i=1 to n][X(i)**(1/N)]
C
C  THEN
C
C    SCALE = XBAR/GAMMAHAT
C
C  FOR STARTING VALUE, USE THE METHOD OF MOMENT ESTIMATORS
C
C    GAMMAHAT = (XBAR/XSD)**2
C    SCALE    = XSD**2/XBAR
C
C    
          AN=REAL(N)
C
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
          CALL GEOMEA(Y,N,IWRITE,XGEOM,IBUGG3,IERROR)
C
          GAMMMO=(XMEAN/XSD)**2
          SCALMO=XSD**2/XMEAN
C
C  ESTIMATES FOR 2-PARAMETER MODEL.  USE DFZER2 TO FIND ROOT OF
C  THE LIKELIHOOD EQUATION.
C
          DLOGGM=DLOG(DBLE(XMEAN)/DBLE(XGEOM))
          DXSTRT=DBLE(GAMMMO)
          AE=2.0*0.000001D0*DXSTRT
          RE=AE
          IFLAG=0
          DXLOW=DXSTRT/2.0D0
          DXUP=2.0D0*DXSTRT
          ITBRAC=0
 2205     CONTINUE
          XLOWSV=DXLOW
          XUPSV=DXUP
          CALL DFZERO(GAMFUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG)
C
          IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
            DXLOW=XLOWSV/2.0D0
            DXUP=2.0D0*XUPSV
            ITBRAC=ITBRAC+1
            GOTO2205
          ENDIF
C
          IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2211)
C2211       FORMAT('***** WARNING FROM GAMMA MAXIMUM ',
CCCCC1             'LIKELIHOOD--')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2213)
C2213       FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1             'DESIRED TOLERANCE.')
CCCCC       CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2221)
 2221       FORMAT('***** WARNING FROM GAMMA MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2223)
 2223       FORMAT('      ESTIMATE OF SHAPE PARAMETER MAY BE NEAR ',
     1             'A SINGULAR POINT.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.4)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2231)
 2231       FORMAT('***** ERROR FROM GAMMA MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2233)
 2233       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.5)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2241)
 2241       FORMAT('***** WARNING FROM GAMMA MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2243)
 2243       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          SHAPE=REAL(DXLOW)
          SCALE=XMEAN/SHAPE
        ENDIF
      ELSEIF(ICASPL.EQ.'EEML')THEN
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2301)
 2301     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2303)
 2303     FORMAT('      CENSORING NOT SUPPORTED FOR THE ',
     1           'GEOMETRIC EXTREME EXPONENTIAL DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
C
          XPAR(1)=DBLE(XMEAN)
          XPAR(2)=DBLE(XSD)
C
          IOPT=2
          TOL=1.0D-6
          NVAR=2
          NPRINT=-1
          INFO=0
          LWA=MAXNXT
          CALL DNSQE(GEEFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1               DTEMP1,MAXNXT,Y,N)
C
          SHAPE=REAL(XPAR(1))
          SCALE=REAL(XPAR(2))
        ENDIF
      ELSEIF(ICASPL.EQ.'FLML')THEN
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2501)
 2501     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2503)
 2503     FORMAT('      CENSORING NOT SUPPORTED FOR THE ',
     1           'FATIGUE LIFE DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
C
          DN=DBLE(N)
          DSUM1=0.0D0
          DSUM2=0.0D0
          DSUM3=0.0D0
          DSUM4=0.0D0
          DO2610I=1,N
            DX=DBLE(Y(I))
            DSUM1=DSUM1 + DSQRT(DX)
            DSUM2=DSUM2 + 1.0D0/DSQRT(DX)
            DSUM3=DSUM3 + DX
            DSUM4=DSUM4 + 1.0D0/DX
 2610     CONTINUE
          DGAMM1=DSUM1/DSUM2
          XPAR(1)=DSQRT(DSUM3/DSUM4)
C
          DSUM1=0.0D0
          DO2620I=1,N
            DX=DBLE(Y(I))
            DSUM1=DSUM1 + (DSQRT(DX/DGAMM1) - DSQRT(DGAMM1/DX))**2
 2620     CONTINUE
          DALPHA=DSQRT(DSUM1/DN)
          SCALE1=REAL(DGAMM1)
          GAMMA1=REAL(DALPHA)
C
          XPAR(1)=DGAMM1
C
          IOPT=2
          TOL=1.0D-6
          NVAR=1
          NPRINT=-1
          INFO=0
          LWA=MAXNXT
          CALL DNSQE(FLFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1               DTEMP1,MAXNXT,Y,N)
C
          DSUM1=0.0D0
          DSUM2=0.0D0
          DSUM3=0.0D0
C
          DO2630I=1,N
            DX=DBLE(Y(I))
            DSUM1=DSUM1 + DX
            DSUM2=DSUM2 + 1.0D0/DX
            DSUM3=DSUM3 + 1.0D0/(DX + XPAR(1))
 2630     CONTINUE
          TBAR=DSUM1/DN
          H=DN/DSUM2
          DK=DN/DSUM3
          DALPH2=2.0D0*DSQRT(0.5D0*
     1           ((TBAR/XPAR(1)) + XPAR(1)/H) - 1.0D0)
          GAMMA2=REAL(XPAR(1))
          SHAPE=REAL(DALPH2)
          SCALE=GAMMA2
        ENDIF
      ELSEIF(ICASPL.EQ.'IGML')THEN
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2701)
 2701     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2703)
 2703     FORMAT('      CENSORING NOT SUPPORTED FOR THE ',
     1           'INVERSE GAUSSIAN DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          DO2710I=1,N
            IF(Y(I).LT.0.0)THEN
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,2711)
 2711         FORMAT('***** NOTE FROM INVERSE GAUSSIAN MAXIMUM ',
     1               'LIKELIHOOD ESTIMATION--')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,2713)
 2713         FORMAT('      NON-POSITIVE VALUE DETECTED.')
              CALL DPWRST('XXX','BUG ')
              IERROR='YES'
              GOTO9000
            ENDIF
 2710     CONTINUE
C
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          DSUM=0.0D0
          DO2720I=1,N
            DSUM=DSUM + (1.0D0/DBLE(Y(I)) - 1.0D0/DBLE(XMEAN))
 2720     CONTINUE
          SHAPE=REAL(DBLE(N)/DSUM)
          SCALE=XMEAN
        ENDIF
      ELSEIF(ICASPL.EQ.'PAML')THEN
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2801)
 2801     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2803)
 2803     FORMAT('      CENSORING NOT SUPPORTED FOR THE ',
     1           'PARETO DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          XMIN=Y(1)
          DSUM=0.0D0
          DO2810I=1,N
            IF(Y(I).LE.0.0)THEN
              SHAPE=0.0
              SCALE=0.0
              IERROR='YES'
              GOTO9000
            ENDIF
            DTERM1=DBLE(LOG(Y(I)/XMIN))
            DSUM=DSUM + DTERM1
 2810     CONTINUE
          GAMMA=REAL(DSUM)/REAL(N)
          GAMMA=1.0/GAMMA
          SHAPE=GAMMA
          SCALE=XMIN
        ENDIF
      ELSEIF(ICASPL.EQ.'BEML')THEN
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2901)
 2901     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2903)
 2903     FORMAT('      CENSORING NOT SUPPORTED FOR THE ',
     1           'BETA DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
          CALL MAXIM(Y,N,IWRITE,XMAX,IBUGG3,IERROR)
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL VAR(Y,N,IWRITE,XVAR,IBUGG3,IERROR)
          XSD=SQRT(XVAR)
C
CCCCC ALLOW FOR USER SPECIFIED LOWER AND UPPER LIMITS
C
          AUSER=CPUMIN
          BUSER=CPUMIN
C
          IF((AUSER.EQ.CPUMIN .OR. BUSER.EQ.CPUMIN) .OR.
     1       (AUSER.GE.XMIN .OR. BUSER.LE.XMAX))THEN
            IF((XMIN.GE.0.0 .AND. XMIN.LE.1.0) .AND.
     1         (XMAX.GE.0.0 .AND. XMAX.LE.1.0))THEN
              A=0.0
              B=1.0
            ELSE
              A=XMIN - 1.0E-12
              B=XMAX + 1.0E+12
            ENDIF
            BETALL=A
            BETAUL=B
          ELSE
            BETALL=AUSER
            BETAUL=BUSER
            A=AUSER
            B=BUSER
          ENDIF
C
          XMEAN1=(XMEAN-A)/(B-A)
          VAR1=XVAR/((B-A)**2)
          ALPHA1=XMEAN1*(XMEAN1*(1.0-XMEAN1)/VAR1 - 1.0)
          BETA1=(1.0-XMEAN1)*(XMEAN1*(1.0-XMEAN1)/VAR1 - 1.0)
C
          XPAR(1)=DBLE(ALPHA1)
          XPAR(2)=DBLE(BETA1)
          DPROD1=1.0D0
          DPROD2=1.0D0
          DN=DBLE(N)
C
          DO2911I=1,N
            DTERM1=DBLE((B-Y(I))/(B-A))**(1.0D0/DN)
            DTERM2=DBLE( (Y(I)-A)/(B-A))**(1.0D0/DN)
            IF(DTERM1.NE.0.0D0)DPROD1=DPROD1*DTERM1
            IF(DTERM2.NE.0.0D0)DPROD2=DPROD2*DTERM2
 2911     CONTINUE
          XPAR(1)=0.5D0*(1.0D0 - DPROD1)/(1.0D0 - DPROD2 - DPROD1)
          DO2913I=1,N
            DTERM1=DBLE((Y(I)-A)/(B-A))**(1.0D0/DN)
            DTERM2=DBLE( (B-Y(I))/(B-A))**(1.0D0/DN)
            IF(DTERM1.NE.0.0D0)DPROD1=DPROD1*DTERM1
            IF(DTERM2.NE.0.0D0)DPROD2=DPROD2*DTERM2
 2913     CONTINUE
          XPAR(2)=0.5D0*(1.0D0 - DPROD1)/(1.0D0 - DPROD1 - DPROD2)
C
          IOPT=2
          TOL=1.0D-6
          NVAR=2
          NPRINT=-1
          INFO=0
          LWA=MAXNXT
          CALL DNSQE(BETFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1               DTEMP1,MAXNXT,Y,N)
C
          SCALE=REAL(XPAR(1))
          SHAPE=REAL(XPAR(2))
        ENDIF
      ELSEIF(ICASPL.EQ.'GEML' .OR. ICASPL.EQ.'GEMO' .OR.
     1       ICASPL.EQ.'GEDE' .OR. ICASPL.EQ.'GECM')THEN
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3001)
 3001     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3003)
 3003     FORMAT('      CENSORING NOT SUPPORTED FOR THE ',
     1           'GENERALIZED PARETO DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
          CALL MAXIM(Y,N,IWRITE,XMAX,IBUGG3,IERROR)
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
          XVAR=XSD**2
C
          GAMMA1=0.5*(XMEAN*XMEAN/XVAR - 1.0)
          SCALE1=0.5*XMEAN*(XMEAN*XMEAN/XVAR + 1.0)
C
          IF(ICASPL.EQ.'GEML')THEN
            XPAR(1)=DBLE(GAMMA1)
            XPAR(2)=DBLE(SCALE1)
C
            IOPT=2
            TOL=1.0D-6
            NVAR=2
            NPRINT=-1
            INFO=0
            LWA=MAXNXT
            CALL DNSQE(GPAFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1                 DTEMP1,MAXNXT,Y,N)
C
            GAMMA2=REAL(XPAR(1))
            SCALE2=REAL(XPAR(2))
C
          ELSEIF(ICASPL.EQ.'GEDE')THEN
C
            IFEESV=IFEEDB
            IPRISV=IPRINT
            IFEEDB='OFF'
            IPRINT='OFF'
            ICAPSW='OFF'
            ICAPTY='ASCI'
C
            THRESH=CPUMIN
            CALL DPDEGP(Y,N,
     1                  Y2,MAXNXT,
     1                  GAMMA3,SCALE3,GAMMSD,THRESH,
     1                  GAMMA4,ALOC,SCALE,
     1                  IGEPDF,ICAPSW,ICAPTY,
     1                  IPOTTO,
     1                  ISUBRO,IBUGG3,IERROR)
            IF(IGEPDF.NE.'SIMI')GAMMA3=-GAMMA3
C
            IFEEDB=IFEESV
            IPRINT=IPRISV
C
          ELSEIF(ICASPL.EQ.'GECM')THEN
C
            IFEESV=IFEEDB
            IPRISV=IPRINT
            IFEEDB='OFF'
            IPRINT='OFF'
            ICAPSW='OFF'
            ICAPTY='ASCI'
C
            THRESH=0.0
            CALL DPCMGP(Y,N,
     1                  Y2,MAXNXT,
     1                  GAMMA4,SCALE4,GAMMSD,THRESH,
     1                  X2,QP,XQP,DTEMP1,
     1                  IGEPDF,ICAPSW,ICAPTY,
     1                  IPOTTO,
     1                  ISUBRO,IBUGG3,IERROR)
            IF(IGEPDF.NE.'SIMI')GAMMA4=-GAMMA4
C
            IFEEDB=IFEESV
            IPRINT=IPRISV
C
          ENDIF
C

          IF(ICASPL.EQ.'GEMO')THEN
            SCALE=SCALE1
            SHAPE=GAMMA1
            IF(IGEPDF.EQ.'SIMI')GAMMA1=-GAMMA1
          ELSEIF(ICASPL.EQ.'GEDE')THEN
            SCALE=SCALE3
            SHAPE=GAMMA3
          ELSEIF(ICASPL.EQ.'GECM')THEN
            SCALE=SCALE4
            SHAPE=GAMMA4
          ELSE
            SCALE=SCALE2
            SHAPE=GAMMA2
            IF(IGEPDF.EQ.'SIMI')GAMMA2=-GAMMA2
          ENDIF
        ENDIF
      ELSEIF(ICASPL.EQ.'FRML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3101)
 3101     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3003)
 3103     FORMAT('      CENSORING NOT SUPPORTED FOR THE ',
     1           'FRECHET (MAXIMUM) DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C    (1/GHAT) -
C    SUM[i=1 to n][Y(I)**(-GHAT)*LN(Y(I))]/SUM[i=1 to n][[Y(I)**(-GHAT)]
C    - (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
C
C  THEN
C
C    SCALE = ((1/N)*SUM[i=1 to n][Y(I)**(-GHAT)])**(-1/GHAT)
C
C  FOR STARTING VALUE, USE
C
C    GHAT = 1.28/(STD DEV OF LOG(Y))
C    
          DO3110I=1,N
            IF(Y(I).LE.0.0)THEN
              IERROR='YES'
              GOTO9000
            ENDIF
            X2(I)=LOG(Y(I))
 3110     CONTINUE
C
          AN=REAL(N)
C
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
          CALL SD(X2,N,IWRITE,XLOGSD,IBUGG3,IERROR)
          CALL SUM(X2,N,IWRITE,XLOGSM,IBUGG3,IERROR)
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
C
C  ESTIMATES FOR 2-PARAMETER MODEL.  USE DFZER2 TO FIND ROOT OF
C  THE EQUATION GIVEN ABOVE.
C
          DO3111I=1,N
            DTEMP1(I)=DBLE(Y(I))
 3111     CONTINUE
          DEV2SM=DBLE(XLOGSM/AN)
          DXSTRT=DBLE(SQRT(1.645)*XSD)
          DAE=2.0*0.000001D0*DXSTRT
          DRE=DAE
          INEV2=N
          IFLAG=0
          DXLOW=DXSTRT/5.0D0
          DXUP=5.0D0*DXSTRT
          ITBRAC=0
 3115     CONTINUE
          XLOWSV=DXLOW
          XUPSV=DXUP
          CALL DFZER2(EV2FUN,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
C
          IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
            DXLOW=XLOWSV/2.0D0
            DXUP=2.0D0*XUPSV
            ITBRAC=ITBRAC+1
            GOTO3115
          ENDIF
C
          IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3116)
C3116       FORMAT('***** WARNING FROM FRECHET MAXIMUM ',
CCCCC1             'LIKELIHOOD--')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3118)
C3118       FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1             'DESIRED TOLERANCE.')
CCCCC       CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3121)
 3121       FORMAT('***** WARNING FROM FRECHET MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3123)
 3123       FORMAT('      ESTIMATE OF SHAPE PARAMETER MAY BE NEAR ',
     1             'A SINGULAR POINT.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.4)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3131)
 3131       FORMAT('***** ERROR FROM FRECHET MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3133)
 3133       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.5)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3141)
 3141       FORMAT('***** WARNING FROM FRECHET MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3143)
 3143       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          SHAPE=REAL(DXLOW)
          DSUM=0.0D0
          DO3138I=1,N
            DSUM=DSUM + DBLE(Y(I)**(-SHAPE))
 3138     CONTINUE
          SCALE=REAL((DSUM/DBLE(N))**DBLE(1.0D0/DBLE(-SHAPE)))
CCCCC     BN=1.0 + 2.2/AN**1.13
CCCCC     GAMMBC=SHAPE/BN
        ENDIF
      ELSEIF(ICASPL.EQ.'IWML')THEN
        IF(ICENS2.EQ.'ON')THEN
C
C  INVERTED WEIBULL TAKES (1/X) AND THEN USES THE WEIBULL CODE.  AFTER
C  THE PARAMETERS ARE ESTIMATED, THE ESTIMATE OF SCALE NEEDS TO BE
C  INVERTED.

C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C    (1/GHAT) -
C    SUM[i=1 to n][Y(I)**GHAT*LN(Y(I))]/SUM[i=1 to n][[Y(I)**GHAT] +
C    (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
C
C  THEN
C
C    SCALE = ((1/N)*SUM[i=1 to n][Y(I)**GHAT])
C
C  FOR STARTING VALUE, USE
C
C    GHAT = 1.28/(STD DEV OF LOG(Y))
C    
          DO3260I=1,N
            IF(Y(I).LE.0.0)THEN
              IERROR='YES'
              GOTO9000
            ELSE
              Y(I)=1.0/Y(I)
            ENDIF
            X2(I)=LOG(Y(I))
 3260     CONTINUE
C
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
          CALL SD(X2,N,IWRITE,XLOGSD,IBUGG3,IERROR)
C
          DSUM1=0.0D0
          DO3261I=1,N
            DTEMP1(I)=DBLE(Y(I))
            IF(X(I).EQ.1.0)DSUM1=DSUM1 + DLOG(DTEMP1(I))
 3261     CONTINUE
          DWEISM=DSUM1/DBLE(IR)
          XSTART=DBLE(1.28/XLOGSD)
          AE=2.0*0.000001D0*XSTART
          RE=AE
          IN=N
          IFLAG=0
          XLOW=XSTART/2.0D0
          XUP=2.0D0*XSTART
          ITBRAC=0
 3265     CONTINUE
          XLOWSV=XLOW
          XUPSV=XUP
          CALL DFZER2(WEIFUN,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP1)
C
          IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
            XLOW=XLOWSV/2.0D0
            XUP=2.0D0*XUPSV
            ITBRAC=ITBRAC+1
            GOTO3265
          ENDIF
C
          IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3211)
C3211       FORMAT('***** WARNING FROM CENSORED INVERTED WEIBULL MAXIMUM ',
CCCCC1             'LIKELIHOOD--')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3213)
C3213       FORMAT('      ESTIMATE OF GAMMA MAY NOT BE COMPUTED TO ',
CCCCC1             'DESIRED TOLERANCE.')
CCCCC       CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3271)
 3271       FORMAT('***** WARNING FROM CENSORED INVERTED WEIBULL ',
     1             'MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3273)
 3273       FORMAT('      ESTIMATE OF SHAPE PARAMETER MAY BE NEAR ',
     1             'A SINGULAR POINT.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.4)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3281)
 3281       FORMAT('***** ERROR FROM CENSORED INVERTED WEIBULL ',
     1             'MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3283)
 3283       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.5)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3271)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3293)
 3293       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          SHAPE=XLOW
          DSUM1=0.0D0
          DO3268I=1,N
            DSUM1=DSUM1 + DBLE(Y(I)**SHAPE)
 3268     CONTINUE
          SCALE=REAL((DSUM1/DBLE(IR))**DBLE(1.0D0/DBLE(SHAPE)))
          SCALE=1.0/SCALE
        ELSE
C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C    (1/GHAT) -
C    SUM[i=1 to n][Y(I)**GHAT*LN(Y(I))]/SUM[i=1 to n][[Y(I)**GHAT] +
C    (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
C
C  THEN
C
C    SCALE = ((1/N)*SUM[i=1 to n][Y(I)**GHAT])
C
C  FOR STARTING VALUE, USE
C
C    GHAT = 1.28/(STD DEV OF LOG(Y))
C    
          DO3210I=1,N
            IF(Y(I).LE.0.0)THEN
              IERROR='YES'
              GOTO9000
            ELSE
              Y(I)=1.0/Y(I)
            ENDIF
            X2(I)=LOG(Y(I))
 3210     CONTINUE
C
          AN=REAL(N)
C
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGG3,IERROR)
          CALL SD(X2,N,IWRITE,XLOGSD,IBUGG3,IERROR)
          CALL SUM(X2,N,IWRITE,XLOGSM,IBUGG3,IERROR)
          CALL MINIM(Y,N,IWRITE,XMIN,IBUGG3,IERROR)
C
C  ESTIMATES FOR 2-PARAMETER MODEL.  USE DFZER2 TO FIND ROOT OF
C  THE EQUATION GIVEN ABOVE.
C
          DO3201I=1,N
            DTEMP1(I)=DBLE(Y(I))
 3201     CONTINUE
          DWEISM=DBLE(XLOGSM/AN)
          DXSTRT=1.28D0/DBLE(XLOGSD)
          DAE=2.0*0.000001D0*DXSTRT
          DRE=DAE
          IN=N
          IFLAG=0
          DXLOW=DXSTRT/2.0D0
          DXUP=2.0D0*DXSTRT
          ITBRAC=0
 3205     CONTINUE
          XLOWSV=DXLOW
          XUPSV=DXUP
          CALL DFZER2(WEIFUN,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
C
          IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
            DXLOW=XLOWSV/2.0D0
            DXUP=2.0D0*XUPSV
            ITBRAC=ITBRAC+1
            GOTO3205
          ENDIF
C
          IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3211)
C3211       FORMAT('***** WARNING FROM WEIBULL MAXIMUM ',
CCCCC1             'LIKELIHOOD--')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3213)
C3213       FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1             'DESIRED TOLERANCE.')
CCCCC       CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3221)
 3221       FORMAT('***** WARNING FROM WEIBULL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3223)
 3223       FORMAT('      ESTIMATE OF SHAPE PARAMETER MAY BE NEAR ',
     1             'A SINGULAR POINT.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.4)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3231)
 3231       FORMAT('***** ERROR FROM WEIBULL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3233)
 3233       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.5)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3241)
 3241       FORMAT('***** WARNING FROM WEIBULL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3243)
 3243       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          SHAPE=REAL(DXLOW)
          DSUM=0.0D0
          DO3208I=1,N
            DSUM=DSUM + DBLE(Y(I)**SHAPE)
 3208     CONTINUE
          SCALE=REAL((DSUM/DBLE(N))**DBLE(1.0D0/DBLE(SHAPE)))
          SCALE=1.0/SCALE
CCCCC     BN=1.0 + 2.2/AN**1.13
CCCCC     GAMMBC=SHAPE/BN
        ENDIF
      ELSE
        SHAPE=1.0
        SCALE=1.0
        GOTO9000
      ENDIF
      IF(IERROR.EQ.'YES')GOTO9000
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  COMPUTE SELECTED PERCENTILES                **
C               **************************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NP.GT.0)THEN
        IF(ICASPL.EQ.'LNML')THEN
          DO4110I=1,NP
            QPTEMP=QP(I)/100.0
            CALL LGNPPF(QPTEMP,SHAPE,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4110     CONTINUE
        ELSEIF(ICASPL.EQ.'WEML')THEN
          DO4120I=1,NP
            QPTEMP=QP(I)/100.0
            CALL WEIPPF(QPTEMP,SHAPE,MINMAX,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4120     CONTINUE
        ELSEIF(ICASPL.EQ.'GAML')THEN
          DO4130I=1,NP
            QPTEMP=QP(I)/100.0
            CALL GAMPPF(QPTEMP,SHAPE,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4130     CONTINUE
        ELSEIF(ICASPL.EQ.'FLML')THEN
          DO4140I=1,NP
            QPTEMP=QP(I)/100.0
            CALL FLPPF(QPTEMP,SHAPE,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4140     CONTINUE
        ELSEIF(ICASPL.EQ.'EEML')THEN
          DO4150I=1,NP
            QPTEMP=QP(I)/100.0
            CALL GEEPPF(QPTEMP,SHAPE,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4150     CONTINUE
        ELSEIF(ICASPL.EQ.'IGML')THEN
          DO4160I=1,NP
            QPTEMP=QP(I)/100.0
            CALL IGPPF(QPTEMP,SHAPE,ALOC,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4160     CONTINUE
        ELSEIF(ICASPL.EQ.'PAML')THEN
C
C  FOR PARETO, SCALE IS ACTUALLY LOWER BOUND SHAPE PARAMETER.  STANDARD
C  LOCATION AND SCALE PARAMETERS ARE NOT ESTIMATED.
C
          DO4170I=1,NP
            QPTEMP=QP(I)/100.0
            CALL PARPPF(QPTEMP,SHAPE,SCALE,XQP(I))
CCCCC       XQP(I)=SCALE*XQP(I)
 4170     CONTINUE
        ELSEIF(ICASPL.EQ.'GEML')THEN
          MINMAX=1
          DO4180I=1,NP
            QPTEMP=QP(I)/100.0
            CALL GEPPPF(QPTEMP,SHAPE,MINMAX,IGEPDF,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4180     CONTINUE
        ELSEIF(ICASPL.EQ.'GEMO')THEN
          MINMAX=1
          DO4190I=1,NP
            QPTEMP=QP(I)/100.0
            CALL GEPPPF(QPTEMP,SHAPE,MINMAX,IGEPDF,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4190     CONTINUE
        ELSEIF(ICASPL.EQ.'GEDE')THEN
          MINMAX=1
          DO4200I=1,NP
            QPTEMP=QP(I)/100.0
            CALL GEPPPF(QPTEMP,SHAPE,MINMAX,IGEPDF,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4200     CONTINUE
        ELSEIF(ICASPL.EQ.'GECM')THEN
          MINMAX=1
          DO4210I=1,NP
            QPTEMP=QP(I)/100.0
            CALL GEPPPF(QPTEMP,SHAPE,MINMAX,IGEPDF,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4210     CONTINUE
        ELSEIF(ICASPL.EQ.'FRML')THEN
          DO4220I=1,NP
            QPTEMP=QP(I)/100.0
            CALL EV2PPF(QPTEMP,SHAPE,MINMAX,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4220     CONTINUE
        ELSEIF(ICASPL.EQ.'IWML')THEN
          DO4230I=1,NP
            QPTEMP=QP(I)/100.0
            CALL IWEPPF(QPTEMP,SHAPE,XQP(I))
            XQP(I)=SCALE*XQP(I)
 4230     CONTINUE
        ENDIF
      ENDIF
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBM4(Y,X,N,ICASPL,ICENSO,MAXNXT,MINMAX,
     1Y2,X2,
     1DTEMP1,DALPHA,DBETA,DH,
     1IADEDF,
     1ALOC,SCALE,SHAPE,
     1QP,XQP,NP,
     1IUDFLG,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN BOOTSTRAP SAMPLE, GENERATE MAXIMUM
C              LIKELIHOOD ESTIMATES FOR ONE SHAPE (SHAPE),
C              LOCATION (ALOC), AND SCALE (SCALE).
C
C              SUPPORTED DISTRIBUTIONS ARE:
C
C              1) ASYMMETRIC LAPLACE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/1
C     ORIGINAL VERSION--JANUARY   2005.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICENSO
      CHARACTER*4 IADEDF
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION QP(*)
      DIMENSION XQP(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION DALPHA(*)
      DOUBLE PRECISION DBETA(*)
      DOUBLE PRECISION DH(*)
C
CCCCC DOUBLE PRECISION DSUM
CCCCC DOUBLE PRECISION TOL
CCCCC DOUBLE PRECISION XPAR(2)
CCCCC DOUBLE PRECISION FVEC(2)
C
CCCCC DOUBLE PRECISION DN
CCCCC DOUBLE PRECISION DR
CCCCC DOUBLE PRECISION DX
CCCCC DOUBLE PRECISION DXSTRT
CCCCC DOUBLE PRECISION DAE
CCCCC DOUBLE PRECISION DRE
CCCCC DOUBLE PRECISION DXLOW
CCCCC DOUBLE PRECISION DXUP
CCCCC DOUBLE PRECISION XSTRT
CCCCC DOUBLE PRECISION XSTART
CCCCC DOUBLE PRECISION XLOW
CCCCC DOUBLE PRECISION XUP
CCCCC DOUBLE PRECISION XLOWSV
CCCCC DOUBLE PRECISION XUPSV
CCCCC DOUBLE PRECISION AE
CCCCC DOUBLE PRECISION RE
CCCCC DOUBLE PRECISION DGAMM1
CCCCC DOUBLE PRECISION DGAMM2
CCCCC DOUBLE PRECISION DALPHA
CCCCC DOUBLE PRECISION DALPH2
CCCCC DOUBLE PRECISION DSUM1
CCCCC DOUBLE PRECISION DSUM2
CCCCC DOUBLE PRECISION DSUM3
CCCCC DOUBLE PRECISION DSUM4
CCCCC DOUBLE PRECISION TBAR
CCCCC DOUBLE PRECISION H
CCCCC DOUBLE PRECISION DK
C
      DOUBLE PRECISION DHMIN
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
      DOUBLE PRECISION DTERM4
C
      CHARACTER*4 ICENS2
      CHARACTER*4 IWRITE
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
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.14159265358979/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPJB'
      ISUBN2='M4  '
      IWRITE='OFF'
      IUDFLG=0
      ALOC=0.0
      SCALE=1.0
      SHAPE=1.0
      IR=0
      IF(NP.GT.0)THEN
        DO410I=1,NP
          XQP(I)=0.0
  410   CONTINUE
      ENDIF
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  PROCESS THE CENSORING VARIABLE.             **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBM4')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1000I=1,N
        Y2(I)=Y(I)
 1000 CONTINUE
C
      IF(ICENSO.EQ.'ON')THEN
        IR=0
        CALL DISTIN(X,N,IWRITE,X2,NDIST,IBUGG3,IERROR)
        IF(NDIST.EQ.1)THEN
          DO1102I=1,N
            X(I)=1.0
 1102     CONTINUE
          IR=N
        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)THEN
                X(I)=2.0
              ELSE
                IR=IR+1
              ENDIF
 1103       CONTINUE
          ELSE
            ATEMP1=MIN(X2(1),X2(2))
            ATEMP2=MAX(X2(1),X2(2))
            DO1108I=1,N
              IF(X(I).EQ.ATEMP1)THEN
                IR=IR+1
                X(I)=1.0
              ENDIF
              IF(X(I).EQ.ATEMP2)X(I)=2.0
 1108       CONTINUE
          ENDIF
        ELSE
          WRITE(ICOUT,999)
  999     FORMAT(1X)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1104)
 1104     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          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(Y2,X,N,Y,X)
        IF(ICASPL.EQ.'LNML')THEN
          IF(IR.LT.N)THEN
            AHOLD=Y(IR+1)
            DO1240I=IR+1,N
              IF(Y(I).NE.AHOLD)THEN
                WRITE(ICOUT,999)
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,1241)
 1241           FORMAT('***** ERROR FROM CENSORED LOGNORMAL MAXIMUM ',
     1                 'LIKELIHOOD--')
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,1243)
 1243           FORMAT('      CURRENTLY, ONLY SINGLY CENSORED DATA ',
     1                 'IS SUPPORTED FOR THE LOGNORMAL DISTRIBUTION.')
                CALL DPWRST('XXX','WRIT')
                WRITE(ICOUT,1245)
 1245           FORMAT('      MULTIPLY CENSORED DATA WAS DETECTED.')
                CALL DPWRST('XXX','WRIT')
                IERROR='YES'
                GOTO9000
              ENDIF
 1240       CONTINUE
            C=DBLE(AHOLD)
          ENDIF
        ENDIF
C
      ELSE
        CALL SORT(Y2,N,Y)
      ENDIF
C
      ICENS2=ICENSO
      IF(IR.EQ.N)ICENS2='OFF'
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  GENERATE MAXIMUM LIKELIHOOD ESTIMATES         **
C               **  FOR GIVEN DISTRIBUTION                        **
C               ****************************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBM4')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'ADML')THEN
        IF(ICENS2.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2101)
 2101     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2103)
 2103     FORMAT('      CENSORING NOT SUPPORTED FOR THE ',
     1           'ASYMETRIC LAPLACE DISTRIBUTION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
        ELSE
          XMIN=Y(1)
          XMAX=Y(N)
          IR=1
C
          DHMIN=DBLE(CPUMAX)
          DO2110I=1,N
            THETA=Y(I)
            DSUM1=0.0D0
            DSUM2=0.0D0
            DO2120J=1,N
              IF(Y(J).GE.THETA)DSUM1=DSUM1 + DBLE(Y(J) - THETA)
              IF(Y(J).LE.THETA)DSUM2=DSUM2 + DBLE(THETA - Y(J))
 2120       CONTINUE
            DALPHA(I)=DSUM1/DBLE(N)
            DBETA(I)=DSUM2/DBLE(N)
            DH(I)=2.0D0*DLOG(DSQRT(DALPHA(I)) + DSQRT(DBETA(I)))
     1            + DSQRT(DALPHA(I))*DSQRT(DBETA(I))
            IF(DH(I).LT.DHMIN)THEN
              DHMIN=DH(I)
              IR=I
            ENDIF
 2110     CONTINUE
C
C  TO MAKE THIS PROCEDURE AUTOMATIC:
C
C  1. IF IR = 1 OR IR = N, MAXIMUM LIKELIHOOD ESTIMATES DO
C     NOT EXIST.  IN THIS CASE, USE IR=2 OR IR = N-1 (ALTHOUGH
C     THESE ARE NOT EXACT ML ESTIMATES, THIS SEEMS PREFERRABLE
C     TO RETURNING DUMMY VALUES.  HOWEVER, SET THE LOCATION TO
C     Y(1) OR Y(N) (AS APPROPRIATE).
C
C  2. ONE ANOMALY THAT CAN HAPPEN IS FOR DALPHA TO BE ZERO FOR
C     THE LAST SEVERAL VALUES (I.E., WE HAVE TIES FOR THE
C     MAXIMUM VALUE).  IF THIS RESULTS IN THE MINIMUM VALUE,
C     THIS RESULTS IN A DIVISION BY ZERO IN THE ML COMPUTATIONS.
C     IN THIS CASE, LOOP BACK UNTIL WE FIND A NON-ZERO VALUE FOR
C     DALPHA.
C
C
C  NOTE 3/2006: INSTEAD OF TRYING TO FAKE ML ESTIMATES, JUST
C               SET AN ERROR FLAG AND IGNORE THIS BOOTSTRAP SAMPLE.
C
          IF(IR.EQ.1)THEN
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2131)
C2131       FORMAT('***** ERROR FROM ASYMMETRIC DOUBLE EXPONENTIAL ',
CCCCC1             'MAXIMUM LIKELIHOOD--')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2133)
C2133       FORMAT('      ESTIMATE OF LOCATION PARAMTER EQUALS DATA ',
CCCCC1             'MINIMUM.  THE MAXIMUM')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2135)
C2135       FORMAT('      LIKELIHOOD ESTIMATES DO NOT EXIST.  ',
CCCCC1             'HOWEVER, ')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2137)
C2137       FORMAT('      THIS IMPLIES THAT AN EXPONENTIAL MODEL IS ',
CCCCC1             'APPROPRIATE.')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       IERROR='YES'
CCCCC       ALOC=0.0
CCCCC       SCALE=1.0
CCCCC       SHAPE=-1.0
CCCCC       IR=2
CCCCC       ALOC=Y(1)
            IUDFLG=1
            GOTO9000
          ELSEIF(IR.EQ.N)THEN
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2131)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2143)
C2143       FORMAT('      ESTIMATE OF LOCATION PARAMTER EQUALS DATA ',
CCCCC1             'MAXIMUM.  THE MAXIMUM')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2145)
C2145       FORMAT('      LIKELIHOOD ESTIMATES DO NOT EXIST.  ',
CCCCC1             'HOWEVER, ')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2147)
C2147       FORMAT('      THIS IMPLIES THAT A NEGATIVE EXPONENTIAL ',
CCCCC1             'MODEL IS APPROPRIATE.')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       IERROR='YES'
CCCCC       ALOC=0.0
CCCCC       SCALE=1.0
CCCCC       SHAPE=-1.0
CCCCC       GOTO9000
CCCCC       IR=N-1
CCCCC       ALOC=Y(N)
            IUDFLG=1
            GOTO9000
          ELSE
            ALOC=Y(IR)
          ENDIF
C
          DTERM1=DBETA(IR)**(1.0D0/4.0D0)
          DTERM2=DALPHA(IR)**(1.0D0/4.0D0)
          DTERM3=DSQRT(DBETA(IR))
          DTERM4=DSQRT(DALPHA(IR))
          SCALE=DSQRT(2.0D0)*DTERM2*DTERM1*(DTERM3 + DTERM4)
          IF(DTERM2.NE.0.0D0)THEN
            SHAPE=DTERM1/DTERM2
          ELSE
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2131)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,2153)
C2153       FORMAT('      INFINITE VALUE FOR SHAPE PARAMETER.')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       IERROR='YES'
CCCCC       ALOC=0.0
CCCCC       SCALE=1.0
CCCCC       SHAPE=-1.0
            ILAST=IR
            DO2350I=ILAST,2,-1
              IF(DALPHA(I).GT.0.0D0)THEN
                IR=I
                GOTO2359
              ENDIF
 2350       CONTINUE
 2359       CONTINUE
            DTERM1=DBETA(IR)**(1.0D0/4.0D0)
            DTERM2=DALPHA(IR)**(1.0D0/4.0D0)
            DTERM3=DSQRT(DBETA(IR))
            DTERM4=DSQRT(DALPHA(IR))
            SHAPE=DTERM1/DTERM2
            SCALE=DSQRT(2.0D0)*DTERM2*DTERM1*(DTERM3 + DTERM4)
          ENDIF
          IF(SHAPE.LE.0.0)SHAPE=0.00001
          IF(SCALE.LE.0.0)SCALE=1.0
        ENDIF
      ELSE
        SHAPE=1.0
        SCALE=1.0
        ALOC=0.0
        GOTO9000
      ENDIF
      IF(IERROR.EQ.'YES')GOTO9000
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  COMPUTE SELECTED PERCENTILES                **
C               **************************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NP.GT.0)THEN
        IF(ICASPL.EQ.'ADML')THEN
          DO4110I=1,NP
            QPTEMP=QP(I)/100.0
            CALL ADEPPF(QPTEMP,SHAPE,IADEDF,XQP(I))
            XQP(I)=ALOC + SCALE*XQP(I)
 4110     CONTINUE
        ENDIF
      ENDIF
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBPP(Y,X,N,ICASPL,ICENSO,IMETHD,IPPLDP,MAXOBV,
     1MINMAX,
     1Y2,X2,
     1WEIGHH,WEIGHV,RESBW,PREDBW,
     1QP,XQP,NP,
     1PPA0,PPA1,CCXY,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN BOOTSTRAP SAMPLE, GENERATE THE PROBABILITY
C              PLOT AND RETURN THE ESTIMATES FOR LOCATION (PPA0) AND
C              SCALE (PPA1).  BOTH UNCENSORED AND CENSORED PROBABILITY
C              PLOTS ARE SUPPORTED.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/1
C     ORIGINAL VERSION--JANUARY   2005.
C
C
C              SUPPORTED DISTRIBUTIONS ARE:
C
C              1) UNIFORM
C              2) NORMAL
C              3) LOGISTIC
C              4) LAPLACE (DOUBLE EXPONENTIAL)
C              5) CAUCHY
C              6) HALF NORMAL
C              7) EXPONENTIAL
C              8) GUMBEL (EXTREME VALUE TYPE 1)
C              9) SEMI-CIRCULAR
C             10) COSINE
C             11) ANGLIT
C             12) ARCSINE
C             13) HYPERBOLIC SECANT
C             14) HALF CAUCHY
C             15) RAYLEIGH
C             16) SLASH
C             17) HALF LOGISTIC
C             18) LANDAU (NOT IMPLEMENTED)
C
C             ALL OF THESE SUPPORT BOTH CENSORED AND UNCENSORED DATA
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICENSO
      CHARACTER*4 IMETHD
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION WEIGHH(*)
      DIMENSION WEIGHV(*)
      DIMENSION RESBW(*)
      DIMENSION PREDBW(*)
      DIMENSION QP(*)
      DIMENSION XQP(*)
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
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='DPJB'
      ISUBN2='PP  '
      IF(NP.GT.0)THEN
        DO410I=1,NP
          XQP(I)=0.0
  410   CONTINUE
      ENDIF
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  IF SET PROBABILITY PLOT DATA POINTS COMMAND **
C               **  WAS ENTERED, THIN DATA SET BY COMPUTING     **
C               **  PERCENTILES OF THE DATA.  ONLY DO THIS FOR  **
C               **  THE UNCENSORED CASE.                        **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPPLDP.GT.0 .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'
        DO100I=1,NPERC
          P100=ASTRT + REAL(I)*AINC
          CALL PERCEN(P100,Y2,N,IWRITE,X2,MAXOBV,
     1                XPERC,IBUGG3,IERROR)
          X2(I)=XPERC
  100   CONTINUE
        N=NPERC
        DO105I=1,N
          Y2(I)=X2(I)
  105   CONTINUE
      ELSE
        DO110I=1,N
          Y2(I)=Y(I)
  110   CONTINUE
      ENDIF
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBPP')THEN
        WRITE(ICOUT,113)IPPLDP,NPERC,N
  113   FORMAT('      IPPLDP, NPER, N = ',3I8)
        CALL DPWRST('XXX','BUG ')
        DO117I=1,N
          WRITE(ICOUT,118)I,Y2(I)
  118     FORMAT('      I, Y2(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
  117   CONTINUE
      ENDIF
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)
  999     FORMAT(1X)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1104)
 1104     FORMAT('***** ERROR IN JACKNIFE/BOOTSTRAP 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(Y2,X,N,Y,X)
        CALL UNIME3(N,X2,X,IMETHD)
      ELSE
        CALL SORT(Y2,N,Y)
        CALL UNIMED(N,X2)
      ENDIF
      XMIN=Y(1)
      XMAX=Y(N)
C
C               ********************************************************
C               **  STEP 2--                                          **
C               **  GENERATE PROBABILITY PLOT FOR GIVEN DISTRIBUTION  **
C               ********************************************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICNT=0
C
      IF(ICASPL.EQ.'UNPP')THEN
        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
      ELSEIF(ICASPL.EQ.'NOPP')THEN
        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
      ELSEIF(ICASPL.EQ.'LOPP')THEN
        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
      ELSEIF(ICASPL.EQ.'LAPP')THEN
        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
      ELSEIF(ICASPL.EQ.'CAPP')THEN
        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
      ELSEIF(ICASPL.EQ.'HNPP')THEN
        DO1161I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1161
          ICNT=ICNT+1
          CALL HFNPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
 1161   CONTINUE
      ELSEIF(ICASPL.EQ.'EXPP')THEN
        DO1171I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1171
          ICNT=ICNT+1
          CALL EXPPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
 1171   CONTINUE
      ELSEIF(ICASPL.EQ.'GUPP')THEN
        DO1181I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1181
          ICNT=ICNT+1
          CALL EV1PPF(X2(I),MINMAX,X2OUT)
          X2(ICNT)=X2OUT
 1181   CONTINUE
      ELSEIF(ICASPL.EQ.'SEPP')THEN
        DO1191I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1191
          ICNT=ICNT+1
          CALL SEMPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
 1191   CONTINUE
      ELSEIF(ICASPL.EQ.'COPP')THEN
        DO1201I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1201
          ICNT=ICNT+1
          CALL COSPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
 1201   CONTINUE
      ELSEIF(ICASPL.EQ.'ANPP')THEN
        DO1211I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1211
          ICNT=ICNT+1
          CALL ANGPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
 1211   CONTINUE
      ELSEIF(ICASPL.EQ.'ARPP')THEN
        DO1221I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1221
          ICNT=ICNT+1
          CALL ARSPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
 1221   CONTINUE
      ELSEIF(ICASPL.EQ.'HSPP')THEN
        DO1231I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1231
          ICNT=ICNT+1
          CALL HSEPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
 1231   CONTINUE
      ELSEIF(ICASPL.EQ.'HCPP')THEN
        DO1241I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1241
          ICNT=ICNT+1
          CALL HFCPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
 1241   CONTINUE
      ELSEIF(ICASPL.EQ.'RAPP')THEN
        DO1251I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1251
          ICNT=ICNT+1
          CALL RAYPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
1251    CONTINUE
      ELSEIF(ICASPL.EQ.'SLPP')THEN
        DO1261I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1261
          ICNT=ICNT+1
          CALL SLAPPF(X2(I),X2OUT)
          X2(ICNT)=X2OUT
1261    CONTINUE
      ELSEIF(ICASPL.EQ.'LUPP')THEN
        DO1271I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1271
          ICNT=ICNT+1
          X2OUT=LANPPF(X2(I))
          X2(ICNT)=X2OUT
1271    CONTINUE
      ELSEIF(ICASPL.EQ.'HLPP')THEN
        GTEMP=-1.0
        DO1281I=1,N
          IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1281
          ICNT=ICNT+1
          CALL HFLPPF(X2(I),GTEMP,X2OUT)
          X2(ICNT)=X2OUT
1281    CONTINUE
      ELSE
        PPA0=0.0
        PPA1=1.0
        GOTO9000
      ENDIF
C
C               **************************************************
C               **  STEP 3--                                    **
C               **  COMPUTE FITTED LINE TO PROBABILITY PLOT     **
C               **************************************************
C
      ISTEPN='3'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      N2=ICNT
      ICNT=0
      DO1912I=1,N
        IF(ICENSO.EQ.'ON' .AND. X(I).EQ.0.0)GOTO1912
        ICNT=ICNT+1
        Y2(ICNT)=Y(I)
 1912 CONTINUE
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBPP')THEN
        WRITE(ICOUT,2001)N2
 2001   FORMAT('N2 = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(N2.GE.1)THEN
          DO2110I=1,N2
            WRITE(ICOUT,2011)I,Y2(I),X2(I)
 2011       FORMAT('I,Y2(I),X2(I) = ',I8,2G15.7)
            CALL DPWRST('XXX','BUG ')
 2110     CONTINUE
        ENDIF
      ENDIF
C
      CALL LINFIT(Y2,X2,N2,
     1            PPA0,PPA1,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'CAPP' .OR. ICASPL.EQ.'HCPP' .OR.
     1   ICASPL.EQ.'SLPP')THEN
C
         DO6010I=1,N2
           RESBW(I)=Y2(I) - (PPA0 + PPA1*X2(I))
           WEIGHH(I)=1.0
           WEIGHV(I)=1.0
 6010   CONTINUE
        CALL BIWEIG(RESBW,N2,IWRITE,WEIGHV,IBUGG3,IERROR)
C
        IT=1
        I1=1
        I2=N2
        I3=1
        I4=N2
        XMAXHF=1.0
C
        CALL LINEAR(IT,I1,I2,X2,Y2,WEIGHH,WEIGHV,N2,XMAXHF,I3,I4,
     1              PPA0BW,PPA1BW,PREDBW,RESBW,
     1              ISUBRO,IBUGG3,IERROR)
C
        DO6020I=1,N2
          RESBW(I)=Y(I) - (PPA0BW + PPA1BW*X(I))
 6020   CONTINUE
        CALL BIWEIG(RESBW,N2,IWRITE,WEIGHV,IBUGG3,IERROR)
        CALL LINEAR(IT,I1,I2,X2,Y2,WEIGHH,WEIGHV,N2,XMAXHF,I3,I4,
     1              PPA0BW,PPA1BW,PREDBW,RESBW,
     1              ISUBRO,IBUGG3,IERROR)
        PPA0=PPA0BW
        PPA1=PPA1BW
C
      ENDIF
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  COMPUTE SELECTED PERCENTILES                **
C               **************************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'JBPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NP.GT.0)THEN
        IF(ICASPL.EQ.'NOPP')THEN
          DO4110I=1,NP
            QPTEMP=QP(I)/100.0
            CALL NORPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4110     CONTINUE
        ELSEIF(ICASPL.EQ.'UNPP')THEN
          DO4120I=1,NP
            QPTEMP=QP(I)/100.0
            CALL UNIPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4120     CONTINUE
        ELSEIF(ICASPL.EQ.'LOPP')THEN
          DO4130I=1,NP
            QPTEMP=QP(I)/100.0
            CALL LOGPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4130     CONTINUE
        ELSEIF(ICASPL.EQ.'LAPP')THEN
          DO4140I=1,NP
            QPTEMP=QP(I)/100.0
            CALL DEXPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4140     CONTINUE
        ELSEIF(ICASPL.EQ.'CAPP')THEN
          DO4150I=1,NP
            QPTEMP=QP(I)/100.0
            CALL CAUPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4150     CONTINUE
        ELSEIF(ICASPL.EQ.'HNPP')THEN
          DO4160I=1,NP
            QPTEMP=QP(I)/100.0
            CALL HFNPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4160     CONTINUE
        ELSEIF(ICASPL.EQ.'EXPP')THEN
          DO4170I=1,NP
            QPTEMP=QP(I)/100.0
            CALL EXPPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4170     CONTINUE
        ELSEIF(ICASPL.EQ.'GUPP')THEN
          DO4180I=1,NP
            QPTEMP=QP(I)/100.0
            CALL EV1PPF(QPTEMP,MINMAX,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4180     CONTINUE
        ELSEIF(ICASPL.EQ.'SEPP')THEN
          DO4190I=1,NP
            QPTEMP=QP(I)/100.0
            CALL SEMPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4190     CONTINUE
        ELSEIF(ICASPL.EQ.'COPP')THEN
          DO4200I=1,NP
            QPTEMP=QP(I)/100.0
            CALL COSPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4200     CONTINUE
        ELSEIF(ICASPL.EQ.'ANPP')THEN
          DO4210I=1,NP
            QPTEMP=QP(I)/100.0
            CALL ANGPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4210     CONTINUE
        ELSEIF(ICASPL.EQ.'ARPP')THEN
          DO4220I=1,NP
            QPTEMP=QP(I)/100.0
            CALL ARSPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4220     CONTINUE
        ELSEIF(ICASPL.EQ.'HSPP')THEN
          DO4230I=1,NP
            QPTEMP=QP(I)/100.0
            CALL HSEPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4230     CONTINUE
        ELSEIF(ICASPL.EQ.'HCPP')THEN
          DO4240I=1,NP
            QPTEMP=QP(I)/100.0
            CALL HFCPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4240     CONTINUE
        ELSEIF(ICASPL.EQ.'RAPP')THEN
          DO4250I=1,NP
            QPTEMP=QP(I)/100.0
            CALL RAYPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4250     CONTINUE
        ELSEIF(ICASPL.EQ.'SLPP')THEN
          DO4260I=1,NP
            QPTEMP=QP(I)/100.0
            CALL SLAPPF(QPTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4260     CONTINUE
        ELSEIF(ICASPL.EQ.'LUPP')THEN
          DO4270I=1,NP
            QPTEMP=QP(I)/100.0
            XQP(I)=LANPPF(QPTEMP)
            XQP(I)=PPA0 + PPA1*XQP(I)
 4270     CONTINUE
        ELSEIF(ICASPL.EQ.'HLPP')THEN
          GTEMP=-1.0
          DO4280I=1,NP
            QPTEMP=QP(I)/100.0
            CALL HFLPPF(QPTEMP,GTEMP,XQP(I))
            XQP(I)=PPA0 + PPA1*XQP(I)
 4280     CONTINUE
        ENDIF
      ENDIF
C               *******************
C               *******************
C               **   STEP 90--   **
C               **   EXIT        **
C               *******************
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPJBRA(ICASRA,ISEED,MINMAX,
     1Y,NRAN,
     1SHAPE1,SHAPE2,ALOC,SCALE,
     1IMAKDF,IGEODF,IBEIDF,IBEKDF,IGEPDF,IADEDF,
     1ILGADF,ISKNDF,IGLDDF,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE IS CALLED BY THE DPJBS2 ROUTINE
C              (JACKNIFE/BOOTSRAP DISTRIBUTIONAL PLOT).  THIS IS
C              USED TO IMPLEMENT "PARAMETERIC" BOOTSTRAPPING RATHER
C              THAN "NON-PARAMETRIC" BOOTSTRAPPING.  FOR THE
C              NON-PARAMETRIC BOOTSTRAP, THE DEFAULT, THE BOOTSTRAP
C              SAMPLES ARE DRAWN FROM THE SAMPLE.  FOR THE
C              PARAMETRIC BOOTSTRAP, THE FULL SAMPLE IS USED TO
C              ESTIMATE THE DISTRIBUTION PARAMETERS.  THEN THESE
C              PARAMETERS ARE USED TO GENERATE A SAMPLE FROM THAT
C              ESTIMATED DISTRIBUTION FOR EACH BOOTSTRAP SAMPLE.
C              THIS ROUTINE IS USED TO GENERATE THAT SAMPLE.
C
C              GENERATE RANDOM NUMBERS
C              FROM 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
C              16) EXTREME VALUE TYPE 1
C              17) EXTREME VALUE TYPE 2
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 GAUSSIAN
C              26) WALD
C              27) RECIPROCAL INVERSE GAUSSIAN
C              28) FATIGUE LIFE
C              29) GENERALIZED PARETO
C              30) POWER FUNCTION
C              31) HYPERGEOMETRIC
C              32) NON-CENTRAL CHI-SQUARE
C              33) NON-CENTRAL F
C              34) DOUBLY NON-CENTRAL F
C              35) FOLDED NORMAL
C              36) HALF-CAUCHY
C              37) NORMAL MIXTURE
C              38) POWER LAW
C              39) GENERALIZED TUKEY-LAMBDA
C              40) INVERTED WEIBULL
C              41) DOUBLE WEIBULL
C              42) DOUBLE GAMMA
C              43) LOG    GAMMA
C              44) INVERTED GAMMA
C              45) COSINE
C              46) ANGLIT
C              47) HYPERBOLIC SECANT
C              48) ARCSIN
C              49) LOG DOUBLE EXPONENTIAL
C              50) GENERALIZED EXTREM VALU
C              51) EXPONENTIATED WEIBULL
C              52) GOMPERTZ
C              53) HALF-LOGISTIC
C              54) POWER EXPONENTIAL
C              55) ALPHA
C              56) BRADFORD
C              57) RECIPROCAL
C              58) JOHNSON SB
C              59) JOHNSON SU
C              60) POWER NORMAL
C              61) LOG-LOGISTIC
C              62) GEOMETRIC EXTR EXPO
C              63) POWER LOGNORMAL
C              64) BETA-BINOMIAL
C              65) TWO-SIDED POWER
C              66) BIWEIBULL
C              66) LOGARITHMIC SERIES
C              67) G-AND-H
C              68) SLASH
C              69) LANDAU
C              70) INVERTED BETA
C              71) ERROR (=SUBBOTIN
C                         =EXPONENTIAL POWER
C                         =GENERAL ERROR)
C              72) TRAPEZOID
C              73) VON MISES
C              74) PARETO SECOND KIND
C              75) WRAPPED CAUCHY
C              76) GENERALIZED TRAPEZOID
C              77) TRUNCATED NORMAL
C              78) CHI
C              79) FOLDED CAUCHY
C              80) MIELKE'S BETA-KAPPA
C              81) GENERALIZED EXPONENTIAL
C              82) TRUNCATED   EXPONENTIAL
C              83) GENERALIZED GAMMA
C              84) FOLDED T
C              85) SKEWED NORMAL
C              86) SKEWED T
C              87) ZIPF
C              88) GOMPERTZ-MAKEHAM
C              89) GENERALIZED INVERSE GAUSSIAN
C              90) LOG SKEWED NORMAL
C              91) LOG SKEWED T
C              92) NON-CENTRAL T
C              93) DOUBLY NON-CENTRAL T
C              94) GENERALIZED HALF-LOGISTIC
C              95) GENERALIZED LOGISTIC
C              96) POLYA
C              97) HERMITE
C              98) YULE
C              99) WARING
C             100) GENERALIZED WARING
C             101) NON-CENTRAL BETA
C             102) DOUBLY NON-CENTRAL BETA
C             103) SKEW DOUBLE EXPONENTIAL
C             104) ASYMMETRIC DOUBLE EXPONENTIAL
C             105) MAXWELL
C             106) RAYLEIGH
C             107) MCLEISH
C             108) BESSEL I-FUNCTION
C             109) BESSEL K-FUNCTION       (NOT WORKING)
C             110) GENERALIZED MCLEISH
C             111) HYPERBOLIC              (NOT WORKING)
C
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 INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C     UPDATED         --AUGUST    2005. DUNRAN WAS FIXED TO GO FROM
C                                       0 TO N.  THIS ROUTINE WAS
C                                       MODIFIED TO CALL A VERSION
C                                       THAT GOES FROM 1 TO N.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASRA
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IWRITE
      CHARACTER*4 IERROR
C
      CHARACTER*4 IMAKDF
      CHARACTER*4 IGEODF
      CHARACTER*4 IGEPDF
      CHARACTER*4 IADEDF
      CHARACTER*4 IBEIDF
      CHARACTER*4 IBEKDF
      CHARACTER*4 ILGADF
      CHARACTER*4 ISKNDF
      CHARACTER*4 IGLDDF
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*26 IDIST
C
      REAL Y(*)
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-----DATA STATEMENTS-------------------------------------------------
C
      DATA EPS/0.000001/
      DATA ALAMLG/0.00001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPJB'
      ISUBN2='RA  '
C
      IERROR='NO'
C
C               ***********************************************
C               **  TREAT THE RANDOM NUMBER GENERATION CASE  **
C               ***********************************************
C
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBRA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPJBRA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGG3,ISUBRO
   52   FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICASRA,ISEED,MINMAX
   53   FORMAT('ICASRA,ISEED,MINMAX = ',A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)ALOC,SCALE,SHAPE1,SHAPE2
   55   FORMAT('ALOC,SCALE,SHAPE1,SHAPE2 = ',4G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ******************************************
C               **  STEP 1--                            **
C               **  GENERATE    NRAN    RANDOM NUMBERS  **
C               **  FROM THE SPECIFIED DISTRIBUTION.    **
C               **  STORE THEM IN THE VECTOR Y(.).      **
C               ******************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBRA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASRA.EQ.'UNIF')GOTO1010
      IF(ICASRA.EQ.'NORM')GOTO1020
      IF(ICASRA.EQ.'LOGI')GOTO1030
      IF(ICASRA.EQ.'DOUB')GOTO1040
      IF(ICASRA.EQ.'CAUC')GOTO1050
      IF(ICASRA.EQ.'LAMB')GOTO1060
      IF(ICASRA.EQ.'LOGN')GOTO1070
      IF(ICASRA.EQ.'HALF')GOTO1080
      IF(ICASRA.EQ.'T')GOTO1090
      IF(ICASRA.EQ.'CHIS')GOTO1100
      IF(ICASRA.EQ.'F')GOTO1110
      IF(ICASRA.EQ.'EXPO')GOTO1120
      IF(ICASRA.EQ.'GAMM')GOTO1130
      IF(ICASRA.EQ.'BETA')GOTO1140
      IF(ICASRA.EQ.'WEIB')GOTO1150
      IF(ICASRA.EQ.'EXV1')GOTO1160
      IF(ICASRA.EQ.'GUMB')GOTO1160
      IF(ICASRA.EQ.'EXV2')GOTO1170
      IF(ICASRA.EQ.'FREC')GOTO1170
      IF(ICASRA.EQ.'PARE')GOTO1180
      IF(ICASRA.EQ.'BINO')GOTO1190
      IF(ICASRA.EQ.'GEOM')GOTO1200
      IF(ICASRA.EQ.'POIS')GOTO1210
      IF(ICASRA.EQ.'NEGB')GOTO1220
      IF(ICASRA.EQ.'SEMI')GOTO1230
      IF(ICASRA.EQ.'TRIA')GOTO1240
      IF(ICASRA.EQ.'DIUN')GOTO1250
      IF(ICASRA.EQ.'BOOT')GOTO1260
      IF(ICASRA.EQ.'PERM')GOTO1270
      IF(ICASRA.EQ.'IG')GOTO1290
      IF(ICASRA.EQ.'WALD')GOTO1300
      IF(ICASRA.EQ.'RIG')GOTO1310
      IF(ICASRA.EQ.'FL')GOTO1320
      IF(ICASRA.EQ.'GEP')GOTO1330
      IF(ICASRA.EQ.'POWF')GOTO1340
      IF(ICASRA.EQ.'HYPE')GOTO1350
      IF(ICASRA.EQ.'NCCS')GOTO1360
      IF(ICASRA.EQ.'NCF ')GOTO1370
      IF(ICASRA.EQ.'DNCF')GOTO1380
      IF(ICASRA.EQ.'FNRM')GOTO1390
      IF(ICASRA.EQ.'HFCA')GOTO1400
      IF(ICASRA.EQ.'NMRM')GOTO1410
      IF(ICASRA.EQ.'POWL')GOTO1440
      IF(ICASRA.EQ.'GLAM')GOTO1460
      IF(ICASRA.EQ.'IWEI')GOTO1480
      IF(ICASRA.EQ.'DWEI')GOTO1490
      IF(ICASRA.EQ.'DGAM')GOTO1500
      IF(ICASRA.EQ.'LGAM')GOTO1510
      IF(ICASRA.EQ.'IGAM')GOTO1520
      IF(ICASRA.EQ.'COSI')GOTO1530
      IF(ICASRA.EQ.'ANGL')GOTO1540
      IF(ICASRA.EQ.'HSEC')GOTO1550
      IF(ICASRA.EQ.'ARCS')GOTO1560
      IF(ICASRA.EQ.'LDEX')GOTO1570
      IF(ICASRA.EQ.'GEVA')GOTO1580
      IF(ICASRA.EQ.'EWEI')GOTO1590
      IF(ICASRA.EQ.'GOMP')GOTO1600
      IF(ICASRA.EQ.'HALO')THEN
        IFLGHL=0
        GOTO1610
      ENDIF
      IF(ICASRA.EQ.'GHLO')THEN
        IFLGHL=1
        GOTO1610
      ENDIF
      IF(ICASRA.EQ.'POEX')GOTO1620
      IF(ICASRA.EQ.'ALPH')GOTO1630
      IF(ICASRA.EQ.'BRAD')GOTO1640
      IF(ICASRA.EQ.'RECI')GOTO1650
      IF(ICASRA.EQ.'JOSB')GOTO1660
      IF(ICASRA.EQ.'JOSU')GOTO1670
      IF(ICASRA.EQ.'PNOR')GOTO1680
      IF(ICASRA.EQ.'LLOG')GOTO1690
      IF(ICASRA.EQ.'GEEE')GOTO1700
      IF(ICASRA.EQ.'PLNO')GOTO1710
      IF(ICASRA.EQ.'BBIN')GOTO1730
      IF(ICASRA.EQ.'POLY')GOTO1730
      IF(ICASRA.EQ.'STSP')GOTO1760
      IF(ICASRA.EQ.'BIWE')GOTO1790
      IF(ICASRA.EQ.'LOGS')GOTO1850
      IF(ICASRA.EQ.'GH  ')GOTO1860
      IF(ICASRA.EQ.'SLAS')GOTO1880
      IF(ICASRA.EQ.'LAND')GOTO1890
      IF(ICASRA.EQ.'IBET')GOTO1900
      IF(ICASRA.EQ.'ERRO')GOTO1920
      IF(ICASRA.EQ.'TRAP')GOTO1930
      IF(ICASRA.EQ.'VONM')GOTO1940
      IF(ICASRA.EQ.'PAR2')GOTO1950
      IF(ICASRA.EQ.'WRCA')GOTO1960
      IF(ICASRA.EQ.'GTRA')GOTO1970
      IF(ICASRA.EQ.'TNOR')GOTO2010
      IF(ICASRA.EQ.'CHI ')GOTO2040
      IF(ICASRA.EQ.'FCAU')GOTO2050
      IF(ICASRA.EQ.'BKAP')GOTO2060
      IF(ICASRA.EQ.'GEXP')GOTO2090
      IF(ICASRA.EQ.'TEXP')GOTO2120
      IF(ICASRA.EQ.'GGD ')GOTO2150
      IF(ICASRA.EQ.'FT  ')GOTO2170
      IF(ICASRA.EQ.'SKWN')GOTO2180
      IF(ICASRA.EQ.'SKWT')GOTO2190
      IF(ICASRA.EQ.'ZIPF')GOTO2200
      IF(ICASRA.EQ.'GMAK')GOTO2210
      IF(ICASRA.EQ.'GIG ')GOTO2240
      IF(ICASRA.EQ.'SKLN')GOTO2270
      IF(ICASRA.EQ.'SKLT')GOTO2280
      IF(ICASRA.EQ.'NCT ')GOTO2300
      IF(ICASRA.EQ.'DNCT')GOTO2310
      IF(ICASRA.EQ.'GLOG')GOTO2330
      IF(ICASRA.EQ.'HERM')GOTO2340
      IF(ICASRA.EQ.'YULE')GOTO2360
      IF(ICASRA.EQ.'WARI')GOTO2370
      IF(ICASRA.EQ.'GWAR')GOTO2390
      IF(ICASRA.EQ.'NCBE')GOTO2420
      IF(ICASRA.EQ.'DNCB')GOTO2450
      IF(ICASRA.EQ.'SKDE')GOTO2490
      IF(ICASRA.EQ.'ASDE')GOTO2500
      IF(ICASRA.EQ.'MAXW')GOTO2520
      IF(ICASRA.EQ.'RAYL')GOTO2530
      IF(ICASRA.EQ.'GASD')GOTO2540
      IF(ICASRA.EQ.'MCLE')GOTO2560
      IF(ICASRA.EQ.'BESI')GOTO2570
      IF(ICASRA.EQ.'BESK')GOTO2600
      IF(ICASRA.EQ.'GMCL')GOTO2630
      IF(ICASRA.EQ.'HBOL')GOTO2650
C
 5950 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5951)
 5951 FORMAT('***** INTERNAL ERROR IN DPJBRA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5952)
 5952 FORMAT('      AT BRANCH POINT 1951--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5953)
 5953 FORMAT('      ICASRA NOT EQUAL ONE OF THE ALLOWABLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5954)
 5954 FORMAT('      UNIF, NORM, LOGI, DOUB, CAUC, ETC.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5955)
 5955 FORMAT('      EVEN THOUGH ICASRA HAD ALREADY PASSED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5956)ICASRA
 5956 FORMAT('      THIS TEST ONCE BEFORE.  VALUE OF ICASRA = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1010 CONTINUE
      CALL UNIRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1020 CONTINUE
      CALL NORRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1030 CONTINUE
      CALL LOGRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1040 CONTINUE
      CALL DEXRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1050 CONTINUE
      CALL CAURAN(NRAN,ISEED,Y)
      GOTO2990
C
 1060 CONTINUE
      CALL LAMRAN(NRAN,ALAMBA,ISEED,Y)
      GOTO2990
C
 1070 CONTINUE
      CALL LGNRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1080 CONTINUE
      CALL HFNRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1090 CONTINUE
      CALL TRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1100 CONTINUE
      CALL CHSRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1110 CONTINUE
      CALL FRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1120 CONTINUE
      CALL EXPRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1130 CONTINUE
      CALL GAMRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1140 CONTINUE
      CALL BETRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1150 CONTINUE
      CALL WEIRAN(NRAN,SHAPE1,MINMAX,ISEED,Y)
      GOTO2990
C
 1160 CONTINUE
      CALL EV1RAN(NRAN,MINMAX,ISEED,Y)
      GOTO2990
C
 1170 CONTINUE
      CALL EV2RAN(NRAN,GAMMA,MINMAX,ISEED,Y)
      GOTO2990
C
 1180 CONTINUE
      CALL PARRAN(NRAN,GAMMA,A,ISEED,Y)
      GOTO2990
C
 1190 CONTINUE
      CALL BINRAN(NRAN,P,NPAR,ISEED,Y)
      GOTO2990
C
 1200 CONTINUE
      IF(IGEODF.EQ.'DLMF')THEN
        CALL GE2RAN(NRAN,P,ISEED,Y)
      ELSE
        CALL GEORAN(NRAN,P,ISEED,Y)
      ENDIF
      GOTO2990
C
 1210 CONTINUE
      CALL POIRAN(NRAN,ALAMBA,ISEED,Y)
      GOTO2990
C
 1220 CONTINUE
      CALL NBRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1230 CONTINUE
      CALL SEMRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1240 CONTINUE
      ZLOWLM=-1.0
      ZUPPLM=1.0
      CALL TRIRAN(NRAN,C,ZLOWLM,ZUPPLM,ISEED,Y)
      GOTO2990
C
 1250 CONTINUE
      CALL DUNRAN(NRAN,NPAR,ISEED,Y)
      GOTO2990
C
 1260 CONTINUE
CCCCC CALL DUNRAN(NRAN,NRAN,ISEED,Y)
      CALL DUNRA2(NRAN,NRAN,ISEED,Y)
      GOTO2990
C
 1270 CONTINUE
      CALL RANPER(NRAN,ISEED,Y)
      GOTO2990
C
 1290 CONTINUE
      CALL IGRAN(NRAN,SHAPE1,AMU,ISEED,Y)
      GOTO2990
C
 1300 CONTINUE
      CALL WALRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1310 CONTINUE
      CALL RIGRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1320 CONTINUE
      CALL FLRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1330 CONTINUE
      CALL GEPRAN(NRAN,SHAPE1,MINMAX,IGEPDF,ISEED,Y)
      GOTO2990
C
 1340 CONTINUE
      CALL POWRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1350 CONTINUE
CCCCC DO1352II=1,NRAN
CCCCC   CALL HYPRAN(KK,NN1,NN2,ISEED,JX)
CCCCC   IF(JX.EQ.-1)THEN
CCCCC     WRITE(ICOUT,1354)
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     WRITE(ICOUT,1356)INT(AK),INT(AM),INT(AN)
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     IERROR='YES'
CCCCC     GOTO9000
CCCCC   ENDIF
C1354   FORMAT('****** ERROR IN GENERATING HYPERGEOMETRIC RANDOM ',
CCCCC1         'NUMBERS.')
C1356   FORMAT('       THE VALUES OF K, M, AND N = ',3I8)
CCCCC   Y(II)=REAL(JX)
C1352 CONTINUE
      GOTO2990
C
 1360 CONTINUE
      CALL NCCRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1370 CONTINUE
      CALL NCFRAN(NRAN,ANU1,ANU2,ALAMB1,ISEED,Y)
      GOTO2990
C
 1380 CONTINUE
      CALL DNFRAN(NRAN,ANU1,ANU2,ALAMB1,ALAMB2,ISEED,Y)
      GOTO2990
C
 1390 CONTINUE
      CALL FNRRAN(NRAN,U,SD,ISEED,Y)
      GOTO2990
C
 1400 CONTINUE
      CALL HFCRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1410 CONTINUE
C
CCCCC CALL NMXRAN(NRAN,U1,SD1,U2,SD2,P,ISEED,Y)
      GOTO2990
C
 1440 CONTINUE
C
      CALL PWLRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1460 CONTINUE
      CALL GLDRAN(NRAN,SHAPE1,SHAPE2,ISEED,IGLDDF,Y)
      GOTO2990
C
 1480 CONTINUE
      CALL IWERAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1490 CONTINUE
      CALL DWERAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1500 CONTINUE
      CALL DGARAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1510 CONTINUE
      CALL LGARAN(NRAN,SHAPE1,ILGADF,ISEED,Y)
      GOTO2990
C
 1520 CONTINUE
      CALL IGARAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1530 CONTINUE
      CALL COSRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1540 CONTINUE
      CALL ANGRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1550 CONTINUE
      CALL HSERAN(NRAN,ISEED,Y)
      GOTO2990
C
 1560 CONTINUE
      CALL ARSRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1570 CONTINUE
      CALL LDERAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1580 CONTINUE
      CALL GEVRAN(NRAN,SHAPE1,MINMAX,ISEED,Y)
      GOTO2990
C
 1590 CONTINUE
C
      CALL EWERAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1600 CONTINUE
      CALL GOMRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1610 CONTINUE
      CALL HFLRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1620 CONTINUE
      CALL PEXRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1630 CONTINUE
      CALL ALPRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1640 CONTINUE
      CALL BRARAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1650 CONTINUE
      CALL RECRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1660 CONTINUE
      CALL JSBRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1670 CONTINUE
      CALL JSURAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1680 CONTINUE
      CALL PNRRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1690 CONTINUE
      CALL LLGRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1700 CONTINUE
      CALL GEERAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1710 CONTINUE
      CALL PLNRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1730 CONTINUE
C
      IF(ICASRA.EQ.'POLY')THEN
        IDIST='POLYA DISTRIBUTION'
      ELSE
        IDIST='BETA-BINOMIAL DISTRIBUTION'
      ENDIF
C
      IF(ICASRA.EQ.'POLY')THEN
        CALL BBNRAN(SHAPE1,SHAPE2,N,NRAN,ISEED,Y)
      ELSE
        CALL BBNRAN(SHAPE1,SHAPE2,N,NRAN,ISEED,Y)
      ENDIF
      GOTO2990
C
 1760 CONTINUE
      CALL TSPRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1790 CONTINUE
CCCCC CALL BWERAN(NRAN,ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,ISEED,Y)
      GOTO2990
C
 1850 CONTINUE
      CALL DLGRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1860 CONTINUE
      CALL GHRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1880 CONTINUE
      CALL SLARAN(NRAN,ISEED,Y)
      GOTO2990
C
 1890 CONTINUE
      CALL LANRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1900 CONTINUE
      CALL IBRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1920 CONTINUE
      CALL ERRRAN(NRAN,ALPHA,ISEED,Y)
      GOTO2990
C
 1930 CONTINUE
CCCCC CALL TRARAN(NRAN,A,B,C,DZ,ISEED,Y)
      GOTO2990
C
 1940 CONTINUE
      CALL VONRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 1950 CONTINUE
      CALL PA2RAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 1960 CONTINUE
      CALL WCARAN(NRAN,P,ISEED,Y)
      GOTO2990
C
 1970 CONTINUE
CCCCC CALL GTRRAN(NRAN,A,B,C,DZ,ANU1,ANU3,ALPHA,ISEED,Y)
      GOTO2990
C
 2010 CONTINUE
CCCCC CALL TNRRAN(NRAN,A,B,U,SD,ISEED,Y)
      GOTO2990
C
 2040 CONTINUE
      CALL CHRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 2050 CONTINUE
      CALL FCARAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 2060 CONTINUE
CCCCC CALL KAPRAN(NRAN,AK,BETA,THETA,ISEED,Y)
      GOTO2990
C
 2090 CONTINUE
CCCCC CALL GEXRAN(NRAN,ALAM12,ALAM12,S,ISEED,Y)
      GOTO2990
C
 2120 CONTINUE
CCCCC CALL TNERAN(NRAN,X0,AM,SD,ISEED,Y)
      GOTO2990
C
 2150 CONTINUE
      CALL GGDRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 2170 CONTINUE
      CALL FTRAN(NRAN,INT(SHAPE1+0.5),ISEED,Y)
      GOTO2990
C
 2180 CONTINUE
      CALL SNRAN(NRAN,SHAPE1,ISKNDF,ISEED,Y)
      GOTO2990
C
 2190 CONTINUE
      CALL STRAN(NRAN,INT(SHAPE1+0.5),SHAPE2,ISEED,Y)
      GOTO2990
C
 2200 CONTINUE
      CALL ZIPRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 2210 CONTINUE
      IF(IMAKDF.EQ.'DLMF')THEN
CCCCC   CALL MAKRAN(NRAN,XI,ALAMB,THETA,ISEED,Y)
      ELSEIF(IMAKDF.EQ.'MEEK')THEN
CCCCC   XI=GAMMA/AK
CCCCC   THETA=ALAMB/GAMMA
CCCCC   ALAMB=AK
CCCCC   CALL MAKRAN(NRAN,XI,ALAMB,THETA,ISEED,Y)
      ELSEIF(IMAKDF.EQ.'REPA')THEN
C
        CALL MA2RAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      ENDIF
      GOTO2990
C
 2240 CONTINUE
CCCCC CALL GIGRAN(NRAN,CHI,ALAMB,THETA,ISEED,Y)
      GOTO2990
C
 2270 CONTINUE
      CALL LSNRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 2280 CONTINUE
CCCCC CALL LSTRAN(NRAN,NU,ALMBDA,SD,ISEED,Y)
      GOTO2990
C
 2300 CONTINUE
      CALL NCTRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 2310 CONTINUE
CCCCC CALL DNTRAN(NRAN,ANU,ALAMB1,ALAMB2,ISEED,Y)
      GOTO2990
C
 2330 CONTINUE
      CALL GLORAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 2340 CONTINUE
      CALL HERRAN(SHAPE1,SHAPE2,NRAN,ISEED,Y)
      GOTO2990
C
 2360 CONTINUE
      CALL YULRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 2370 CONTINUE
CCCCC CALL GWARAN(NRAN,A,B,C,ISEED,Y)
      GOTO2990
C
 2390 CONTINUE
CCCCC CALL GWARAN(NRAN,A,B,C,ISEED,Y)
      GOTO2990
C
 2420 CONTINUE
CCCCC CALL NCBRAN(NRAN,ALPHA,BETA,ALAMB,ISEED,Y)
      GOTO2990
C
 2450 CONTINUE
CCCCC CALL DNBRAN(NRAN,ALPHA,BETA,ALAMB1,ALAMB2,ISEED,Y)
      GOTO2990
C
 2490 CONTINUE
      CALL SDERAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 2500 CONTINUE
      CALL ADERAN(NRAN,SHAPE1,IADEDF,ISEED,Y)
C
 2520 CONTINUE
      CALL MAXRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 2530 CONTINUE
      CALL RAYRAN(NRAN,ISEED,Y)
      GOTO2990
C
 2540 CONTINUE
CCCCC CALL GALRAN(NRAN,SHAPE1,SHAPE2,IADEDF,ISEED,Y)
      GOTO2990
C
 2560 CONTINUE
      CALL MCLRAN(NRAN,SHAPE1,ISEED,Y)
      GOTO2990
C
 2570 CONTINUE
CCCCC CALL BEIRAN(NRAN,S1SQ,S2SQ,ANU,IBEIDF,ISEED,Y)
C
 2600 CONTINUE
CCCCC CALL BEKRAN(NRAN,S1SQ,S2SQ,ANU,ISEED,Y)
      GOTO2990
C
 2630 CONTINUE
      CALL GMCRAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 2650 CONTINUE
CCCCC CALL HBORAN(NRAN,SHAPE1,SHAPE2,ISEED,Y)
      GOTO2990
C
 2990 CONTINUE
C
      DO3010I=1,N
        Y(I)=ALOC + SCALE*Y(I)
 3010 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'JBRA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPJBRA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)IERROR,IBUGG3,ISUBRO
 9013   FORMAT('IERROR,IBUGG3,ISUBRO = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)ICASRA,ISEED,MINMAX
 9014   FORMAT('ICASRA,ISEED,MINMAX = ',A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)NRAN
 9015   FORMAT('NRAN = ',I8)
        CALL DPWRST('XXX','BUG ')
        DO9020I=1,MIN(NRAN,100)
          WRITE(ICOUT,9021)I,Y(I)
 9021     FORMAT('I,Y(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
 9020   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPJUST(ICOM,IHARG,NUMARG,
     1IDEFJU,
     1ITEXJU,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE JUSTIFICATION TYPE FOR
C              TEXT SCRIPT
C              ON A PLOT.
C              THE JUSTIFICATION FOR THE TEXT WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXJU.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFJU
C                     --IBUGD2
C     OUTPUT ARGUMENTS--ITEXJU
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFJU
      CHARACTER*4 ITEXJU
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPJUST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICOM,NUMARG,IDEFJU
   53 FORMAT('ICOM,NUMARG,IDEFJU = ',A4,2X,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ************************************
C               **  TREAT THE JUSTIFICATION CASE  **
C               ************************************
C
 1110 CONTINUE
      IF(ICOM.EQ.'JUST')GOTO1120
      IF(ICOM.EQ.'LEFT')GOTO1130
      IF(ICOM.EQ.'CENT')GOTO1140
      IF(ICOM.EQ.'RIGH')GOTO1150
C
 1120 CONTINUE
      IF(NUMARG.LE.0)GOTO1161
      IF(IHARG(NUMARG).EQ.'ON')GOTO1161
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1161
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'LEFT')GOTO1161
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CENT')GOTO1162
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'RIGH')GOTO1163
      GOTO1170
C
 1130 CONTINUE
      IF(NUMARG.LE.0)GOTO9000
      IF(IHARG(NUMARG).EQ.'ON')GOTO1161
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1161
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'JUST')GOTO1161
      GOTO9000
C
 1140 CONTINUE
      IF(NUMARG.LE.0)GOTO9000
      IF(IHARG(NUMARG).EQ.'ON')GOTO1162
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1162
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1162
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'JUST')GOTO1162
      GOTO9000
C
 1150 CONTINUE
      IF(NUMARG.LE.0)GOTO9000
      IF(IHARG(NUMARG).EQ.'ON')GOTO1163
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1163
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1163
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'JUST')GOTO1163
      GOTO9000
C
 1161 CONTINUE
      ITEXJU='LEFT'
      GOTO1180
C
 1162 CONTINUE
      ITEXJU='CENT'
      GOTO1180
C
 1163 CONTINUE
      ITEXJU='RIGH'
      GOTO1180
C
 1165 CONTINUE
      ITEXJU=IDEFJU
      GOTO1180
C
 1170 CONTINUE
CCCCC IERROR='YES'
CCCCC WRITE(ICOUT,1171)
C1171 FORMAT('***** ERROR IN DPJUST--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1172)
C1172 FORMAT('      ILLEGAL ENTRY FOR JUSTIFICATION ',
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC1'COMMAND.')
CCCCC WRITE(ICOUT,1173)
C1173 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC1'PROPER FORM--')
CCCCC WRITE(ICOUT,1174)
C1174 FORMAT('      SUPPOSE THE THE ANALYST WISHES ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1175)
C1175 FORMAT('      TO HAVE ALL LEGENDS CENTERED,')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1177)
C1177 FORMAT('      THEN ALLOWABLE FORMS ARE--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1178)
C1178 FORMAT('           JUSTIFICATION CENTER ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1179)
C1179 FORMAT('           CENTER JUSTIFICATION ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC GOTO9000
      ITEXJU=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE JUSTIFICATION (FOR PLOT SCRIPT AND TEXT) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ITEXJU
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)ITEXJU
 8111 FORMAT('THE CURRENT JUSTIFICATION IS ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IDEFJU
 8112 FORMAT('THE DEFAULT JUSTIFICATION IS ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPJUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
 9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ITEXJU,IDEFJU
 9013 FORMAT('ITEXJU,IDEFJU = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPKAPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN KAPLAN-MEIER 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-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--98/5
C     ORIGINAL VERSION--MAY       1998.
C     UPDATED         --JULY      2005. SUPPORT SWITCH FOR WHETHER
C                                       SURVIVAL CURVE (DEFAULT) OR
C                                       CDF CURVE DRAWN
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 ISUBRO
      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 IHRIGH
      CHARACTER*4 IHRIG2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION TAG1(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),TAG1(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPKA'
      ISUBN2='PL  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLV2=0
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'KAPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPKAPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAXCOL
   54 FORMAT('MAXCOL = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C
C               **********************************
C               **  TREAT THE KAPLAN-MEIER PLOT **
C               **********************************
C
C               *******************************************
C               **  STEP 1--                             **
C               **  SEARCH FOR KAPLAN MEIER, KAPLAN-MEIER**
C               **  MODIFIED KAPLAN MEIER, OR MODIFIED   **
C               **  KAPLAN-MEIER                         **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='KAPL'
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'KAPL'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'KAPL'.AND.IHARG(1).EQ.'MEIE'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
C
      ICASPL='MKAP'
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MODI'.AND.IHARG(1).EQ.'KAPL'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
C
      ICASPL='MKAP'
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'MODI'.AND.IHARG(1).EQ.'KAPL'.AND.IHARG(2).EQ.'MEIE'
     1.AND.IHARG(3).EQ.'PLOT')
     1GOTO113
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     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
      IF(ICASPL.EQ.'KAPL'.OR.ICASPL.EQ.'MKAP')GOTO270
C
  260 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPKAPL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,262)
  262 FORMAT('      AT BRANCH POINT 261--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,263)
  263 FORMAT('      ICASPL NOT EQUAL TO    KAPL OR MKAP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,267)
  267 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,268)(IANS(I),I=1,MIN(IWIDTH,80))
  268 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  270 CONTINUE
      MAXV2=2
      GOTO290
C
  290 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     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)
C
C               ***********************************************************
C               **  STEP 12--                                            **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.               **
C               ***********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPKAPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)IHLEFT,IHLEF2
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH A KAPLAN MEIER PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      IS TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1218)(IANS(I),I=1,IWIDTH)
 1218 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ********************************************
C               **  STEP 13--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 2      **
C               **  (THIS WILL BE THE TAG      VARIABLE)  **
C               ********************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHRIGH=IHARG(2)
      IHRIG2=IHARG2(2)
      IHWUSE='V'
      MESSAG='NO'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')THEN
        NUMV=1
        ICOLR=-1
        NRIGHT=-1
      ELSE
        NUMV=2
        ICOLR=IVALUE(ILOCV)
        NRIGHT=IN(ILOCV)
      ENDIF
C
C               ******************************************************
C               **  STEP 14--                                       **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
C               **  FOR THE TAG VARIABLE (NRIGHT) IS THE SAME AS    **
C               **  THE NUMBER OF OBSERVATIONS FOR THE RESPONSE     **
C               ** VARIABLE.                                        **
C               ******************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV.EQ.2.AND.(NLEFT.NE.NRIGHT))THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1411)
 1411   FORMAT('***** ERROR IN DPKAPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1412)
 1412   FORMAT('      IF TWO VARIABLES ARE SPECIFED FOR THE ',
     1         'KAPLAN-MEIER PLOT,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1413)
 1413   FORMAT('      THEY MUST HAVE THE SAME NUMBER OF OBSERVATIONS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1414)
 1414   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1415)IHLEFT,IHLEF2,NLEFT
 1415   FORMAT('      ',A4,A4,' HAS ',I8,' OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1416)IHRIGH,IHRIG2,NRIGHT
 1416   FORMAT('      ',A4,A4,' HAS ',I8,' OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1417)
 1417   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,1418)(IANS(I),I=1,MIN(IWIDTH,80))
 1418   FORMAT('      ',80A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='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
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'KAPL')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  CHECK FOR A VALID NUMBER                 **
C               **  OF VARIABLES                             **
C               **  (EITHER 1 OR 2                           **
C               **  FOR A KAPLAN MEIER PLOT).                **
C               ***********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO2209
      GOTO2250
C
 2209 CONTINUE
      IF(NUMV2.LE.2)GOTO2290
C
 2250 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2251)
 2251 FORMAT('***** ERROR IN DPKAPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2252)
 2252 FORMAT('      FOR A KAPLAN MEIER PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2253)
 2253 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2254)
 2254 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2255)
 2255 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2256)
 2256 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2257)NUMV2
 2257 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2258)
 2258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2259)(IANS(I),I=1,MIN(IWIDTH,80))
 2259 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
C
C               **********************************************
C               **  STEP 31--                               **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE        VARIABLE; **
C               **  FORM THIS VARIABLE BY                   **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='31'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO3110
      IF(ICASQ.EQ.'SUBS')GOTO3120
      IF(ICASQ.EQ.'FOR')GOTO3130
C
 3110 CONTINUE
      DO3115I=1,NLEFT
      ISUB(I)=1
 3115 CONTINUE
      NQ=NLEFT
      GOTO3150
C
 3120 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3150
C
 3130 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3150
C
 3150 CONTINUE
      IF(NQ.GE.MINN2)GOTO3160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3151)
 3151 FORMAT('***** ERROR IN DPKAPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3152)
 3152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3153)IHLEFT,IHLEF2
 3153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3154)
 3154 FORMAT('      (FOR WHICH A KAPLAN MEIER PLOT IS TO BE ',
     1'FORMED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3156)MINN2
 3156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3157)
 3157 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3158)
 3158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3159)(IANS(I),I=1,MIN(IWIDTH,80))
 3159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3160 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3170
      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)
C
      IF(NUMV.EQ.1)THEN
        TAG1(J)=-1.0
      ELSE
        IJ=MAXN*(ICOLR-1)+I
        IF(ICOLR.LE.MAXCOL)TAG1(J)=V(IJ)
        IF(ICOLR.EQ.MAXCP1)TAG1(J)=PRED(I)
        IF(ICOLR.EQ.MAXCP2)TAG1(J)=RES(I)
        IF(ICOLR.EQ.MAXCP3)TAG1(J)=YPLOT(I)
        IF(ICOLR.EQ.MAXCP4)TAG1(J)=XPLOT(I)
        IF(ICOLR.EQ.MAXCP5)TAG1(J)=X2PLOT(I)
        IF(ICOLR.EQ.MAXCP6)TAG1(J)=TAGPLO(I)
      ENDIF
C
 3170 CONTINUE
      NS=J
C
C               *************************************************************
C               **  STEP 41--                                              **
C               **  FORM THE VERTICAL AND HORIZONTALAXIS                   **
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY)FOR THE PLOT.   **
C               **  FORM THE CURVE DESIGNATION VARIABLED(.)  .             **
C               **  THIS WILL BE ALL ONES.                                 **
C               **  DEFINE THE NUMBER OF PLOT POINTS   (NPLOTP).           **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES(NPLOTV).           **
C               *************************************************************
C
      ISTEPN='41'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPKAP2(Y1,TAG1,NS,NUMV,ICASPL,MAXN,
     1IKAPSW,
     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.'KAPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPKAPL--')
      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 DPKAP2(Y1,TAG1,N,NUMV,ICASPL,MAXN,
     1IKAPSW,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN KAPLAN-MEIER PLOT
C     INPUT ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS
C                               FOR THE FIRST  VARIABLE.
C                      TAG1   = 1 = FAILURE TIME, 0 = CENSORED
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     CAUTION--THE INPUT VARIABLE Y1(.) WILL BE CHANGED HEREIN
C              (IT WILL BE SORTED)
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--98/5
C     ORIGINAL VERSION--MAY       1998.
C     UPDATED         --JULY      2005. SWITCH TO SPECIFY WHETHER
C                                       SURVIVAL CURVE (DEFAULT) OR
C                                       CDF CURVE DRAWN
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IKAPSW
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DPROD
      DOUBLE PRECISION DCURR
      DOUBLE PRECISION DN
      DOUBLE PRECISION DCORR
C
      DIMENSION Y1(*)
      DIMENSION TAG1(*)
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='DPKA'
      ISUBN2='P2  '
C
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'KAP2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPKAP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N,ICASPL,MAXN,NUMV
   53 FORMAT('N,ICASPL,MAXN,NUMV = ',I8,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y1(I),TAG1(I)
   56 FORMAT('I, Y1(I), TAG1(I), = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.2)GOTO119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPKAP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)
  113 FORMAT('      MUST BE AT LEAST 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,114)N
  114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      HOLD=Y1(1)
      DO120I=1,N
      IF(Y1(I).NE.HOLD)GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** ERROR IN DPKAP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,122)
  122 FORMAT('      ALL ELEMENTS IN Y1 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,123)HOLD
  123 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  129 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  COMPUTE COORDINATES FOR KAPLAN MEIER PLOT**
C               **  (INCORPORATE STAIR-STEP APPEARANCE)      **
C               ***********************************************
C
      CALL SORTC(Y1,TAG1,N,Y1,TAG1)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'KAP2')THEN
        DO135I=1,N
        WRITE(ICOUT,136)I,Y1(I),TAG1(I)
  136   FORMAT('I, Y1(I), TAG1(I), = ',I8,2E15.7)
        CALL DPWRST('XXX','BUG ')
  135   CONTINUE
      ENDIF
C
      DN=DBLE(N)
      IF(ICASPL.EQ.'KAPL')THEN
        IR=0
        J=1
        X(J)=0.0
        Y(J)=1.0
        D(J)=1.0
C
        DPROD=1.0D0
        DO200I=1,N
          IF(NUMV.GE.2 .AND. ABS(TAG1(I)).LT.0.5)GOTO200
          J=J+1
          X(J)=Y1(I)
          Y(J)=Y(J-1)
          D(J)=1.0
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'KAP2')THEN
            WRITE(ICOUT,203)I,J,X(J),Y(J)
  203       FORMAT('I,J,X(J),Y(J)=',2I8,2G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          DCURR=(DN - DBLE(I))/(DN - DBLE(I) + 1.0D0)
          DPROD=DPROD*DCURR
          J=J+1
          X(J)=Y1(I)
          Y(J)=REAL(DPROD)
          D(J)=1.0
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'KAP2')THEN
            WRITE(ICOUT,204)I,J,X(J),Y(J)
  204       FORMAT('I,J,X(J),Y(J)=',2I8,2G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
  200   CONTINUE
      ELSEIF(ICASPL.EQ.'MKAP')THEN
        IR=0
        J=1
        X(J)=0.0
        Y(J)=1.0
        D(J)=1.0
C
        DPROD=1.0D0
        DCORR=(DN + 0.7D0)/(DN + 0.4D0)
        DO400I=1,N
          IF(NUMV.GE.2 .AND. ABS(TAG1(I)).LT.0.5)GOTO400
          J=J+1
          X(J)=Y1(I)
          Y(J)=Y(J-1)
          D(J)=1.0
          DCURR=(DN - DBLE(I) + 0.7D0)/(DN - DBLE(I) + 1.7D0)
          DPROD=DPROD*DCURR
          J=J+1
          X(J)=Y1(I)
          Y(J)=REAL(DCORR*DPROD)
          D(J)=1.0
  400   CONTINUE
      ENDIF
C
      NPLOTP=J
      NPLOTV=2
C
CCCCC JULY 2005: CONVERT TO CDF FORMAT
C
      IF(IKAPSW.EQ.'CDF')THEN
        DO510I=1,NPLOTP
          Y(I)=1.0 - Y(I)
  510   CONTINUE
      ENDIF
C
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'KAP2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPKAP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,ICASPL,MAXN
 9013 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N
      WRITE(ICOUT,9016)I,Y1(I)
 9016 FORMAT('I, Y1(I), = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)NPLOTP,NPLOTV
 9021 FORMAT('NPLOTP,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,NPLOTP
      WRITE(ICOUT,9023)I,Y(I),X(I),D(I)
 9023 FORMAT('I,Y(I),X(I),D(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPKDEN(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IKDENP,PKDEWI,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A KERNEL DENSITY PLOT USING A 
C              GAUSSIAN WINDOW.  USES APPLIED STATISTICS
C              ALGORITHM 176 (BY B. W. SILVERMAN).
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--2001/8
C     ORIGINAL VERSION--AUGUST    2001.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DOUBLE PRECISION Y1(MAXOBV)
      DOUBLE PRECISION SMOOTH(MAXOBV)
      DOUBLE PRECISION FT(MAXOBV)
      INCLUDE 'DPCOZD.INC'
      EQUIVALENCE (DGARBG(IDGAR1),Y1(1))
      EQUIVALENCE (DGARBG(IDGAR2),SMOOTH(1))
      EQUIVALENCE (DGARBG(IDGAR3),FT(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
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPKD'
      ISUBN2='EN  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=1
      MINN2=20
C
      ICOLR=0
C
C               ***************************************************
C               **  TREAT THE KERNEL DENSITY PLOT                **
C               ***************************************************
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KDEN')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPKDEN--')
        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.'KDEN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'KERN'.AND.IHARG(1).EQ.'PLOT')GOTO110
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'KERN'.AND.IHARG(1).EQ.'DENS'.AND.IHARG(2).EQ.'PLOT')
     1GOTO120
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'DENS'.AND.IHARG(1).EQ.'PLOT')GOTO110
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'DENS'.AND.IHARG(1).EQ.'TRAC')GOTO110
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ICASPL='KDEN'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  120 CONTINUE
      ICASPL='KDEN'
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KDEN')
     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--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KDEN')
     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')WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               *****************************************************
C               **  STEP 3--                                       **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS    **
C               **  (NLEFT) FOR THE RESPONSE VARIABLE IS POSITIVE. **
C               *****************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KDEN')
     1CALL 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 DPKDEN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      KERNEL DENSITY PLOT WAS TO HAVE BEEN FORMED MUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      BE ',I8,' OR LARGER; SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,318)(IANS(I),I=1,MIN(IWIDTH,80))
  318   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPKDEN AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH NUMARG HAD PASSED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      THIS TEST ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,487)(IANS(I),I=1,MIN(80,IWIDTH))
  487   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KDEN')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************************************
C               **  STEP 6--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  (BASED ON THE QUALIFIER)           **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
C               *****************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'KDEN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=DBLE(V(IJ))
      IF(ICOLL.EQ.MAXCP1)Y1(J)=DBLE(PRED(I))
      IF(ICOLL.EQ.MAXCP2)Y1(J)=DBLE(RES(I))
      IF(ICOLL.EQ.MAXCP3)Y1(J)=DBLE(YPLOT(I))
      IF(ICOLL.EQ.MAXCP4)Y1(J)=DBLE(XPLOT(I))
      IF(ICOLL.EQ.MAXCP5)Y1(J)=DBLE(X2PLOT(I))
      IF(ICOLL.EQ.MAXCP6)Y1(J)=DBLE(TAGPLO(I))
C
  660 CONTINUE
      NLOCAL=J
C
C               *****************************************************
C               **  STEP 8--                                       **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
C               **  RESET THE VECTOR D(.) TO ALL ONES.             **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
C               *****************************************************
C
      CALL DPKDE2(Y1,FT,SMOOTH,
     1NLOCAL,ICASPL,IKDENP,PKDEWI,MINN2,
     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.'KDEN')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPKDEN--')
        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)IKDENP,PKDEWI
 9014   FORMAT('IKDENP,PKDEWI = ',I8,2X,G15.7)
        CALL DPWRST('XXX','BUG ')
        IF(NPLOTP.LE.0)GOTO9090
        DO9015I=1,NPLOTP
          WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016     FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
         CALL DPWRST('XXX','BUG ')
 9015   CONTINUE
 9090   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPKDE2(Y,FT,SMOOTH,
     1N,ICASPL,IKDENP,PKDEWI,MINN2,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A KERNEL DENSITY PLOT.  USES THE
C              APPLIED STATISTICS ALGORITHM 176 OF B. W. SILVERMAN
C              (COMPUTES KERNEL ESTIMATE USING THE FFT).
C              CURRENTLY, ONLY A GAUSSIAN KERNEL FUNCTION IS
C              SUPPORTED.
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--2001/8
C     ORIGINAL VERSION--AUGUST    2001.
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
      DOUBLE PRECISION DH
      DOUBLE PRECISION DHI
      DOUBLE PRECISION DLO
      DOUBLE PRECISION DN
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DX
      DOUBLE PRECISION DMEAN
      DOUBLE PRECISION DVAR
      DOUBLE PRECISION DSD
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION Y(*)
      DOUBLE PRECISION FT(*)
      DOUBLE PRECISION SMOOTH(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPKD'
      ISUBN2='E2  '
C
      IERROR='NO'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LT.MINN2)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN DPKDE2--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
      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 DPKDE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL INPUT HORIZONTAL AXIS ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'KDE2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,70)
   70   FORMAT('***** AT THE BEGINNING OF DPKDE2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)N,IKDENP,PKDEWI
   72   FORMAT('N,IKDENP,PKDEWI = ',I6,2G15.7)
        CALL DPWRST('XXX','BUG ')
        DO73I=1,N
        WRITE(ICOUT,74)I,REAL(Y(I))
   74   FORMAT('I, Y(I) = ',I8,G15.7)
        CALL DPWRST('XXX','BUG ')
   73   CONTINUE
      ENDIF
C
C               **********************************************
C               **  STEP 2--                                **
C               **  CALL DENEST ROUTINE TO COMPUTE THE      **
C               **  KERNEL DENSITY ESTIMATE.                **
C               **********************************************
C
      IERROR='NO'
      ICAL=0
      KFLAG=1
      CALL DSORT(Y,Y,N,KFLAG,IERROR)
      DH=DBLE(PKDEWI)
      IF(PKDEWI.LE.0)THEN
        DN=N
        DSUM=0.0D0
        DO200I=1,N
          DX=Y(I)
          DSUM=DSUM+DX
  200   CONTINUE
        DMEAN=DSUM/DN
        DSUM=0.0D0
        DO300I=1,N
          DX=Y(I)
          DSUM=DSUM+(DX-DMEAN)**2
  300   CONTINUE
        DVAR=DSUM/(DN-1.0D0)
        DSD=0.0D0
        IF(DVAR.GT.0.0D0)DSD=DSQRT(DVAR)
C
        P=0.25
        AN=REAL(N)
        ANI=P*(AN+1.0)
        NI=ANI
        A2NI=NI
        REM=ANI-A2NI
        NIP1=NI+1
        IF(NI.LE.1)NI=1
        IF(NI.GE.N)NI=N
        IF(NIP1.LE.1)NIP1=1
        IF(NIP1.GE.N)NIP1=N
        XPERC1=(1.0-REM)*Y(NI)+REM*Y(NIP1)
C
        P=0.75
        ANI=P*(AN+1.0)
        NI=ANI
        A2NI=NI
        REM=ANI-A2NI
        NIP1=NI+1
        IF(NI.LE.1)NI=1
        IF(NI.GE.N)NI=N
        IF(NIP1.LE.1)NIP1=1
        IF(NIP1.GE.N)NIP1=N
        XPERC2=(1.0-REM)*Y(NI)+REM*Y(NIP1)
        AIQ=(XPERC2-XPERC1)/1.34
C
CCCCC   DH=DBLE(1.06)*DSD*DN**(-1.0D0/5.0D0)
        DH=0.9D0*MIN(DSD,DBLE(AIQ))*DN**(-1.0D0/5.0D0)
      ENDIF
      DLO=Y(1) - 3.0D0*DH
      DHI=Y(N) + 3.0D0*DH
C
      CALL DENEST(Y,N,DLO,DHI,DH,FT,SMOOTH,IKDENP,ICAL,IERROR)
C
      IF(IERROR.EQ.'YES')GOTO9000
C
      DO410I=1,IKDENP
        Y2(I)=REAL(SMOOTH(I))
        X2(I)=REAL(DLO + (DBLE(I) - 0.5D0)*(DHI-DLO)/DBLE(IKDENP))
        D2(I)=1.0
  410 CONTINUE
C
      N2=IKDENP
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'KDE2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPKDE2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)ICASPL,IERROR,N2
 9012   FORMAT('ICASPL,IERROR,N2 = ',A4,2X,A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)REAL(DLO),REAL(DHI),REAL(DH),REAL(DSD)
 9013   FORMAT('DLO,DHI,DH,DSD = ',4G15.7)
        CALL DPWRST('XXX','BUG ')
        DO9015I=1,N2
        WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016   FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
        CALL DPWRST('XXX','BUG ')
 9015   CONTINUE
 9090   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPKDNP(IHARG,IARGT,ARG,NUMARG,
     1IKDENP,IDEFKN,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE NUMBER OF POINTS USED FOR THE KERNEL DENSITY
C              CURVE IN THE KERNEL DENSITY PLOT COMMAND.
C              THE SPECIFIED KERNEL DENSITY POINTS VALUE WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE IKDENP.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFKN (A FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--IKDENP  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2001/8
C     ORIGINAL VERSION--AUGUST    2001.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'POIN')GOTO1110
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      GOTO9000
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'POIN')GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPKDNP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR KERNEL DENSITY POINTS COMMAND.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      HOLD=IDEFKN
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IKDENP=INT(HOLD+0.5)
      IKLOW=5
      IKHIGH=11
      IF(IKDENP.LE.2**IKLOW)THEN
        IKDENP=2**IKLOW
      ELSEIF(IKDENP.GT.2**IKHIGH)THEN
        IKDENP=2**IKHIGH
      ELSE
        DO1185K=IKLOW,IKHIGH
          IF(IKDENP.GT.2**(K-1).AND.IKDENP.LE.2**K)THEN
            IKDENP=2**K
            GOTO1189
          ENDIF
 1185   CONTINUE
      ENDIF
 1189 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)IKDENP
 1281 FORMAT('THE KERNEL DENSITY POINTS HAS JUST BEEN SET ',
     1       'TO ',I8)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)IKDENP
 8111 FORMAT('THE CURRENT KERNEL DENSITY POINTS    IS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8121)IDEFKN
 8121 FORMAT('THE DEFAULT KERNEL DENSITY POINTS    IS ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPKDWI(IHARG,IARGT,ARG,NUMARG,
     1PKDEWI,DEFKWI,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SMOOTHING WIDTH FOR THE
C              TO BE USED FOR THE KERNEL DENSITY ESTIMATOR.
C              THE SPECIFIED KERNEL DENSITY WIDTH VALUE WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PKDEWI.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFKWI (A FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--PKDEWI  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2001/8
C     ORIGINAL VERSION--AUGUST    2001.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'WIDT')GOTO1110
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      GOTO9000
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'WIDT')GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPKDWI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR KERNEL DENSITY WIDTH COMMAND.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      HOLD=DEFKWI
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PKDEWI=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      IF(PKDEWI.NE.DEFKWI)THEN
        WRITE(ICOUT,1281)PKDEWI
 1281   FORMAT('THE KERNEL DENSITY WIDTH HAS JUST BEEN SET ',
     1         'TO ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,1291)
 1291   FORMAT('THE KERNEL DENSITY WIDTH HAS JUST BEEN SET ',
     1         'TO THE DEFAULT.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1293)
 1293   FORMAT('DATAPLOT WILL SELECT THE WIDTH BASED ON THE DATA.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1289 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)PKDEWI
 8111 FORMAT('THE CURRENT KERNEL DENSITY WIDTH    IS ',G15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8121)DEFKWI
 8121 FORMAT('THE DEFAULT KERNEL DENSITY WIDTH    IS ',G15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPKNOT(IHARG,IHARG2,NUMARG,IDEFK1,IDEFK2,
     1IKNOT1,IKNOT2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE USER VARIABLE NAME IN WHICH
C              THE KNOTS FOR SPLINE FITTING RESIDE.
C              CHARACTERS 1 TO 4 OF THE SPECIFIED KNOT NAME
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IKNOT1;
C              CHARACTERS 5 TO 8 OF THE SPECIFIED KNOT NAME
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IKNOT2.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IHARG2 (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFK1 (A  HOLLERITH VARIABLE)
C                     --IDEFK2 (A  HOLLERITH VARIABLE)
C     OUTPUT ARGUMENTS--IKNOT1 (A  HOLLERITH VARIABLE)
C                     --IKNOT2 (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-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--NOVEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IDEFK1
      CHARACTER*4 IDEFK2
      CHARACTER*4 IKNOT1
      CHARACTER*4 IKNOT2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
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
      GOTO1110
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
      GOTO1160
C
 1150 CONTINUE
      IHOLD1=IDEFK1
      IHOLD2=IDEFK2
      GOTO1180
C
 1160 CONTINUE
      IHOLD1=IHARG(NUMARG)
      IHOLD2=IHARG2(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IKNOT1=IHOLD1
      IKNOT2=IHOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IKNOT1,IKNOT2
 1181 FORMAT('THE KNOTS VARIABLE HAS JUST BEEN DESIGNATED AS ',
     1A4,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IKNOT1.EQ.'    '.AND.IKNOT2.EQ.'    ')WRITE(ICOUT,1182)
 1182 FORMAT('(THAT IS, THE NO-KNOTS CASE IS BEING ASSUMED)')
      IF(IKNOT1.EQ.'    '.AND.IKNOT2.EQ.'    ')CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPKRUS(YTEMP,XTEMP,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT KRUSKAL-WALLIS TEST
C              NON-PARAMETRIC ONE-WAY ANOVA
C     EXAMPLE--KRUSKAL-WALLIS TEST Y X
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/6
C     ORIGINAL VERSION--JUNE      1999.
C     UPDATED         --OCTOBER   2004. SUPPORT FOR HTML AND LATEX
C                                       OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION DTAG(MAXOBV)
      DIMENSION ARANK(MAXOBV)
      DIMENSION NRANK(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE(GARBAG(IGARB1),DTAG(1))
      EQUIVALENCE(GARBAG(IGARB2),ARANK(1))
C
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE(IGARBG(IIGAR1),NRANK(1))
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPKR'
      ISUBN2='US  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ******************************************
C               **  TREAT THE KRUSKAL-WALLIS TEST CASE  **
C               ******************************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPKRUS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPKRUS--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR KRUSKAL-WALLIS TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,IWIDTH)
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPKRUS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH KRUSKAL-WALLIS TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS SHOULD ALSO BE A VARIABLE)  **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2141)
 2141    FORMAT('***** ERROR IN DPKRUS--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2142)
 2142    FORMAT('      FOR KRUSKAL-WALLIS TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2145)
 2145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2146)
 2146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2147)
 2147    FORMAT('      ARGUMENT 2 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2148)
 2148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,2150)(IANS(I),I=1,IWIDTH)
 2150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
 2190 CONTINUE
C
C               *******************************************************
C               **  STEP 22--                                        **
C               **  IF ARGUMENT 2 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2) **
C               **  FOR ARGUMENT 2 IS THE SAME AS ARGUMENT 1.        **
C               *******************************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.NE.'V')GOTO2290
      IF(N2.EQ.N1)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPKRUS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (FOR VARIABLE 2 OF KRUSKAL-WALLIS TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      MUST BE THE SAME AS VARIABLE 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)N1,N2
 2216 FORMAT('      N1 = ',I8,' N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2219)
 2219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2220)(IANS(I),I=1,IWIDTH)
 2220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1. **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPKRUS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH KRUSKAL-WALLIS TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH)
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 42--                                **
C               **  TEMPORARILY FORM THE VARIABLE X(.)       **
C               **  WHICH WILL HOLD THE DATAN FROM SAMPLE 2. **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE2.NE.'V')GOTO4290
C
      ISTEPN='42'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4210
      IF(ICASEQ.EQ.'SUBS')GOTO4220
      IF(ICASEQ.EQ.'FOR')GOTO4230
C
 4210 CONTINUE
      DO4215I=1,N2
      ISUB(I)=1
 4215 CONTINUE
      NQ=N2
      GOTO4250
C
 4220 CONTINUE
      NIOLD=N2
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4250
C
 4230 CONTINUE
      NIOLD=N2
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4250
C
 4250 CONTINUE
      IF(NQ.GE.MINN2)GOTO4260
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4251)
 4251 FORMAT('***** ERROR IN DPKRUS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4252)
 4252 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4253)IH21,IH22
 4253 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4254)
 4254 FORMAT('      (FOR WHICH KRUSKAL-WALLIS TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4255)
 4255 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4256)MINN2
 4256 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4257)NQ
 4257 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4258)
 4258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH)
 4259 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4260 CONTINUE
      J=0
      IMAX=N2
      IF(NQ.LT.N2)IMAX=NQ
      DO4270I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4270
      J=J+1
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
 4270 CONTINUE
      NS2=J
C
 4290 CONTINUE
C
C               *********************************
C               **  STEP 52--                  **
C               **  DO KRUSKAL-WALLIS TEST     **
C               *********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPKRUS, AS WE ARE ABOUT TO CALL DPKRU2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      DO5217I=1,NS1
      WRITE(ICOUT,5218)I,Y(I)
 5218 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5217 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPKRU2(Y,X,NS1,
     1YTEMP,XTEMP,DTAG,ARANK,NRANK,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
     1ICAPSW,ICAPTY,
     1IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPKR'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF0 '
      VALUE0=CUT0
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF50'
      VALUE0=CUT50
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF75'
      VALUE0=CUT75
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF90'
      VALUE0=CUT90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF95'
      VALUE0=CUT95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF99'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='F999'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPKRUS--')
      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 DPKRU2(Y,TAG,N,
     1YTEMP,XTEMP,DTAG,ARANK,NRANK,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUTL99,CUTU99,
     1ICAPSW,ICAPTY,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT KRUSKALL-WALLIS'S TEST
C              NON-PARAMETRIC ONE-WAY ANOVA
C     EXAMPLE--KRUSKALL-WALLIS TEST Y TAG
C     REFERENCE--W. J. CONOVER, "PRACTICAL NONPARAMETRIC
C                STATISTICS", THIRD EDITION, 1999, WILEY,
C                PP. 288-297.
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/6
C     ORIGINAL VERSION--JUNE      1999.
C     UPDATED         --OCTOBER   2004. SUPPORT FOR HTML AND LATEX
C                                       OUTPUT
C     UPDATED         --OCTOBER   2004. ADD MULTIPLE COMPARISONS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBASLC
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*3 IATEMP
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
C
      EXTERNAL SUM
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION DTAG(*)
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
      DIMENSION ARANK(*)
      DIMENSION NRANK(*)
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='DPKR'
      ISUBN2='U2  '
      ISUBRO='    '
      ISUBN0='    '
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 DPKRU2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,65)N
   65 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO66I=1,N
      WRITE(ICOUT,67)I,TAG(I)
   67 FORMAT('I,TAG(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPKRU2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPKRU2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPKRU2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(N.GE.1)GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPKRU2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 2 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1212)N
 1212 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1219 CONTINUE
C
      IF(N.EQ.1)GOTO1220
      GOTO1229
 1220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** NOTE FROM DPKRU2--VARIABLE 2 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1229 CONTINUE
C
      HOLD=TAG(1)
      DO1235I=2,N
      IF(TAG(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM DPKRU2--VARIABLE 2 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
 1290 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR KRUSKALL-WALLIS TEST **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      CALL DISTIN(TAG,N,IWRITE,DTAG,NUMDIS,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      CALL SORTC(TAG,Y,N,TAG,Y)
      CALL RANK(Y,N,IWRITE,XTEMP,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
CCCCC OCTOBER 2004: THE KRUSKAL-WALLIS STATISTIC FOR THE CASE
CCCCC WITH NO TIES IS:
CCCCC
CCCCC    H = [12/(N*(N+1)]*SUM[i=1 to k][R(i)**2/N(i)] - 3*(N+1)
CCCCC
CCCCC THE FORMULA WITH TIES IS:
CCCCC
CCCCC    H = (1/S**2)*{SUM[i=1 to k][R(i)**2/N(i) - N*(N+1)**2/4}
CCCCC
CCCCC GO AHEAD AND USE THE TIES FORMULA SINCE IT IS JUST AS EASY
CCCCC AND IT ALSO FACILATES THE COMPUTATION OF MULTIPLE COMPARISONS.
C
CCCCC AFACT=12.0/(REAL(N)*REAL(N+1))
      AN=REAL(N)
      AFACT=AN*(AN+1.0)**2/4.0
C
      DSUM1=0.0D0
      DO4200IDIS=1,NUMDIS
         J=0
         DO4300I=1,N
            IF(TAG(I).EQ.DTAG(IDIS))THEN
               J=J+1
               YTEMP(J)=XTEMP(I)
            ENDIF
 4300    CONTINUE
         NRANK(IDIS)=J
         ANR=REAL(NRANK(IDIS))
         CALL SUM(YTEMP,NRANK(IDIS),IWRITE,YSUM,IBUGA3,IERROR)
         ARANK(IDIS)=YSUM
         DSUM1=DSUM1 + DBLE(YSUM)**2/DBLE(ANR)
 4200 CONTINUE
C
      DSUM2=0.0D0
      DO4310I=1,N
        DSUM2=DSUM2 + DBLE(XTEMP(I))**2
 4310 CONTINUE
      S2=REAL((DSUM2 - DBLE(AFACT))/DBLE(N-1))
C
CCCCC CALL MEAN(Y,N,IWRITE,TBAR,IBUGA3,IERROR)
C
      DTERM1=DSUM1 - DBLE(AFACT)
      STATVA=DTERM1/DBLE(S2)
      NUMDF=NUMDIS-1
      CALL CHSCDF(STATVA,NUMDF,STATCD)
C
      CUT0=0.0
      CALL CHSPPF(.50,NUMDF,CUT50)
      CALL CHSPPF(.75,NUMDF,CUT75)
      CALL CHSPPF(.90,NUMDF,CUT90)
      CALL CHSPPF(.95,NUMDF,CUT95)
      CALL CHSPPF(.99,NUMDF,CUT99)
      CALL CHSPPF(.999,NUMDF,CUT999)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(STATVA.LE.CUT95)ICONC2='ACCEPT'
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='FRI2'
      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
      WRITE(IOUNI1,2005)
 2005 FORMAT('     I       J    ',
     1       '|Ri/Ni-Rj/nj|      ',
     1       '90% CV        ',
     1       '95% CV        ',
     1       '99% CV        ')
C
      IDF=N-NUMDIS
      ALPHA=0.05
      CALL TPPF(1.0-ALPHA/2.0,IDF,AT95)
      ALPHA=0.10
      CALL TPPF(1.0-ALPHA/2.0,IDF,AT90)
      ALPHA=0.01
      CALL TPPF(1.0-ALPHA/2.0,IDF,AT99)
      AN=REAL(N)
      AFACT2=SQRT(S2*(AN-1.0-STATVA)/REAL(N-NUMDIS))
C
      DO2030I=1,NUMDIS
        DO2039J=1,NUMDIS
          IF(I.LT.J)THEN
            ANI=REAL(NRANK(I))
            ANJ=REAL(NRANK(J))
            ADIFF=ABS((ARANK(I)/ANI) - (ARANK(J)/ANJ))
            AFACT3=SQRT((1.0/ANI) + (1.0/ANJ))
            ACV90=AT90*AFACT2*AFACT3
            ACV95=AT95*AFACT2*AFACT3
            ACV99=AT99*AFACT2*AFACT3
            IATEMP='   '
            IF(ADIFF.GE.ACV90)IATEMP(1:1)='*'
            IF(ADIFF.GE.ACV95)IATEMP(2:2)='*'
            IF(ADIFF.GE.ACV99)IATEMP(3:3)='*'
            WRITE(IOUNI1,2037)I,J,ADIFF,ACV90,ACV95,ACV99,IATEMP
 2037       FORMAT(I6,2X,I6,2X,4E15.7,A3)
          ENDIF
 2039   CONTINUE
 2030 CONTINUE
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 42--                **
C               **   WRITE OUT EVERYTHING     **
C               **   FOR KRUSKALL-WALLIS TEST **
C               ********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: WRITE HEADER
C
        WRITE(ICOUT,5001)
 5001   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
 5002   FORMAT('<CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5003)NUMDIS
 5003   FORMAT('<B>KRUSKAL WALLIS TEST THAT THE ',I8,' GROUPS ',
     1         'COME FROM IDENTICAL DISTRIBUTIONS</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
 5004   FORMAT('</CENTER> <BR><BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START LIST
C
        WRITE(ICOUT,5005)
 5005   FORMAT('<OL>')
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2A: LIST ITEM 1
C
        WRITE(ICOUT,5006)
 5006   FORMAT('   <LI>Statistics:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
 5007   FORMAT('       <P>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
 5011   FORMAT('       <TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
 5021   FORMAT('         <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
 5023   FORMAT('            <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5025)
 5025   FORMAT('               Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
 5027   FORMAT('            </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
 5026   FORMAT('            <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)N
 5029   FORMAT('                ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
 5028   FORMAT('         </TR>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5041)
 5041   FORMAT('               Number of Groups:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)NUMDIS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
 5043   FORMAT('               Kruskal-Wallis Test Statstic:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)STATVA
 5051   FORMAT('            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5091)
 5091   FORMAT('       </TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: LIST ITEM 2
C
        WRITE(ICOUT,5066)
 5066   FORMAT('   <LI>Percent Points of the Chi-Square Reference ',
     1         'Distribution<br>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
 5067   FORMAT('       for Kruskal-Wallis Test Statistic:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
 5071   FORMAT('               0    Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
 5072   FORMAT('               50   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT50
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
 5073   FORMAT('               75   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT75
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
 5074   FORMAT('               90   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
 5075   FORMAT('               95   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5076)
 5076   FORMAT('               99   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT99
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5077)
 5077   FORMAT('               99.5 Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT999
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5078)100.0*STATCD
 5078   FORMAT('<br>               ',G15.7,' Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)STATVA
 5052   FORMAT('<br>            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2C: LIST ITEM 3
C
        WRITE(ICOUT,5081)
 5081   FORMAT('   <LI>Conclusion (at the 5% level):')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,5087)NUMDIS
 5087     FORMAT('        The ',I8,' groups come from identical ', 
     1           'populations.')
        ELSE
          WRITE(ICOUT,5088)NUMDIS
 5088     FORMAT('        The ',I8,' groups do not come from ', 
     1           'identical populations.')
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
 5093   FORMAT('</OL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5095)
 5095   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
 8001   FORMAT('{',A1,'bf KRUSKAL-WALLIS TEST THAT THE ',I8,
     1         'GROUPS COME FROM IDENTICAL DISTRIBUTIONS}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8004   FORMAT(A1,'begin{center}')
 8005   FORMAT(A1,'end{center}')
 8006   FORMAT(A1,'end{verbatim}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
 8011   FORMAT(A1,'begin{enumerate}')
 8012   FORMAT(A1,'end{enumerate}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC,NUMDIS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8020   FORMAT(11X,A1,'newline')
 8021   FORMAT(5X,A1,'item Statistics:')
 8022   FORMAT(5X,A1,'item Percent Points of the Chi-Square ',
     1         'Reference Distribution:')
 8023   FORMAT(5X,A1,'item Conclusion (at the 5',A1,'% level):')
 8030   FORMAT(11X,A1,'begin{tabular} {lr}')
 8031   FORMAT(11X,'Number of Observations: & ',I8,2X,A1,A1)
 8032   FORMAT(11X,'Number of Groups: & ',I8,2X,A1,A1)
 8034   FORMAT(11X,'Kruskal-Wallis Test Statistic: & ',G15.7,
     1         2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8041   FORMAT(11X,G15.7,' Percent Point: & ',G15.7,2X,A1,A1)
 8042   FORMAT(11X,'The ',I8,' groups come from identical ',
     1         'populations.',2X,A1,A1)
 8043   FORMAT(11X,'The ',I8,' groups do not come from identical ',
     1         'populations.',2X,A1,A1)
 8044   FORMAT(11X,'0      Percent Point: & ',G15.7,2X,A1,A1)
 8045   FORMAT(11X,'50     Percent Point: & ',G15.7,2X,A1,A1)
 8046   FORMAT(11X,'90     Percent Point: & ',G15.7,2X,A1,A1)
 8047   FORMAT(11X,'95     Percent Point: & ',G15.7,2X,A1,A1)
 8048   FORMAT(11X,'99     Percent Point: & ',G15.7,2X,A1,A1)
 8049   FORMAT(11X,'99.5   Percent Point: & ',G15.7,2X,A1,A1)
C
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)NUMDIS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8022)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)CUT0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)CUT50,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)CUT90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8047)CUT95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8048)CUT99,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)CUT999,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)100.*STATCD,STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,8042)NUMDIS,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8043)NUMDIS,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8051   FORMAT(A1,'end{enumerate}')
 8052   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8051)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8052)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7211)
 7211   FORMAT('              KRUSKALL-WALLIS TEST FOR ONE-WAY ANOVA')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7222)
 7222   FORMAT('1. STATISTICS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7224)N
 7224   FORMAT(6X,'NUMBER OF OBSERVATIONS    = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7226)NUMDIS
 7226   FORMAT(6X,'NUMBER OF GROUPS          = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7228)STATVA
 7228   FORMAT(6X,'KRUSKALL-WALLIS TEST STATISTIC   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
 7240   FORMAT('2. PERCENT POINTS OF THE CHI-SQUARE REFERENCE ',
     1         'DISTRIBUTION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7241)
 7241   FORMAT('   FOR KRUSKALL-WALLIS TEST STATISTIC')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7345)CUT0
 7345   FORMAT(6X,'0          % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7346)CUT50
 7346   FORMAT(6X,'50         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7347)CUT75
 7347   FORMAT(6X,'75         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7348)CUT90
 7348   FORMAT(6X,'90         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7349)CUT95
 7349   FORMAT(6X,'95         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7350)CUT99
 7350   FORMAT(6X,'99         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7351)CUT999
 7351   FORMAT(6X,'99.9       % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7247)100.*STATCD,STATVA
 7247   FORMAT(6X,G15.7,'   % Point:  ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7261)
 7261   FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,7262)NUMDIS
 7262     FORMAT(6X,'THE ',I8,' SAMPLES COME FROM IDENTICAL ',
     1           'POPULATIONS.')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,7272)NUMDIS
 7272     FORMAT(6X,'THE ',I8,' SAMPLES DO NOT COME FROM IDENTICAL ',
     1           'POPULATIONS.')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
 7290   CONTINUE
      ENDIF
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7401)
 7401 FORMAT('PAIRWISE MULTIPLE COMPARISONS WRITTEN TO FILE ',
     1       'dpst1f.dat.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
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 DPKRU2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I)
 9017 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      WRITE(ICOUT,9025)N
 9025 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9026I=1,N
      WRITE(ICOUT,9027)I,TAG(I)
 9027 FORMAT('I,TAG(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9026 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
