      SUBROUTINE DPPROF(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PROFILE PLOT--
C              A MULTIVARIATE TECHNICQUE WHICH PLOTS A STANDARDIZED (0 TO 1)
C              VARIABLE VERSUS DUMMY VARIABLE NUMBER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/2
C     ORIGINAL VERSION--FEBRUARY  1988.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
CCCCC CHARACTER*4 IH
CCCCC CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
CCCCC CHARACTER*4 IHHOR
CCCCC CHARACTER*4 IHHOR2
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Z1(MAXOBV)
      DIMENSION Z2(MAXOBV)
      DIMENSION Z3(MAXOBV)
      DIMENSION YSUB(MAXOBV)
      DIMENSION YFULL(MAXOBV)
      DIMENSION XTEMP(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Z1(1))
      EQUIVALENCE (GARBAG(IGARB2),Z2(1))
      EQUIVALENCE (GARBAG(IGARB3),Z3(1))
      EQUIVALENCE (GARBAG(IGARB4),YSUB(1))
      EQUIVALENCE (GARBAG(IGARB5),YFULL(1))
      EQUIVALENCE (GARBAG(IGARB6),XTEMP(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPPR'
      ISUBN2='OF  '
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 PROFILE PLOT CASE  **
C               ***********************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PROF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPROF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG2,IBUGG3,IBUGQ,ISUBRO
   52 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='PROF'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO111
      GOTO119
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO119
C
  119 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               ***********************************************************
C               **  STEP 2--                                             **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 11--                          **
C               **  FOR A PROFILE PLOT,                **
C               **  WE MUST HAVE A SUBSET OR FOR       **
C               **  SO AS TO INDICATE EXACTLY WHICH    **
C               **  CAR, ETC. THE SINGLE PROFILE PLOT  **
C               **  WILL BE FORMED FOR.                **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1180
      DO1100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO1110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO1110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1120
 1100 CONTINUE
      GOTO1180
 1110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1190
 1120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1190
C
 1180 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('***** ERROR IN DPPROF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('      NUMARG LESS THAN 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)
 1184 FORMAT('      POSSIBLE CAUSE--AN OMITTED (BUT NEEDED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('      SUBSET/EXCEPT/FOR QUALIIFICATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)
 1186 FORMAT('      AT THE END OF THE PROFILE PLOT COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1187)
 1187 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1188)(IANS(I),I=1,IWIDTH)
 1188 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PROF')GOTO1195
      WRITE(ICOUT,1191)NUMARG,ILOCQ,ICASEQ
 1191 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1195 CONTINUE
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.GE.1)GOTO1290
C
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPPROF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      TO BE INCLUDED AS COMPONENTS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      IN A PROFILE PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1218)(IANS(I),I=1,IWIDTH)
 1218 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      RETURN
C
 1290 CONTINUE
C
C               ***************************************
C               **  STEP 13--                        **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               **  ALSO CHECK TO ASSURE THAT EACH   **
C               **  OF THE VARIABLES HAS AT LEAST    **
C               **  2 OBSERVATIONS.                  **
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1300I=1,NUMVAR
C
      IHRIGH=IHARG(I)
      IHRIG2=IHARG2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      NRIGHT=IN(ILOCV)
      IF(NRIGHT.GE.MINN2)GOTO1390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPPROF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('      (FOR WHICH A PROFILE PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)MINN2
 1326 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1327)
 1327 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1328)
 1328 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1329)(IANS(J),J=1,IWIDTH)
 1329 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1390 CONTINUE
C
 1300 CONTINUE
C
C               *************************************************
C               **  STEP 21--                                  **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FOR  EACH OF THE RESPONSE VARIABLES   **
C               **  EXTRACT THE DATA SUBSET                    **
C               **  (USUALLY ONLY 1 OBSERVATION)               **
C               **  AND ALSO EXTRACT THE                       **
C               **  MIN AND MAX FOR THE FULL VARIABLE          **
C               *************************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2110
      IF(ICASEQ.EQ.'SUBS')GOTO2120
      IF(ICASEQ.EQ.'FOR')GOTO2130
C
 2110 CONTINUE
      DO2115I=1,NRIGHT
      ISUB(I)=1
 2115 CONTINUE
      NQ=NRIGHT
      GOTO2190
C
 2120 CONTINUE
      NIOLD=NRIGHT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2190
C
 2130 CONTINUE
      NIOLD=NRIGHT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2190
C
 2190 CONTINUE
C
C               *************************************************
C               **  STEP 22--                                  **
C               **  FOR EACH OF THE RESPONSE VARIABLES,        **
C               **  EXTRACT THE DATA SUBSET                    **
C               **  (FREQUENTLY ONLY 1 OBSERVATION)            **
C               **  AND ALSO EXTRACT THE                       **
C               **  MIN AND MAX FOR THE FULL VARIABLE          **
C               *************************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2200K=1,NUMVAR
      IHRIGH=IHARG(K)
      IHRIG2=IHARG2(K)
C
      DO2210I=1,NUMNAM
      I2=I
      IF(IHRIGH.EQ.IHNAME(I).AND.IHRIG2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO2219
 2210 CONTINUE
      WRITE(ICOUT,2211)
 2211 FORMAT('***** INTERNAL ERROR IN DPPROF AT POINT 2210--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE VARIABLE ',I4,I4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      NOT NOW FOUND IN INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      ALTHOUGH ALREADY FOUND EARLIER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2216)(IANS(I),I=1,IWIDTH)
 2216 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2219 CONTINUE
C
      ILISTR=I2
      ICOLR=IVALUE(ILISTR)
      NRIGHT=IN(ILISTR)
C
      J=0
      IMAX=NRIGHT
      IF(NQ.LT.NRIGHT)IMAX=NQ
      DO2240I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO2240
      J=J+1
      IJ=MAXN*(ICOLR-1)+I
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1WRITE(ICOUT,2241)I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX
 2241 FORMAT('I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX = ',8I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1CALL DPWRST('XXX','BUG ')
      IF(ICOLR.LE.MAXCOL)YSUB(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)YSUB(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)YSUB(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)YSUB(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)YSUB(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)YSUB(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)YSUB(J)=TAGPLO(I)
 2240 CONTINUE
      NLOCAL=J
      NSUB=NLOCAL
C
      J=0
      IMAX=NRIGHT
      DO2250I=1,IMAX
      J=J+1
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)YFULL(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)YFULL(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)YFULL(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)YFULL(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)YFULL(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)YFULL(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)YFULL(J)=TAGPLO(I)
 2250 CONTINUE
      NFULL=J
C
      IWRITE='OFF'
      CALL MEDIAN(YSUB,NSUB,IWRITE,XTEMP,MAXN,XMED,IBUGG3,IERROR)
      CALL MINIM(YFULL,NFULL,IWRITE,XMIN,IBUGG3,IERROR)
      CALL MAXIM(YFULL,NFULL,IWRITE,XMAX,IBUGG3,IERROR)
      Z1(K)=XMED
      Z2(K)=XMIN
      Z3(K)=XMAX
C
 2200 CONTINUE
      NZ=NUMVAR
C
C               *************************************************************
C               **  STEP 31--                                              **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                  **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.                     **
C               **  DEFINE THE VECTOR D(.) TO 1'S, 2'S, AND 3'S            **
C               **  FOR THE PLOTTED VALUE, THE LOWER CONFIDENCE LINE,      **
C               **  AND THE UPPER CONFIDENCE LINE.                         **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PROF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPPRO2(Z1,Z2,Z3,NZ,ICASPL,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PROF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPROF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG2,IBUGG3,IBUGQ,ISUBRO
 9012 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NSUB
 9021 FORMAT('NSUB = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NSUB.LE.0)GOTO9024
      DO9022I=1,NSUB
      WRITE(ICOUT,9023)I,YSUB(I)
 9023 FORMAT('I,YSUB(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9024 CONTINUE
      WRITE(ICOUT,9031)NFULL
 9031 FORMAT('NFULL = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NFULL.LE.0)GOTO9034
      DO9032I=1,NFULL
      WRITE(ICOUT,9033)I,YFULL(I)
 9033 FORMAT('I,YFULL(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9034 CONTINUE
      WRITE(ICOUT,9041)NZ
 9041 FORMAT('NZ = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO9044
      DO9042I=1,NZ
      WRITE(ICOUT,9043)I,Z1(I),Z2(I),Z3(I)
 9043 FORMAT('I,Z1(I),Z2(I),Z3(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
 9044 CONTINUE
      WRITE(ICOUT,9051)NPLOTP
 9051 FORMAT('NPLOTP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9054
      DO9052I=1,NPLOTP
      WRITE(ICOUT,9053)I,Y(I),X(I),D(I)
 9053 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9052 CONTINUE
 9054 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPROJ(ICOM,IHARG,NUMARG,I3DPRO,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 3-D PROJECTION SWITCH I3DPRO.
C              THE 2 SETTINGS ARE
C                 1) ORTHOGRAPHIC (THE DEFAULT)
C                 2) PERSPECTIVE
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--I3DPRO   ('ORTH'  OR 'PERS')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DI3DPROION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 I3DPRO
      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(ICOM.EQ.'ORTH')GOTO1110
      IF(ICOM.EQ.'PERS')GOTO1120
      IF(ICOM.EQ.'PROJ')GOTO1130
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(1).EQ.'ON')GOTO1150
      IF(IHARG(1).EQ.'OFF')GOTO1160
      GOTO1199
C
 1120 CONTINUE
      IF(NUMARG.LE.0)GOTO1160
      IF(IHARG(1).EQ.'ON')GOTO1160
      IF(IHARG(1).EQ.'OFF')GOTO1150
      GOTO1199
C
 1130 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(1).EQ.'ON')GOTO1150
      IF(IHARG(1).EQ.'OFF')GOTO1160
      IF(IHARG(1).EQ.'AUTO')GOTO1150
      IF(IHARG(1).EQ.'DEFA')GOTO1150
      IF(IHARG(1).EQ.'ORTH')GOTO1150
      IF(IHARG(1).EQ.'PERS')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      I3DPRO='ORTH'
      GOTO1180
C
 1160 CONTINUE
      I3DPRO='PERS'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE PROJECTION SWITCH (AFFECTING 3-D PLOTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)I3DPRO
 1182 FORMAT('           HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPROM(IHARG,NUMARG,IPROSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PROMPT SWITCH IPROSW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IPROSW  ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--DECEMBER  1985.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IPROSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1150
      IF(NUMARG.GE.1)GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1199
C
 1150 CONTINUE
      IPROSW='ON'
      GOTO1180
C
 1160 CONTINUE
      IPROSW='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IPROSW
 1181 FORMAT('THE PROMPT SWITCH HAS JUST BEEN TURNED ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPRO2(Z1,Z2,Z3,NZ,ICASPL,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A PROFILE PLOT
C              (USEFUL FOR MULTIVARIATE ANALYSIS).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/2
C     ORIGINAL VERSION--JANUARY   1988.
C     UPDATED         --APRIL     1992.  DELETE K
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Z1(*)
      DIMENSION Z2(*)
      DIMENSION Z3(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPPR'
      ISUBN2='O2  '
C
      IERROR='NO'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NZ.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPPRO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)NZ
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PRO2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPPRO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,NZ,N2,NPLOTV
   72 FORMAT('ICASPL,NZ,N2,NPLOTV = ',A4,2X,3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO83
      DO81I=1,NZ
      WRITE(ICOUT,82)I,Z1(I),Z2(I),Z3(I)
   82 FORMAT('I,Z1(I),Z2(I),Z3(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
   83 CONTINUE
   90 CONTINUE
C
C               ****************************************
C               **  STEP 11--                         **
C               **  DETERMINE PLOT COORDINATES        **
C               ****************************************
C
      J=0
      DO1100I=1,NZ
      ANUM=Z1(I)-Z2(I)
      ADEN=Z3(I)-Z2(I)
      P=0.0
      IF(ADEN.GT.0.0)P=ANUM/ADEN
      J=J+1
      Y2(J)=P
      X2(J)=J
      D2(J)=1.0
 1100 CONTINUE
      N2=J
      NPLOTV=2
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PRO2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPRO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,NZ,N2,IERROR
 9012 FORMAT('ICASPL,NZ,N2,IERROR = ',A4,2I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED  APRIL 1992
CCCCC WRITE(ICOUT,9013)NZ,J,K
C9013 FORMAT('NZ,J,K = ',3I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NZ,J
 9013 FORMAT('NZ,J = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO9023
      DO9021I=1,NZ
      WRITE(ICOUT,9022)I,Z1(I),Z2(I),Z3(I)
 9022 FORMAT('I,Z1(I),Z2(I),Z3(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9023 CONTINUE
      WRITE(ICOUT,9031)N2,NPLOTV
 9031 FORMAT('N2,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,N2
      WRITE(ICOUT,9036)I,Y2(I),X2(I),D2(I)
 9036 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPRPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1CLLIMI,CLWIDT,
     1ICONT,NUMHPP,NUMVPP,IMANUF,
     1XMATN,YMATN,XMITN,YMITN,
     1ISQUAR,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ALOWFR,ALOWDG,
     1IFORSW,
     1ANOPL1,ANOPL2,ISEED,IBOOSS,BARHEF,BARWEF,
     1ICAPSW,
     1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IFOUND,IERROR)
C
C     PURPOSE--GENERATE EITHER
C              1) A PARTIAL REGRESSION PLOT
C              2) A PARTIAL LEVERAGE PLOT
C              3) A PARTIAL RESIDUAL PLOT
C              4) A CCPR PLOT
C              FOR EXAMPLE, THE COMMAND
C                 PARTIAL REGRESSION PLOT Y X1 TO XK
C              WILL GENERATE PARTIAL REGRESSION PLOTS OF Y VS X1,
C              Y VS X2, ETC. AS A MULTIPLOT ON A SINGLE PAGE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002/6
C     ORIGINAL VERSION--JUNE      2002.
C     UPDATED         --FEBRUARY  2005. CALL LIST TO MAINAN
C     UPDATED         --MARCH     2006. CALL LIST TO MAINGR
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES---------------
C
      INCLUDE 'DPCOPA.INC'
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICASP2
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICASAN
      CHARACTER*4 ICASEQ
      CHARACTER*4 ICONT
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IFORSW
      CHARACTER*4 IFTEXP
      CHARACTER*4 IFTORD
      CHARACTER*4 ICPSWZ
C
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGUG
      CHARACTER*4 IBUGU2
      CHARACTER*4 IBUGU3
      CHARACTER*4 IBUGU4
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IEMPTY
      CHARACTER*4 IERAS2
      CHARACTER*4 IFENC2
      CHARACTER*4 IPPTB2
      CHARACTER*4 ISORS2
      CHARACTER*4 ISQUAR
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
      CHARACTER*4 IREPCH
      CHARACTER*4 IMPSW
      CHARACTER*4 IMPSW3
      CHARACTER*4 IFPLFZ
      CHARACTER*4 IFPLTZ
      CHARACTER*4 IFPLPZ
      CHARACTER*4 IFPLLZ
      CHARACTER*4 IFPLL2
      CHARACTER*4 IFPLXZ
      CHARACTER*4 IFPLYZ
      CHARACTER*4 IFPLDZ
      CHARACTER*4 IFPLZT
      CHARACTER*4 IFPLZ2
      CHARACTER*4 IFPLZ3
      CHARACTER*4 IFPLZ4
C
      CHARACTER*4 IFEED9
C
      CHARACTER*4 IMANUF
C
      CHARACTER*4 ICHAP2(100)
      CHARACTER*4 ILINP2(100)
      CHARACTER*4 ISPIS2(100)
      CHARACTER*4 IBARS2(100)
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
      CHARACTER*4 IX1ZSV
      CHARACTER*4 IX2ZSV
      CHARACTER*4 IY1ZSV
      CHARACTER*4 IY2ZSV
      CHARACTER*4 IY1MNS
      CHARACTER*4 IY1MXS
      CHARACTER*4 IY1LJ2
      CHARACTER*4 IY1LD2
      CHARACTER*4 IY2MNS
      CHARACTER*4 IY2MXS
      CHARACTER*4 IX1MNS
      CHARACTER*4 IX1MXS
      CHARACTER*4 IX2MNS
      CHARACTER*4 IX2MXS
      CHARACTER*4 IX1FSV
      CHARACTER*4 IX2FSV
      CHARACTER*4 IY1FSV
      CHARACTER*4 IY2FSV
      CHARACTER*4 ILFLAX
      CHARACTER*4 ILFLAY
      CHARACTER*4 IFPLLD
      CHARACTER*4 IFPLDI
      CHARACTER*4 IX1LT2(MAXCH)
      CHARACTER*4 IX2LT2(MAXCH)
      CHARACTER*4 IY1LT2(MAXCH)
      CHARACTER*4 IY2LT2(MAXCH)
      CHARACTER*4 ITITSV(MAXCH)
      CHARACTER*4 IPLOTT
CCCCC CHARACTER*4 ISUBSZ
C
      CHARACTER*80 IFILE5
      CHARACTER*12 ISTAT5
      CHARACTER*12 IFORM5
      CHARACTER*12 IACCE5
      CHARACTER*12 IPROT5
      CHARACTER*12 ICURS5
      CHARACTER*4 IERRF5
      CHARACTER*4 IENDF5
      CHARACTER*4 IREWI5
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*4 ICT
      CHARACTER*4 IC2T
      CHARACTER*4 IHT(5)
      CHARACTER*4 IH2T(5)
      CHARACTER*4 ISU2SW(MAXSUB)
C
C  MAXY IS THE MAXIMUM NUMBER OF VARIABLES TO USE IN CREATING THE
C  PARTIAL REGRESSION PLOT   CURVE
C
      PARAMETER(MAXY=50)
C
      DIMENSION IVARN1(MAXY)
      DIMENSION IVARN2(MAXY)
      DIMENSION ILIS(MAXY)
      DIMENSION ICOLL(MAXY)
C
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
CCCCC CHARACTER*4 IWRITE
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON------------------------------------------------------
C
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)----------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-------------------------------------------------
C
      IFOUND='YES'
      IERROR='NO'
C
      ISUBN1='DPPR'
      ISUBN2='PL  '
C
      IF(ICASPL.NE.'CCPR')ICASPL='PRPL'
      IFPLLD='ON'
      IFPLDI='LINE'
      IBOOSS=100
C
      IFLAGV=5
C
C               ***********************************************
C               **  TREAT THE PARTIAL REGRESSION PLOT   CASE **
C               ***********************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PRPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO69
      DO61I=1,NUMARG
      WRITE(ICOUT,62)I,IHARG(I),IARGT(I)
   62 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   69 CONTINUE
      WRITE(ICOUT,71)IFPLLA
   71 FORMAT('IFPLLA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IFPLTA
   72 FORMAT('IFPLTA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IFPLPT
   73 FORMAT('IFPLPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IFPLFI
   74 FORMAT('IFPLFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)IFPLFR
   75 FORMAT('IFPLFR = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  SHIFT COMMAND LINE ARGMENTS                     **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'REGR'.AND.IHARG(2).EQ.'PLOT')THEN
        ICASPL='PREG'
        ISHIFT=2
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C  SYNONYM: ADDED VARIABLE PLOT
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'PLOT')THEN
        ICASPL='PREG'
        ISHIFT=2
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LEVE'.AND.IHARG(2).EQ.'PLOT')THEN
        ICASPL='PLEV'
        ISHIFT=2
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'RESI'.AND.IHARG(2).EQ.'PLOT')THEN
        ICASPL='PRES'
        ISHIFT=2
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(ICASPL.EQ.'CCPR'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')THEN
        ISHIFT=1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C  SYNONYM: COMPONENT PLUS RESIDUAL PLOT
C
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'PLUS'.AND.IHARG(2).EQ.'RESI'.AND.
     1   IHARG(3).EQ.'PLOT')THEN
        ICASPL='PRES'
        ISHIFT=3
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      ICOM='FIT '
      ICOM2='    '
      IFOUND='YES'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINN2=2
      MINNA=3
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 11--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1180
      DO1100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO1110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO1110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1120
 1100 CONTINUE
      GOTO1180
 1110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1190
 1120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1190
C
 1180 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PRPL')GOTO1195
      WRITE(ICOUT,1191)NUMARG,ILOCQ,ICASEQ
 1191 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1195 CONTINUE
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **  IF THE   TO   FEATURE IS USED IN THE        **
C               **  ARGUMENT LIST, TRANSLATE THE   TO   TO      **
C               **  EXPLICIT VARIABLE NAMES                     **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=ILOCQ-1
      CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXY,
     1IHNAME,IHNAM2,IUSE,NUMNAM,
     1IVARN1,IVARN2,NUMVAR,IBUGG2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
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.'PRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFLAG=0
      IFLAG2=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
      NTEMP=IN(ILOCV)
      IF(I.EQ.1)THEN
        NRIGHT=NTEMP
      ELSE
        NRIGH2=NTEMP
        IF(NTEMP.NE.NRIGHT)IFLAG=1
      ENDIF
      ILIS(I)=ILOCV
C
      IF(NTEMP.GT.MINN2)GOTO1390
C
 1309 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPPRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('      PARTIAL REGRESSION 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,1327)I,NTEMP
 1327 FORMAT('      VARIABLE ',I8,' HAS ',I8,' OBSERVATIONS.')
      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.'PRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 1410 CONTINUE
      IF(IFLAG.EQ.1)THEN
        WRITE(ICOUT,1411)
 1411   FORMAT('***** ERROR IN DPPRPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1413)
 1413   FORMAT('      THE NUMBER OF OBSERVATIONS FOR EACH OF THE',
     1        'VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1414)
        CALL DPWRST('XXX','BUG ')
 1414   FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
        DO1417I=1,NUMVAR
          I2=ILIS(I)
          WRITE(ICOUT,1416)IVARN1(I),IVARN2(I),IN(I2)
 1416     FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1           ' OBSERVATIONS;')
         CALL DPWRST('XXX','BUG ')
 1417   CONTINUE
        WRITE(ICOUT,1420)
 1420   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1421)(IANS(I),I=1,MIN(IWIDTH,100))
 1421     FORMAT('      ',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               **************************************************
C               **   STEP 0.5--                                 **
C               **   PERFORM MULTILINEAR FIT                    **
C               **************************************************
C
      ISTEPN='0.5'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICPSWZ='OFF'
      CALL MAINAN(ICASAN,ISEED,ANOPL1,ANOPL2,
     1TEMP,TEMP2,XTEMP1,XTEMP2,MAXNXT,
     1IFTEXP,IFTORD,
     1ALOWFR,ALOWDG,
     1IBOOSS,
     1ICPSWZ,
     1IFORSW,
     1IBUGG2,IBUGG2,IBUGG3,
     1IBUGCO,IBUGEV,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C               **************************************************
C               **   STEP 1--                                   **
C               **   SAVE INITIAL SETTINGS                      **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      PXMN2=PXMIN
      PXMX2=PXMAX
      PYMN2=PYMIN
      PYMX2=PYMAX
      PWXMN2=PWXMIN
      PWXMX2=PWXMAX
      PWYMN2=PWYMIN
      PWYMX2=PWYMAX
      IF(IFPLFR.EQ.'DEFA')THEN
        PXMIN=0.0
        PXMAX=100.0
        PYMIN=0.0
        PYMAX=100.0
      ENDIF
C
      IERAS2=IERASW
      IFENC2=IFENSW
      IPPTB2=IPPTBI
      ISORS2=ISORSW
C
      ILFLAX='OFF'
      ILFLAY='OFF'
      IF(IY1MIN.EQ.'FIXE'.AND.IY1MAX.EQ.'FIXE')THEN
        ILFLAY='ON'
      ENDIF
      IF(IX1MIN.EQ.'FIXE'.AND.IX2MAX.EQ.'FIXE')THEN
        ILFLAX='ON'
      ENDIF
C
      IX1TSV=IX1TSW
      IX2TSV=IX2TSW
      IY1TSV=IY1TSW
      IY2TSV=IY2TSW
      IX1ZSV=IX1ZSW
      IX2ZSV=IX2ZSW
      IY1ZSV=IY1ZSW
      IY2ZSV=IY2ZSW
      PX1LD2=PX1LDS
      PX2LD2=PX2LDS
      PY1LD2=PY1LDS
      PY1LA2=PY1LAN
      IY1LJ2=IY1LJU
      IY1LD2=IY1LDI
      GY1MNS=GY1MIN
      GY1MXS=GY1MAX
      GY2MNS=GY2MIN
      GY2MXS=GY2MAX
      GX1MNS=GX1MIN
      GX1MXS=GX1MAX
      GX2MNS=GX2MIN
      GX2MXS=GX2MAX
      IY1MNS=IY1MIN
      IY1MXS=IY1MAX
      IY2MNS=IY2MIN
      IY2MXS=IY2MAX
      IX1MNS=IX1MIN
      IX1MXS=IX1MAX
      IX2MNS=IX2MIN
      IX2MXS=IX2MAX
      IX1FSV=IX1FSW
      IX2FSV=IX2FSW
      IY1FSV=IY1FSW
      IY2FSV=IY2FSW
      PX1ZD2=PX1ZDS
      PX2ZD2=PX2ZDS
      PY1ZD2=PY1ZDS
      PY2ZD2=PY2ZDS
      DO1495I=1,100
        ICHAP2(I)=ICHAPA(I)
        ILINP2(I)=ILINPA(I)
        ISPIS2(I)=ISPISW(I)
        IBARS2(I)=ISPISW(I)
 1495 CONTINUE
C
      DO1500I=1,MAXCH
        IX1LT2(I)=IX1LTE(I)
        IX2LT2(I)=IX2LTE(I)
        IY1LT2(I)=IY1LTE(I)
        IY2LT2(I)=IY2LTE(I)
 1500 CONTINUE
      NCX1L2=NCX1LA
      NCX2L2=NCX2LA
      NCY1L2=NCY1LA
      NCY2L2=NCY2LA
C
      IFPLL2=IFPLLA
      IFPLTZ=IFPLTA
      IFPLFZ=IFPLFR
      IFPLPZ=IFPLPT
      IFPLLZ=IFPLLD
      IFPLZT=IFPLST
      IFPLZ2=IFPLS2
      IFPLZ3=IFPLS3
      IFPLZ4=IFPLS4
      IFPLXZ=IFPLXA
      IFPLYZ=IFPLYA
      IFPLDZ=IFPLDI
      IF(IFPLFR.EQ.'USER'.AND.IFPLLA.EQ.'BOX')IFPLLA='ON'
      IF(IFPLFR.EQ.'CONN')IFPLFR='DEFA'
      IF(IFPLLA.EQ.'BOX ')THEN
        IFPLLD='ON'
        IF(IFPLDI.EQ.'BLAN')IFPLDI='LINE'
      ENDIF
C
      IFEED9=IFEEDB
C
      DO110I=1,MAXCH
        ITITSV(I)=ITITTE(I)
  110 CONTINUE
      NCTITS=NCTITL
      PTITDZ=PTITDS
C
      DO1530I=1,NUMVAR
      IHRIGH=IVARN1(I)
      IHRIG2=IVARN2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      ICOLL(I)=IVALUE(ILOCV)
 1530 CONTINUE
C
      IOUNI5=IST5NU
      IFILE5=IST5NA
      ISTAT5=IST5ST
      IFORM5=IST5FO
      IACCE5=IST5AC
      IPROT5=IST5PR
      ICURS5=IST5CS
      ISUBN0='SPMA'
      IERRF5='NO'
C
      IREWI5='ON'
      CALL DPOPFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IREWI5,ISUBN0,IERRF5,IBUGG3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')IOUNI5=0
C
      IMPSW3=IMPSW
      IMPCO2=IMPCO
      IMPNR2=IMPNR
      IMPNC2=IMPNC
      IMPSW='ON'
      IMPCO=1
C
      NPLOTS=NUMVAR-1
C
      IF(IMPNR*IMPNC.LT.NPLOTS)THEN
        IMPNC=INT(SQRT(REAL(NPLOTS-1)))+1
        IMPNR=1
        IF(NPLOTS.GE.11)THEN
          IMPNR=INT(NPLOTS/IMPNC)+1
        ELSEIF(NPLOTS.GE.7)THEN
          IMPNR=3
        ELSEIF(NPLOTS.GE.3)THEN
          IMPNR=2
        ENDIF
      ENDIF
C
      IROWT=IMPNR
      ICOLT=IMPNC
      IF(IFPLLA.EQ.'BOX')THEN
        IMPNR=IMPNR+1
        IMPNC=IMPNC+1
        IROWT=IROWT+1
        ICOLT=ICOLT+1
      ENDIF
C
C               *************************************
C               **   STEP 21--                     **
C               **   GENERATE THE PLOTS            **
C               *************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'DPPRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'PREG')THEN
        ICT='PART'
        IC2T='IAL '
        NCCOMM=2
        IHT(1)='REGR'
        IH2T(1)='ESSI'
        IHT(2)='PLOT'
        IH2T(2)='    '
        IPLOTT='PREG'
      ELSEIF(ICASPL.EQ.'PLEV')THEN
        ICT='PART'
        IC2T='IAL '
        NCCOMM=2
        IHT(1)='LEVE'
        IH2T(1)='RAGE'
        IHT(2)='PLOT'
        IH2T(2)='    '
        IPLOTT='PLEV'
      ELSEIF(ICASPL.EQ.'PRES')THEN
        ICT='PART'
        IC2T='IAL '
        NCCOMM=2
        IHT(1)='RESI'
        IH2T(1)='DUAL'
        IHT(2)='PLOT'
        IH2T(2)='    '
        IPLOTT='PRES'
      ELSEIF(ICASPL.EQ.'CCPR')THEN
        ICT='CCPR'
        IC2T='    '
        NCCOMM=1
        IHT(1)='PLOT'
        IH2T(1)='    '
        IPLOTT='CCPR'
      ELSE
        ICT='PART'
        IC2T='IAL '
        NCCOMM=2
        IHT(1)='REGR'
        IH2T(1)='ESSI'
        IPLOTT='PREG'
      ENDIF
      GOTO5299
C
C               **************************************************
C               **   GENERATE ONE OF THE FOLLOWING COMMANDS     **
C               **      PARTIAL REGRESSION PLOT Y X1 X2 .... XI **
C               **      PARTIAL RESIDUAL   PLOT Y X1 X2 .... XI **
C               **      PARTIAL LEVERAGE   PLOT Y X1 X2 .... XI **
C               **   WHERE XI IS THE SPECIFIC VARIABLE THE      **
C               **   PLOT IS BEING GENERATED FOR.               **
C               **************************************************
 5299 CONTINUE
C
      IF(NPLOTS.LT.1)GOTO8000
C
      ISHIFT=NCCOMM
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ICOM=ICT
      ICOM2=IC2T
      IF(NCCOMM.GT.0)THEN
        DO5301II=1,NCCOMM
          IHARG(II)=IHT(II)
          IHARG2(II)=IH2T(II)
          IARG(II)=0
          ARG(II)=0.0
          IARGT(II)='WORD'
 5301   CONTINUE
      ENDIF
      IFRST=NCCOMM+2
      NUMARG=NUMARG+1
      IHARG(NUMARG)='    '
      IHARG2(NUMARG)='    '
      IARG(NUMARG)=0
      ARG(NUMARG)=0.0
      IARGT(NUMARG)=IARGT(IFRST)
      NARGT=NUMARG
C
      IPLOT=0
      IF(IFPLLA.EQ.'BOX')THEN
        NPLOTS=NPLOTS+IMPNR+IMPNC-1
      ENDIF
      DO5300IRES=1,IROWT
        DO5400IFAC=1,ICOLT
C
          IPLOT=IPLOT+1
          IF(IPLOT.GT.NPLOTS)GOTO8000
          IHARG(NUMARG)=IHARG(IFRST+IPLOT-1)
          IHARG2(NUMARG)=IHARG2(IFRST+IPLOT-1)
          IARG(NUMARG)=IARG(IFRST+IPLOT-1)
          ARG(NUMARG)=ARG(IFRST+IPLOT-1)
          IARGT(NUMARG)=IARGT(IFRST+IPLOT-1)
C
          IXLIST=IFAC
          IROW=INT(IPLOT/IMPNC)+1
          IF(MOD(IPLOT,IMPNC).EQ.0)IROW=IROW-1
          ICOL=MOD(IPLOT,IMPNC)
          IF(ICOL.EQ.0)ICOL=IMPNC
C
          IEMPTY='NO'
          ITEMP=IFAC
          IF(IFPLLA.EQ.'BOX')THEN
            ICOL=ICOL-1
            ITEMP=IFAC-1
            IF(ITEMP.EQ.0)IEMPTY='YES'
            IF(IROW.EQ.IMPNR)IEMPTY='YES'
          ENDIF
C
          IF(IEMPTY.EQ.'YES')THEN
            DO5304I=1,MAXSUB
              ISU2SW(I)=ISUBSW(I)
              ISUBSW(I)='OFF'
 5304       CONTINUE
          ENDIF
          IOPTN=3
          IDX=1
          IDY=1
          ICASP2='FACT'
C
CCCCC NOTE: DPSPM4 IMPLEMENTS "SUB-REGIONS" ON PLOTS.  THESE DON'T
CCCCC       SEEM PARTICULARLY RELEVANT FOR THESE PLOTS, SO COMMENT
CCCCC       OUT FOR NOW.  HOWEVER, LEAVE IN CASE WE DECIDE LATER TO
CCCCC       IMPLEMENT THEM.
C
CCCCC     CALL DPSPM4(ICASP2,IOPTN,IDX,IDY,
CCCCC1                ISUBNU,ISUBSW,
CCCCC1                ASUBXL,ASUBXU,ASUBYL,ASUBYU,
CCCCC1                ISUBN9,ISUBSZ,
CCCCC1                ASBXL2,ASBXU2,ASBYL2,ASBYU2,
CCCCC1                PFPXSL,PFPXSU,PFPYSL,PFPYSU,
CCCCC1                IBUGG2,ISUBRO,IERROR)
C
          ICASP2=ICASPL
          IRES2=IRES
          IXLST2=IXLIST+1
          IX=IFAC+1
          CALL DPSPM1(ICASP2,IVARN1,IVARN2,ICOLL,
     1                IMPNR,IMPNC,IROW,ICOL,IRES2,IX,IPLOT,
     1                NPLOTS,NUMVAR,
     1                ICHAP2,ILINP2,
     1                GY1MNS,GY1MXS,GY2MNS,GY2MXS,
     1                GX1MNS,GX1MXS,GX2MNS,GX2MXS,
     1                IY1MNS,IY1MXS,IY2MNS,IY2MXS,
     1                IX1MNS,IX1MXS,IX2MNS,IX2MXS,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                PX1LD2,PX2LD2,
     1                IY1LJ2,IY1LD2,PY1LD2,PY1LA2,
     1                IX1LT2,IX2LT2,IY1LT2,IY2LT2,
     1                NCX1L2,NCX2L2,NCY1L2,NCY2L2,
     1                PFPXLL,PFPXUL,PFPYLL,PFPYUL,IXLST2,
     1                IFPLLA,IFPLLD,IPLOTT,IFPLFR,IFPLXA,IFPLYA,
     1                IFPLDI,
     1                IFPLTD,PFPLTD,IVNMEX,
     1                IBUGG2,ISUBRO)
C
          IF(IEMPTY.EQ.'YES')THEN
            DO5306I=1,100
              ICHAPA(I)='BLAN'
              ILINPA(I)='BLAN'
              ISPISW(I)='OFF'
              IBARSW(I)='OFF'
 5306       CONTINUE
          ENDIF
C
          CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1                MAXNPP,ISEED,IBOOSS,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                BARHEF,BARWEF,
     1                IRHSTG,IHSTCW,
     1                ICAPSW,IFORSW,
     1                IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1                TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                ISUBRO,IFOUND,IERROR)
C
CCCCC NOTE: DPSPM3 SETS AN X2LABEL BASED ON CORRELATION, EFFECT
CCCCC       SIZE, OR NUMBER OF REJECTIONS.  THIS DOESN"T SEEM
CCCCC       PARTICULARLY USEFUL FOR THESE PLOTS, SO COMMENT OUT
CCCCC       FOR NOW.  HOWEVER, LEAVE CODE HERE IN CASE WE DECIDE TO
CCCCC       ACTIVATE LATER.
C
CCCCC     IF(IEMPTY.EQ.'NO')THEN
CCCCC       CALL DPSPM3(ICASPL,IOUNI5,
CCCCC1                  IROW,ICOL,
CCCCC1                  PX2LD2,NPLOTP,
CCCCC1                  IFORSW,
CCCCC1                  IFPX2L,ISPX2P,ISPX2S,
CCCCC1                  IHRIGH,IHRIG2,IHWUSE,
CCCCC1                  ISUBN1,ISUBN2,MESSAG,
CCCCC1                  IBUGG2,ISUBRO,IERROR)
CCCCC     ENDIF
C
          ICONT=IDCONT(1)
          NUMHPP=IDNHPP(1)
          IMPARG=2
          CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1                XMATN,YMATN,XMITN,YMITN,
     1                ISQUAR,
     1                IVGMSW,IHGMSW,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1                IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1                YPLOT,XPLOT,X2PLOT,TAGPLO,
     1                IMPSW,IMPNR,IMPNC,IMPCO,
     1                IMPARG,
     1                PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                MAXCOL,
     1                DSIZE,DSYMB,DCOLOR,DFILL,
     1                ICAPSW,
     1                IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1                IERROR)
          IF(IERROR.EQ.'NO')IAND1=IAND2
          IF(IERROR.EQ.'YES')GOTO5499
C
          IF(IFPLFI.EQ.'NONE')GOTO5499
          IF(IEMPTY.EQ.'YES')GOTO5499
C
          IMPCO=IMPCO-1
          IF(IMPCO.LE.1)IERASW='OFF'
C
          CALL DPSPM2(ICASPL,IVARN1,IVARN2,ICOLL,NUMVAR,NPLOTP,
     1                IRES,IX,ICHAP2,ILINP2,
     1                TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                ALOWFR,ALOWDG,
     1                IANGLU,MAXNPP,IAND1,IAND2,
     1                IFPLFI,IFPLTA,
     1                XMATN,YMATN,XMITN,YMITN,
     1                ISQUAR,
     1                IVGMSW,IHGMSW,
     1                IMPSW,IMPNR,IMPNC,IMPCO,
     1                IREPCH,
     1                PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1                IBUGUG,IBUGU2,IBUGU3,IBUGU4,
     1                ISUBRO,IFOUND,IERROR)
          IF(IERROR.EQ.'YES')GOTO5499

 5499     CONTINUE
          IERROR='NO'
C
          ISHIFT=NCCOMM
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
          ICOM=ICT
          ICOM2=IC2T
          IF(NCCOMM.GT.0)THEN
            DO5491II=1,NCCOMM
              IHARG(II)=IHT(II)
              IHARG2(II)=IH2T(II)
              IARG(II)=0
              ARG(II)=0.0
              IARGT(II)='WORD'
 5491       CONTINUE
          ENDIF
          IFRST=NCCOMM+2
          IHARG(NUMARG)='    '
          IHARG2(NUMARG)='    '
          IARG(NUMARG)=0
          ARG(NUMARG)=0.0
          IARGT(NUMARG)=IARGT(IFRST)
          NARGT=NUMARG
C
 5490   CONTINUE
        PX1LDS=PX1LD2
        GX1MIN=GX1MNS
        GX1MAX=GX1MXS
        GX2MIN=GX2MNS
        GX2MAX=GX2MXS
        GY1MIN=GY1MNS
        GY1MAX=GY1MXS
        GY2MIN=GY2MNS
        GY2MAX=GY2MXS
        IX1MIN=IX1MNS
        IX1MAX=IX1MXS
        IX2MIN=IX2MNS
        IX2MAX=IX2MXS
        IY1MIN=IY1MNS
        IY1MAX=IY1MXS
        IY2MIN=IY2MNS
        IY2MAX=IY2MXS
        PX1ZDS=PX1ZD2
        PX2ZDS=PX2ZD2
        PY1ZDS=PY1ZD2
        PY2ZDS=PY2ZD2
        IF(IEMPTY.EQ.'YES')THEN
          DO5407I=1,MAXSUB
            ISUBSW(I)=ISU2SW(I)
 5407     CONTINUE
        ENDIF
        DO5408I=1,100
            ICHAPA(I)=ICHAP2(I)
            ILINPA(I)=ILINP2(I)
            ISPISW(I)=ISPIS2(I)
            IBARSW(I)=IBARS2(I)
 5408   CONTINUE
        IF(IERROR.EQ.'YES')GOTO5400
C
 5400 CONTINUE
 5300 CONTINUE
      GOTO8000
C
C
C               **************************************************
C               **   STEP 28--                                  **
C               **   REINSTATE INITIAL SETTINGS                 **
C               **************************************************
C
 8000 CONTINUE
 2800 CONTINUE
      ISTEPN='28'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'4PLO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,8807)IMANUF,NUMDEV,IDMANU(1)
 8807 FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      PWXMIN=PWXMN2
      PWXMAX=PWXMX2
      PWYMIN=PWYMN2
      PWYMAX=PWYMX2
      PXMIN=PXMN2
      PXMAX=PXMX2
      PYMIN=PYMN2
      PYMAX=PYMX2
      GX1MIN=GX1MNS
      GX1MAX=GX1MXS
      GX2MIN=GX2MNS
      GX2MAX=GX2MXS
      GY1MIN=GY1MNS
      GY1MAX=GY1MXS
      GY2MIN=GY2MNS
      GY2MAX=GY2MXS
      IX1MIN=IX1MNS
      IX1MAX=IX1MXS
      IX2MIN=IX2MNS
      IX2MAX=IX2MXS
      IY1MIN=IY1MNS
      IY1MAX=IY1MXS
      IY2MIN=IY2MNS
      IY2MAX=IY2MXS
      IX1TSW=IX1TSV
      IX2TSW=IX2TSV
      IY1TSW=IY1TSV
      IY2TSW=IY2TSV
      IX1ZSW=IX1ZSV
      IX2ZSW=IX2ZSV
      IY1ZSW=IY1ZSV
      IY2ZSW=IY2ZSV
      PX1LDS=PX1LD2
      PX2LDS=PX2LD2
      PY1LDS=PY1LD2
      PY1LAN=PY1LA2
      IY1LJU=IY1LJ2
      IY1LDI=IY1LD2
      PX1ZDS=PX1ZD2
      PX2ZDS=PX2ZD2
      PY1ZDS=PY1ZD2
      PY2ZDS=PY2ZD2
C
      DO8820I=1,100
        ICHAPA(I)=ICHAP2(I)
        ILINPA(I)=ILINP2(I)
        ISPISW(I)=ISPIS2(I)
        IBARSW(I)=IBARS2(I)
 8820 CONTINUE
C
      IMPSW='OFF'
      IMPCO=1
      IMPNR=IMPNR2
      IMPNC=IMPNC2
C
      IERASW='ON'
      IFENSW=IFENC2
      ISORSW=ISORS2
      IPPTBI=IPPTB2
C
      DO8500I=1,MAXCH
        IX1LTE(I)=IX1LT2(I)
        IX2LTE(I)=IX2LT2(I)
        IY1LTE(I)=IY1LT2(I)
        IY2LTE(I)=IY2LT2(I)
 8500 CONTINUE
      NCX1LA=NCX1L2
      NCX2LA=NCX2L2
      NCY1LA=NCY1L2
      NCY2LA=NCY2L2
C
      IFPLLA=IFPLL2
      IFPLTA=IFPLTZ
      IFPLFR=IFPLFZ
      IFPLPT=IFPLPZ
      IFPLLD=IFPLLZ
      IFPLXA=IFPLXZ
      IFPLYA=IFPLYZ
      IFPLDI=IFPLDZ
      IFPLST=IFPLZT
      IFPLS2=IFPLZ2
      IFPLS3=IFPLZ3
      IFPLS4=IFPLZ4
C
      IFEEDB=IFEED9
C
      DO8809I=1,MAXCH
        ITITTE(I)=ITITSV(I)
 8809 CONTINUE
      NCTITL=NCTITS
C
      IENDF5='OFF'
      IREWI5='ON'
      IF(IOUNI5.GT.0)
     1CALL DPCLFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IENDF5,IREWI5,ISUBN0,IERRF5,IBUGG3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')GOTO9000
C
      PTITDS=PTITDZ
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMARG
 9014 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9029
      DO9021I=1,NUMARG
      WRITE(ICOUT,9022)I,IHARG(I),IARGT(I)
 9022 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9029 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPRPO(ICOM,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IPPDE1,IPPDE2,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PREPLOT/POSTPLOT DEVICE
C              THAT IS, THE CURRENT DEVICE IN WHICH
C              THE USER WANTS A USER-SPECIFIED
C              PREPLOT LINE TO BE WRITTEN OUT,
C              AND A USER-DEFINED POSTPLOT LINE
C              TO BE WRITTEN OUT.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IPPDE1  (A HOLLERITH VARIABLE)
C                       IPPDE2  (A HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/9
C     ORIGINAL VERSION--OCTOBER  1986.
C     UPDATED         --FEBRUARY 1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
CCCCC CHARACTER*4 IARG   JULY 1987
CCCCC CHARACTER*4 ARG     JULY 1987
      CHARACTER*4 IARGT
C
      CHARACTER*4 IPPDE1
      CHARACTER*4 IPPDE2
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 IHARG1
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
      DIMENSION IARGT(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
C
      IHARG1=IHARG(1)
C
      IF(ICOM.EQ.'PRE')GOTO1109
      IF(ICOM.EQ.'PREP')GOTO1109
      IF(ICOM.EQ.'POST')GOTO1109
      ISHIFT=1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGS2,IERROR)
 1109 CONTINUE
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1120
C
      IF(IHARG(NUMARG).EQ.'ON')GOTO1120
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1120
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'POST')GOTO1120
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DEVI')GOTO1120
      IF(NUMARG.EQ.1)GOTO1130
C
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'POST'
     1              .AND.IHARG(2).EQ.'DEVI')GOTO1120
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'POST'
     1              .AND.IHARG(2).NE.'DEVI')GOTO1130
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'DEVI')GOTO1130
C
      IF(NUMARG.EQ.3.AND.IHARG(1).EQ.'POST'
     1              .AND.IHARG(2).EQ.'DEVI')GOTO1130
      IF(NUMARG.EQ.3.AND.IHARG(1).EQ.'POST'
     1              .AND.IHARG(2).NE.'DEVI')GOTO1140
      IF(NUMARG.EQ.3.AND.IHARG(1).EQ.'DEVI')GOTO1140
C
      GOTO1140
C
 1120 CONTINUE
      IHOLD1='NONE'
      IHOLD2='    '
      GOTO1180
C
 1130 CONTINUE
      IHOLD1=IHARG(NUMARG)
      IHOLD2='    '
      GOTO1180
C
 1140 CONTINUE
      NUMAM1=NUMARG-1
      IHOLD1=IHARG(NUMAM1)
      IHOLD2=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IPPDE1=IHOLD1
      IPPDE2=IHOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1188)IPPDE1,IPPDE2
 1188 FORMAT('THE PREPLOT/POSTPLOT DEVICE HAS JUST BEEN SET TO ',
     1A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPRSW(IHARG,NUMARG,
     1IPRIN2,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY THE PRINTING SWITCH WHICH IN TURN
C              DETERMINES WHETHER ANY SUBSEQUENT NON-GRAPHICAL OUTPUT
C              WILL BE PRINTED OR NOT.
C              THIS CAPABILITY IS USEFUL IF ONE WISHES TO SUPPRESS
C              OUTPUT FROM ALL PRELIMINARY AND INTERMEDIATE
C              CALCULATIONS AND JUST HAVE THE FINAL PLOTS THEMSELVES
C              APPEAR ON THE SCREEN.
C              THE SPECIFIED PRINTING SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IPRIN2.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IPRIN2 (A HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --FEBRUARY  1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IPRIN2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1199
C
 1150 CONTINUE
      IHOLD='ON'
      GOTO1180
C
 1160 CONTINUE
      IHOLD='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IPRIN2=IHOLD
      IPRINT=IPRIN2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IPRIN2
 1181 FORMAT('THE PRINTING SWITCH HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPYRA(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 PYRAMIDS
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 VERTICES
C           OF THE FRONT FACE OF THE PYRAMID.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 3
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*3 = 6.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN PYRAMID WILL GO
C           FROM THE LAST CURSOR POSITION
C           (ASSUMED TO BE AT VERTEX 1)
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT VERTEX 2)
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT VERTEX 3)
C           AND CONTINUING BACK THE START POINT TO CLOSE THE PYRAMID.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN PYRAMID WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS RESULTING FORM THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT VERTEX 1)
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT VERTEX 2)
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS
C           (ASSUMED TO BE AT VERTEX 3)
C           AND THEN CONTINUING BACK THE START POINT TO CLOSE THE PYRAMID.
C     NOTE--AND SO FORTH FOR 10, 14, 18, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/5
C     ORIGINAL VERSION--APRIL     1987.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'PYRA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPYRA--')
      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='PYRA'
      NUMPT=3
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPPYRA--')
      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 PYRAMID WITH ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      FRONT FACE VERTICES (20,20), (50,20), (35,40)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      PYRAMID 20 20 50 20 35 40')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      PYRAMID ABSOLUTE 20 20 50 20 35 40')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X3,X3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X3=X2+X3
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y3,Y3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y3=Y2+Y3
C
      CALL DPPYR2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X3
      Y1=Y3
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X3
      PYEND=Y3
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'PYRA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPYRA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2,X3,Y3
 9013 FORMAT('X1,Y1,X2,Y2,X3,Y3 = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPYR2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A PYRAMID
C              WITH FRONT FACE VERTICES AT (X1,Y1),
C              (X2,Y2), AND (X3,Y3).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/5
C     ORIGINAL VERSION--APRIL     1987.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(10)
      DIMENSION PY(10)
CCCCC DIMENSION PX3(10)
CCCCC DIMENSION PY3(10)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'PYR2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPYR2--')
      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               **  SET THE SPECS              **
C               **  WHICH CONTROL THE          **
C               **  APPEARANCE OF THE          **
C               **  RESULTING CUBE.            **
C               *********************************
C
      DELX21=ABS(X2-X1)
      DELY32=ABS(Y3-Y2)
C
      P3DX=0.1
      P3DY=0.3
C
C               *************************
C               **  STEP 2--           **
C               **  FILL THE FIGURE    **
C               **  (IF CALLED FOR)    **
C               *************************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
C
      IPATT=IREPTY(1)
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
C
      IF(IREFSW(1).EQ.'ON')GOTO2110
      IF(IREFSW(1).EQ.'ONF')GOTO2110
      IF(IREFSW(1).EQ.'ONS')GOTO2120
      IF(IREFSW(1).EQ.'ONFS')GOTO2110
      IF(IREFSW(1).EQ.'ONSF')GOTO2110
C
C               ********************************
C               **  STEP 2.1--                **
C               **  FRONT FACE ONLY           **
C               ********************************
C
 2110 CONTINUE
      PX(1)=X1
      PY(1)=Y1
C
      PX(2)=X2
      PY(2)=Y2
C
      PX(3)=X3
      PY(3)=Y3
C
      PX(4)=X1
      PY(4)=Y1
C
      NP=4
C
      IPATT2='SOLI'
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
C
      IF(IREFSW(1).EQ.'ON')GOTO2120
      IF(IREFSW(1).EQ.'ONF')GOTO2190
      IF(IREFSW(1).EQ.'ONS')GOTO2120
      IF(IREFSW(1).EQ.'ONFS')GOTO2120
      IF(IREFSW(1).EQ.'ONSF')GOTO2120
C
C               ********************************
C               **  STEP 2.2--                **
C               **  SIDE (= RIGHT) FACE ONLY  **
C               ********************************
C
 2120 CONTINUE
      PX(1)=X3
      PY(1)=Y3
C
      PX(2)=X2-P3DX*DELX21
      PY(2)=Y2+P3DY*DELY32
C
      PX(3)=X2
      PY(3)=Y2
C
      PX(4)=X3
      PY(4)=Y3
C
      NP=4
C
      IPATT2='SOLI'
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
C
      GOTO2190
C
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
C
      PX(1)=X1
      PY(1)=Y1
C
      PX(2)=X2
      PY(2)=Y2
C
      PX(3)=X3
      PY(3)=Y3
C
      PX(4)=X1
      PY(4)=Y1
C
      NP=4
C
      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
      PX(1)=X3
      PY(1)=Y3
C
      PX(2)=X2-0.1*DELX21
      PY(2)=Y2+0.3*DELY32
C
      PX(3)=X2
      PY(3)=Y2
C
      NP=3
C
      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.'PYR2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPYR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NP
 9013 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)IREFSW(1),IREFCO(1)
 9021 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)DELX21,DELY32,P3DX,P3DY
 9022 FORMAT('DELX21,DELY32,P3DX,P3DY = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      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 DPQCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICONT,IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING Q (= QUESENBERRY)
C              CONTROL CHARTS--
C              1) Q MEAN
C              2) Q RANGE
C              3) Q STANDARD DEVIATION
C              4) Q CUSUM
C              5) Q P
C              6) Q PN
C              7) Q C
C              8) Q U
C     REFERENCE--QUESENBERRY, CHARLES P.  SPC Q CHARTS FOR START-UP
C                PROCESSES AND SHORT OR LONG RUNS.
C                JOURNAL OF QUALITY TECNOLOGY, JULY 1991,
C                PAGES 213-224.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--93/12
C     ORIGINAL VERSION--DECEMBER  1993.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
C
      CHARACTER*4 IHEXT
      CHARACTER*4 IHEXT2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION X1(MAXOBV)
C
      DIMENSION XIDTEM(MAXOBV)
      DIMENSION TEMP(MAXOBV)
      DIMENSION TEMP2(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),Y2(1))
      EQUIVALENCE (GARBAG(IGARB4),XIDTEM(1))
      EQUIVALENCE (GARBAG(IGARB5),TEMP(1))
      EQUIVALENCE (GARBAG(IGARB6),TEMP2(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPQC'
      ISUBN2='C   '
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 Q CONTROL CHART CASE  **
C               **************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PQCC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPQCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICONT,IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('ICONT,IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISUBRO
   54 FORMAT('ISUBRO = ',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.'PQCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOM=IHARG(1)
      ICOM2=IHARG2(1)
      ISHIFT=1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGG2,IERROR)
C
C               ***************************************
C               **  STEP 1.1--                       **
C               **  SEARCH FOR Q MEAN CONTROL CHART  **
C               ***************************************
C
      ICASPL='MECC'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'X'.AND.IHARG(1).EQ.'BAR'.AND.IHARG(2).EQ.'CONT'.AND.
     1IHARG(3).EQ.'CHAR')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'XBAR'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MEAN'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AVER'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CONT'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'MEAN'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'XBAR'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AVER'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
C
C               ************************************************
C               **  STEP 1.2--                                **
C               **  SEARCH FOR Q STANDARD DEV. CONTROL CHART  **
C               ************************************************
C
      ICASPL='SDCC'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.IHARG(2).EQ.'CONT'.AND.
     1IHARG(3).EQ.'CHAR')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SD'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'S'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SD'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'S'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
C
C               ****************************************
C               **  STEP 1.3--                        **
C               **  SEARCH FOR Q RANGE CONTROL CHART  **
C               ****************************************
C
      ICASPL='RACC'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'RANG'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'R'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RANG'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'R'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
C
C               ****************************************
C               **  STEP 1.4--                        **
C               **  SEARCH FOR Q CUSUM CONTROL CHART  **
C               ****************************************
C
      ICASPL='CUCC'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'CUMU'.AND.IHARG(1).EQ.'SUM'.AND.IHARG(2).EQ.'CONT'.AND.
     1IHARG(3).EQ.'CHAR')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CUSU'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
C
C               ****************************************
C               **  STEP 1.5--                        **
C               **  SEARCH FOR Q P CONTROL CHART      **
C               ****************************************
C
      ICASPL='PCC'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'P'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'P'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
C
C               ****************************************
C               **  STEP 1.6--                        **
C               **  SEARCH FOR Q PN CONTROL CHART     **
C               ****************************************
C
      ICASPL='PNCC'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'PN'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'PN'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'NP'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'NP'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
C
C               ****************************************
C               **  STEP 1.7--                        **
C               **  SEARCH FOR Q C CONTROL CHART      **
C               ****************************************
C
      ICASPL='CCC'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'C'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'C'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
C
C               ****************************************
C               **  STEP 1.8--                        **
C               **  SEARCH FOR Q U CONTROL CHART      **
C               ****************************************
C
      ICASPL='UCC'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'U'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'U'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
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
  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 1--                                             **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PQCC')
     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.'PQCC')
     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.'PQCC')THEN
         WRITE(ICOUT,211)IHLEFT,ICOLL,NLEFT
  211    FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
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'.OR.ISUBRO.EQ.'PQCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPQCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A Q MEAN CONTROL CHART ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'SDCC')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A Q STANDARD DEVIATION CONTROL CHART ')
      IF(ICASPL.EQ.'SDCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'RACC')WRITE(ICOUT,323)
  323 FORMAT('      (FOR WHICH A Q RANGE CONTROL CHART ')
      IF(ICASPL.EQ.'RACC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUCC')WRITE(ICOUT,324)
  324 FORMAT('      (FOR WHICH A Q CUSUM CONTROL CHART ')
      IF(ICASPL.EQ.'CUCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PCC')WRITE(ICOUT,325)
  325 FORMAT('      (FOR WHICH A Q P CONTROL CHART ')
      IF(ICASPL.EQ.'PCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PNCC')WRITE(ICOUT,326)
  326 FORMAT('      (FOR WHICH A Q NP CONTROL CHART ')
      IF(ICASPL.EQ.'PNCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CCC')WRITE(ICOUT,327)
  327 FORMAT('      (FOR WHICH A Q C CONTROL CHART ')
      IF(ICASPL.EQ.'CCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'UCC')WRITE(ICOUT,328)
  328 FORMAT('      (FOR WHICH A Q U CONTROL CHART ')
      IF(ICASPL.EQ.'UCC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,334)
  334 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,335)MINN2
  335 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,336)
  336 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,337)
  337 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,338)(IANS(I),I=1,IWIDTH)
  338 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'.OR.ISUBRO.EQ.'PQCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPQCC')
      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'.AND.ISUBRO.NE.'PQCC')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 Q CONTROL CHART.                 **
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'.OR.ISUBRO.EQ.'PQCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.1)GOTO599
      IF(NUMV2.EQ.2)GOTO530
      IF(NUMV2.EQ.3)GOTO540
      GOTO510
C
  510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPQCC--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,512)
  512 FORMAT('      FOR A Q MEAN CONTROL CHART, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'SDCC')WRITE(ICOUT,513)
  513 FORMAT('      FOR A Q STANDARD DEVIATION CONTROL CHART, ')
      IF(ICASPL.EQ.'SDCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'RACC')WRITE(ICOUT,514)
  514 FORMAT('      FOR A Q RANGE CONTROL CHART, ')
      IF(ICASPL.EQ.'RACC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUCC')WRITE(ICOUT,515)
  515 FORMAT('      FOR A Q CUSUM CONTROL CHART, ')
      IF(ICASPL.EQ.'CUCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PCC')WRITE(ICOUT,516)
  516 FORMAT('      (FOR WHICH A Q P CONTROL CHART ')
      IF(ICASPL.EQ.'PCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PNCC')WRITE(ICOUT,517)
  517 FORMAT('      (FOR WHICH A Q NP CONTROL CHART ')
      IF(ICASPL.EQ.'PNCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CCC')WRITE(ICOUT,518)
  518 FORMAT('      (FOR WHICH A Q C CONTROL CHART ')
      IF(ICASPL.EQ.'CCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'UCC')WRITE(ICOUT,519)
  519 FORMAT('      (FOR WHICH A Q U CONTROL CHART ')
      IF(ICASPL.EQ.'UCC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,523)
  523 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,524)
  524 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,525)
  525 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,526)
  526 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,527)NUMV2
  527 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,528)
  528 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,529)(IANS(I),I=1,IWIDTH)
  529 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'.OR.ISUBRO.EQ.'PQCC')THEN
         WRITE(ICOUT,531)IHHOR,ICOLH,NHOR
  531    FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(NHOR.NE.NLEFT)GOTO570
      GOTO599
C
  540 CONTINUE
C     IHEXT AS IN "EXTRA"
      IHEXT=IHARG(2)
      IHEXT2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHEXT,IHEXT2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLE=IVALUE(ILOCV)
      NEXT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PQCC')THEN
         WRITE(ICOUT,541)IHEXT,ICOLE,NEXT
  541    FORMAT('IHEXT,ICOLE,NEXT   = ',A4,I8,I8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(NEXT.NE.NLEFT)GOTO570
C
      IHHOR=IHARG(3)
      IHHOR2=IHARG2(3)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH=IVALUE(ILOCV)
      NHOR=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PQCC')THEN
         WRITE(ICOUT,542)IHHOR,ICOLH,NHOR
  542    FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(NHOR.NE.NLEFT)GOTO570
      GOTO599
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPQCC--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,572)
  572 FORMAT('      FOR A Q MEAN CONTROL CHART, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'SDCC')WRITE(ICOUT,573)
  573 FORMAT('      FOR A Q STANDARD DEVIATION CONTROL CHART,')
      IF(ICASPL.EQ.'SDCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'RACC')WRITE(ICOUT,574)
  574 FORMAT('      FOR A Q RANGE CONTROL CHART, ')
      IF(ICASPL.EQ.'RACC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUCC')WRITE(ICOUT,575)
  575 FORMAT('      FOR A Q CUSUM CONTROL CHART,')
      IF(ICASPL.EQ.'CUCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PCC')WRITE(ICOUT,576)
  576 FORMAT('      (FOR WHICH A P CONTROL CHART ')
      IF(ICASPL.EQ.'PCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PNCC')WRITE(ICOUT,577)
  577 FORMAT('      (FOR WHICH A NP CONTROL CHART ')
      IF(ICASPL.EQ.'PNCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CCC')WRITE(ICOUT,578)
  578 FORMAT('      (FOR WHICH A Q C CONTROL CHART ')
      IF(ICASPL.EQ.'CCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'UCC')WRITE(ICOUT,579)
  579 FORMAT('      (FOR WHICH A Q U CONTROL CHART ')
      IF(ICASPL.EQ.'UCC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)
  584 FORMAT('      WHEN HAVE 2 (OR 3) VARAIBLES SPECIFIED, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)
  585 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)
  586 FORMAT('      IN THE 2 (OR 3) VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,588)
  588 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,589)
  589 FORMAT('      THE FIRST  VARIABLE  (RESPONSE VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,590)IHLEFT,NLEFT
  590 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,591)
  591 FORMAT('      THE 2ND VARIABLE--')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.EQ.3)WRITE(ICOUT,592)IHEXT,NEXT
      IF(NUMV2.EQ.3)CALL DPWRST('XXX','BUG ')
      IF(NUMV2.EQ.2)WRITE(ICOUT,592)IHHOR,NHOR
  592 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      IF(NUMV2.EQ.2)CALL DPWRST('XXX','BUG ')
      IF(NUMV2.EQ.3)WRITE(ICOUT,593)
  593 FORMAT('      THE 3ND VARIABLE  (HORIZ. AXIS VALUES)--')
      IF(NUMV2.EQ.3)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,594)IHHOR,NHOR
  594 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,595)
  595 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,596)(IANS(I),I=1,IWIDTH)
  596 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  599 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'.OR.ISUBRO.EQ.'PQCC')
     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,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
      IF(NUMV2.EQ.2)GOTO652
      GOTO653
C
  652 CONTINUE
      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)
      GOTO660
C
  653 CONTINUE
      IJ=MAXN*(ICOLE-1)+I
      IF(ICOLE.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLE.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLE.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLE.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLE.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLE.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLE.EQ.MAXCP6)Y2(J)=TAGPLO(I)
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)
      GOTO660
C
  660 CONTINUE
      NLOCAL=J
C
C               ****************************************************************
C               **  STEP 8--                                                  **
C               **  DETERMINE IF THE ANALYST                                  **
C               **  HAS SPECIFIED
C               **      LSL (LOWER SPEC LIMIT)
C               **      USL (UPPER SPEC LIMIT)
C               **      USLCOST (UPPER SPEC LIMIT COST)
C               **      TARGET
C               **  FOR THE Q CONTROL CHART ANALYSIS.                           **
C               ****************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PQCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CCLSL=CPUMIN
      IH='LSL '
      IH2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IF(IERRO2.EQ.'NO')CCLSL=VALUE(ILOCP)
C
      CCUSL=CPUMIN
      IH='USL '
      IH2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IF(IERRO2.EQ.'NO')CCUSL=VALUE(ILOCP)
C
      CCTARG=CPUMIN
      IH='TARG'
      IH2='ET  '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IF(IERRO2.EQ.'NO')CCTARG=VALUE(ILOCP)
C
C               *************************************************************
C               **  STEP 9--                                               **
C               **  COMPUTE THE APPROPRIATE Q CONTROL CHART STATISTIC--      **
C               **  MEAN, STANDARD DEVIATION, RANGE, CUSUM,                **
C               **  P, NP, C, U.                                           **
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'.OR.ISUBRO.EQ.'PQCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  809 CONTINUE
      CALL DPQCC2(Y1,Y2,X1,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,
     1XIDTEM,TEMP,TEMP2,CCLSL,CCUSL,CCTARG,
     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.'PQCC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPQCC--')
      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('PNLOTV,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 DPQCC2(Y,YN,X,N,NUMV2,ICASPL,ISIZE,ICONT,
     1XIDTEM,TEMP,TEMP2,CCLSL,CCUSL,CCTARG,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A Q (= QUESENBERRY) CONTROL CHART
C              OF THE FOLLOWING TYPES--
C                 1) Q MEAN CONTROL CHART    Y X
C                 2) Q STANDARD DEVIATION CONTROL CHART    Y X
C                 3) Q RANGE CONTROL CHART    Y X
C                 4) Q CUSUM CONTROL CHART    Y X
C                 5) Q P CONTROL CHART    NUMDEF NUMTOT X
C                 6) Q PN CONTROL CHART    NUMDEF NUMTOT X
C                 7) Q U CONTROL CHART    NUMDEF SIZE X
C                 8) Q P CONTROL CHART    NUMDEF SIZE X
C     NOTE--USE P AND PN CHARTS IF KNOW HOW MANY ITEMS HAVE DEFECTS
C         --USE U AND C CHARTS IF KNOW HOW MANY DEFECTS
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--QUESENBERRY, CHARLES P.  SPC Q CHARTS FOR START-UP
C                PROCESSES AND SHORT OR LONG RUNS.
C                JOURNAL OF QUALITY TECNOLOGY, JULY 1991,
C                PAGES 213-224.
C     REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105
C     REFERENCE--ISHIKAWA, GUIDE TO QUALITY CONTROL
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--93/12
C     ORIGINAL VERSION--DECEMBER  1993.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION YN(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION XIDTEM(*)
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
C
      DIMENSION A3(30)
      DIMENSION C4(30)
      DIMENSION B3(30)
      DIMENSION B4(30)
      DIMENSION D22(30)
      DIMENSION D3(30)
      DIMENSION D4(30)
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(A3(I),I=    1,   25)
     1/9.999,2.659,1.954,1.628,1.427,
     1 1.287,1.182,1.099,1.032,0.975,
     1 0.927,0.886,0.850,0.817,0.789,
     1 0.763,0.739,0.718,0.698,0.680,
     1 0.663,0.647,0.633,0.619,0.606/
      DATA(C4(I),I=    1,   25)
     1/9.9999,0.7979,0.8862,0.9213,0.9400,
     1 0.9515,0.9594,0.9650,0.9693,0.9727,
     1 0.9754,0.9776,0.9794,0.9810,0.9823,
     1 0.9835,0.9845,0.9854,0.9862,0.9869,
     1 0.9876,0.9882,0.9887,0.9892,0.9896/
      DATA(B3(I),I=    1,   25)
     1/0.000,0.000,0.000,0.000,0.000,0.030,0.118,0.185,0.239,0.284,
     1 0.321,0.354,0.382,0.406,0.428,0.448,0.466,0.482,0.497,0.510,
     1 0.523,0.534,0.545,0.555,0.565/
      DATA(B4(I),I=    1,   25)
     1/9.999,3.267,2.568,2.266,2.089,1.970,1.882,1.815,1.761,1.716,
     1 1.679,1.646,1.618,1.594,1.572,1.552,1.534,1.518,1.503,1.490,
     1 1.477,1.466,1.455,1.445,1.435/
      DATA(D22(I),I=    1,   25)
     1/9.999,3.686,4.358,4.698,4.918,5.078,5.203,5.307,5.394,5.469,
     1 5.534,5.592,5.646,5.693,5.737,5.779,5.817,5.854,5.888,5.922,
     1 5.950,5.979,6.006,6.031,6.058/
      DATA(D3(I),I=    1,   25)
     1/0.000,0.000,0.000,0.000,0.000,0.000,0.076,0.136,0.184,0.223,
     1 0.256,0.284,0.308,0.329,0.348,0.364,0.379,0.392,0.404,0.414,
     1 0.425,0.434,0.443,0.452,0.459/
      DATA(D4(I),I=    1,   25)
     1/9.999,3.267,2.575,2.282,2.115,2.004,1.924,1.864,1.816,1.777,
     1 1.744,1.716,1.692,1.671,1.652,1.636,1.621,1.608,1.596,1.586,
     1 1.575,1.566,1.557,1.548,1.541/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPQC'
      ISUBN2='C2  '
C
      I2=0
      ISIZE2=0
C
      AN=0.0
      XBARG=0.0
      SDG=0.0
      RANGEG=0.0
      YUPPER=0.0
      YLOWER=0.0
C
      ANUMSE=0.0
      SDI=0.0
      SIGMAE=0.0
      RANGEE=0.0
      SADJ=0.0
      RADJ=0.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPQCC2--')
      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 DPQCC2--')
      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 DPQCC2--')
      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'.AND.ISUBRO.NE.'QCC2')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPQCC2--')
      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,3F15.7)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
      IF(NUMV2.LE.2)GOTO79
      DO75I=1,N
      WRITE(ICOUT,76)I,YN(I),X(I)
   76 FORMAT('I,YN(I),X(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   79 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 A Q CONTROL CHART.  **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMSET=(-999)
      IF(NUMV2.EQ.1)GOTO199
      IF(NUMV2.EQ.2)GOTO150
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
  190 CONTINUE
C
      IF(NUMSET.GE.1)GOTO194
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,191)
  191 FORMAT('***** ERROR IN DPQCC2 SUBROUTINE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,192)
  192 FORMAT('      NUMBER OF SETS    NUMSET = 0 ')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  194 CONTINUE
C
      IF(ICASPL.EQ.'PCC')GOTO199
      IF(ICASPL.EQ.'PNCC')GOTO199
      IF(ICASPL.EQ.'UCC')GOTO199
      IF(ICASPL.EQ.'CCC')GOTO199
C
      IF(NUMSET.NE.N)GOTO199
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,195)
  195 FORMAT('***** ERROR IN DPQCC2 SUBROUTINE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,196)
  196 FORMAT('      NUMBER OF SETS    NUMSET   IDENTICAL TO ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,197)
  197 FORMAT('      NUMBER OF OBSERVATIONS   N   .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,198)NUMSET
  198 FORMAT('      NUMSET = N = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  199 CONTINUE
C
      AN=N
      ANUMSE=NUMSET
C
C               *******************************************
C               **  STEP 3.0--                           **
C               **  DETERMINE STATISTICS FOR THE ENTIRE  **
C               **  DATA SET                             **
C               *******************************************
C
 1000 CONTINUE
C
      ISTEPN='3.0'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.EQ.1)GOTO1090
C
      SUMXBG=0.0
      SUMSDG=0.0
      SUMRAG=0.0
      SUMSIE=0.0
      SUMRIE=0.0
      J=0
      DO1010ISET=1,NUMSET
      J=J+1
C
      K=0
      DO1020I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 1020 CONTINUE
      NI=K
      ANI=NI
C
      SUM=0.0
      IF(NI.LE.0)GOTO1040
      DO1030I=1,NI
      SUM=SUM+TEMP(I)
 1030 CONTINUE
      XBARI=SUM/ANI
C
      SUM=0.0
      DO1032I=1,NI
      SUM=SUM+(TEMP(I)-XBARI)**2
 1032 CONTINUE
      DENOM=ANI-1.0
      VARI=0.0
      IF(NI.GE.2)VARI=SUM/DENOM
      SDI=0.0
      IF(VARI.GT.0.0)SDI=SQRT(VARI)
C
      XTMIN=TEMP(1)
      XTMAX=TEMP(1)
      DO1034I=1,NI
      IF(TEMP(I).LT.XTMIN)XTMIN=TEMP(I)
      IF(TEMP(I).GT.XTMAX)XTMAX=TEMP(I)
 1034 CONTINUE
      RANGEI=XTMAX-XTMIN
      GOTO1049
C
 1040 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1041)
 1041 FORMAT('***** INTERNAL ERROR IN DPQCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1042)
 1042 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1043)ISET,XIDTEM(ISET),NI
 1043 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1049 CONTINUE
C
      SUMXBG=SUMXBG+ANI*XBARI
      SUMSDG=SUMSDG+ANI*SDI
      SUMRAG=SUMRAG+ANI*RANGEI
      C4LARG=1.0
      IF(NI.LE.25)SUMSIE=SUMSIE+SDI/C4(NI)
      IF(NI.GE.26)SUMSIE=SUMSIE+SDI/C4LARG
      D22LAR=2.0*SQRT(2.0*ALOG(2.0*ANI))
      IF(NI.LE.25)SUMRIE=SUMRIE+RANGEI/D22(NI)
      IF(NI.GE.26)SUMRIE=SUMRIE+RANGEI/D22LAR
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'QCC2')GOTO1069
      WRITE(ICOUT,1061)ISET,NI,ANI
 1061 FORMAT('ISET,NI,ANI = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1062)XBARI
 1062 FORMAT('XBARI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1063)SDI,C4(NI),C4LARG,SUMSIE
 1063 FORMAT('SDI,C4(NI),C4LARG,SUMSIE = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1064)RANGEI,D22(NI),D22LAR,SUMRIE
 1064 FORMAT('RANGEI,D22(NI),D22LAR,SUMRIE = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 1069 CONTINUE
C
 1010 CONTINUE
C
      XBARG=SUMXBG/AN
      SDG=SUMSDG/AN
      RANGEG=SUMRAG/AN
      SIGMAE=SUMSIE/ANUMSE
      RANGEE=SUMRIE/ANUMSE
C
 1090 CONTINUE
C
C               **************************************************************
C               **  STEP 4--                                                **
 
C               **  IN ORDER TO DETERMINE THE PROPER PLOT COOORDINATES      **
C               **  FOR THE DESIRED PLOT,                                   **
C               **  BRANCH TO THE PROPER SUBCASE--                          **
C               **         1) Q MEAN CONTROL CHART;                           **
C               **         2) Q STANDARD DEVIATION CONTROL CHART;             **
C               **         3) Q RANGE CONTROL CHART;                          **
C               **         4) Q CUSUM CONTROL CHART;                          **
C               **         5) Q P CONTROL CHART;                              **
C               **         6) Q PN CONTROL CHART;                             **
C               **         7) Q C CONTROL CHART;                              **
C               **         8) Q U CONTROL CHART;                              **
C               **************************************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'MECC')GOTO1100
      IF(ICASPL.EQ.'SDCC')GOTO1200
      IF(ICASPL.EQ.'RACC')GOTO1300
      IF(ICASPL.EQ.'CUCC')GOTO1400
      IF(ICASPL.EQ.'PCC')GOTO1500
      IF(ICASPL.EQ.'PNCC')GOTO1600
      IF(ICASPL.EQ.'UCC')GOTO1700
      IF(ICASPL.EQ.'CCC')GOTO1800
C
 1050 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1051)
 1051 FORMAT('***** INTERNAL ERROR IN DPQCC2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1052)
 1052 FORMAT('      AT BRANCH POINT 261--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1053)
 1053 FORMAT('      ICASPL NOT EQUAL ONE OF THE ALLOWABLE 8--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1054)
 1054 FORMAT('      MECC, SDCC, RACC, CSCC, PCC, PNCC, UCC, CCC.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1056)ICASPL
 1056 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *******************************************
C               **  STEP 5.1--                           **
C               **  TREAT THE Q MEAN CONTROL CHART CASE  **
C               *******************************************
C
 1100 CONTINUE
C
      ISTEPN='5.1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      DO1110K=3,N
         KM1=K-1
         AKM1=KM1
         KM2=K-2
C
         SUM=0.0
         DO1120I=1,KM1
            SUM=SUM+Y(I)
 1120    CONTINUE
         XBAKM1=SUM/AKM1
C
         SUM=0.0
         DO1130I=1,KM1
            SUM=SUM+(Y(I)-XBAKM1)**2
 1130    CONTINUE
         SKM1=SQRT(SUM/(AKM1-1.0))
C
         ANUM=Y(K)-XBAKM1
         ADENOM=SKM1*SQRT((1.0/AKM1)+1.0)
         RATIO=ANUM/ADENOM
         CALL TCDF(RATIO,KM2,CDF)
         CALL NORPPF(CDF,PPF)
         J=J+1
         Y2(J)=PPF
         X2(J)=J
         D2(J)=1.0
 1110 CONTINUE
      N2=J
      NPLOTV=2
      GOTO9000
C
C               **********************************************************
C               **  STEP 5.2--                                          **
C               **  TREAT THE Q STANDARD DEVIATION CONTROL CHART CASE  **
C               **********************************************************
C
 1200 CONTINUE
C
      ISTEPN='5.2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      DO1210ISET=1,NUMSET
C
      K=0
      DO1220I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 1220 CONTINUE
      NI=K
      ANI=NI
C
      IF(NI.GE.1)GOTO1239
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1231)
 1231 FORMAT('***** INTERNAL ERROR IN DPQCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1232)
 1232 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1233)ISET,XIDTEM(ISET),NI
 1233 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1239 CONTINUE
C
      SUM=0.0
      DO1240I=1,NI
      SUM=SUM+TEMP(I)
 1240 CONTINUE
      XBARI=SUM/ANI
C
      IF(NI.LE.1)GOTO1210
C
      SUM=0.0
      DO1250I=1,NI
      SUM=SUM+(TEMP(I)-XBARI)**2
 1250 CONTINUE
      DENOM=ANI-1.0
      VARI=0.0
      IF(NI.GE.2)VARI=SUM/DENOM
      SDI=0.0
      IF(VARI.GT.0.0)SDI=SQRT(VARI)
C
      C4LARG=1.0
      IF(NI.LE.25)SADJ=C4(NI)*SIGMAE
      IF(NI.GE.26)SADJ=C4LARG*SIGMAE
C
      YMID=SADJ
C
      B4LARG=1.0+3.0/SQRT(2.0*(ANI-1.0))
      IF(NI.LE.25)YUPPER=B4(NI)*SADJ
      IF(NI.GE.26)YUPPER=B4LARG*SADJ
C
      B3LARG=1.0-3.0/SQRT(2.0*(ANI-1.0))
      IF(NI.LE.25)YLOWER=B3(NI)*SADJ
      IF(NI.GE.26)YLOWER=B3LARG*SADJ
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'QCC2')GOTO1269
      WRITE(ICOUT,1261)ISET,NI,ANI
 1261 FORMAT('ISET,NI,ANI = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1262)XBARI
 1262 FORMAT('XBARI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1263)SDI,C4(NI),C4LARG,SIGMAE,SADJ
 1263 FORMAT('SDI,C4(NI),C4LARG,SIGMAE,SADJ = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1264)SADJ,YMID
 1264 FORMAT('SADJ,YMID = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1265)NI,ANI,B4(NI),B4LARG,YUPPER
 1265 FORMAT('NI,ANI,B4(NI),B4LARG,YUPPER = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1266)NI,ANI,B3(NI),B3LARG,YLOWER
 1266 FORMAT('NI,ANI,B3(NI),B3LARG,YLOWER = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
 1269 CONTINUE
C
      J=J+1
      Y2(J)=SDI
      X2(J)=XIDTEM(ISET)
      D2(J)=1.0
C
      J=J+1
      Y2(J)=YMID
      X2(J)=XIDTEM(ISET)
      D2(J)=2.0
C
      J=J+1
      Y2(J)=YUPPER
      X2(J)=XIDTEM(ISET)
      D2(J)=3.0
C
      J=J+1
      Y2(J)=YLOWER
      X2(J)=XIDTEM(ISET)
      D2(J)=4.0
C
      IF(CCTARG.EQ.CPUMIN)GOTO1271
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XIDTEM(ISET)
      D2(J)=5.0
 1271 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO1272
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XIDTEM(ISET)
      D2(J)=6.0
 1272 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO1273
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XIDTEM(ISET)
      D2(J)=7.0
 1273 CONTINUE
C
 1210 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ********************************************
C               **  STEP 5.3--                            **
C               **  TREAT THE Q RANGE CONTROL CHART CASE  **
C               ********************************************
C
 1300 CONTINUE
C
      ISTEPN='5.3'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      D4FACT=1.25
      D3FACT=1.0/1.25
C
      J=0
      DO1310ISET=1,NUMSET
C
      K=0
      DO1320I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 1320 CONTINUE
      NI=K
      ANI=NI
C
      IF(NI.GE.1)GOTO1339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1331)
 1331 FORMAT('***** INTERNAL ERROR IN DPQCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1332)
 1332 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1333)ISET,XIDTEM(ISET),NI
 1333 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1339 CONTINUE
C
      IF(NI.LE.1)GOTO1310
C
      XTMIN=TEMP(1)
      XTMAX=TEMP(1)
      DO1340I=1,NI
      IF(TEMP(I).LT.XTMIN)XTMIN=TEMP(I)
      IF(TEMP(I).GT.XTMAX)XTMAX=TEMP(I)
 1340 CONTINUE
      RANGEI=XTMAX-XTMIN
C
      D22LAR=2.0*SQRT(2.0*ALOG(2.0*ANI))
      IF(NI.LE.25)RADJ=D22(NI)*RANGEE
      IF(NI.GE.26)RADJ=D22LAR*RANGEE
C
      YMID=RADJ
C
      D4LARG=1.0+3.0*D4FACT/SQRT(2.0*(ANI-1.0))
      IF(NI.LE.25)YUPPER=D4(NI)*RADJ
      IF(NI.GE.26)YUPPER=D4LARG*RADJ
C
      D3LARG=1.0-3.0*D3FACT/SQRT(2.0*(ANI-1.0))
      IF(NI.LE.25)YLOWER=D3(NI)*RADJ
      IF(NI.GE.26)YLOWER=D3LARG*RADJ
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'QCC2')GOTO1369
      WRITE(ICOUT,1361)ISET,NI,ANI
 1361 FORMAT('ISET,NI,ANI = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1362)RANGEI
 1362 FORMAT('RANGEI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1363)RANGEI,D22(NI),D22LAR,RANGEE,SADJ
 1363 FORMAT('RANGEI,D22(NI),D22LAR,RANGEE,SADJ = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1364)RADJ,YMID
 1364 FORMAT('RADJ,YMID = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1365)NI,ANI,D4(NI),D4LARG,YUPPER
 1365 FORMAT('NI,ANI,D4(NI),D4LARG,YUPPER = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1366)NI,ANI,D3(NI),D3LARG,YLOWER
 1366 FORMAT('NI,ANI,D3(NI),D3LARG,YLOWER = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
 1369 CONTINUE
C
      J=J+1
      Y2(J)=RANGEI
      X2(J)=XIDTEM(ISET)
      D2(J)=1.0
C
      J=J+1
      Y2(J)=YMID
      X2(J)=XIDTEM(ISET)
      D2(J)=2.0
C
      J=J+1
      Y2(J)=YUPPER
      X2(J)=XIDTEM(ISET)
      D2(J)=3.0
C
      J=J+1
      Y2(J)=YLOWER
      X2(J)=XIDTEM(ISET)
      D2(J)=4.0
C
      IF(CCTARG.EQ.CPUMIN)GOTO1371
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XIDTEM(ISET)
      D2(J)=5.0
 1371 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO1372
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XIDTEM(ISET)
      D2(J)=6.0
 1372 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO1373
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XIDTEM(ISET)
      D2(J)=7.0
 1373 CONTINUE
C
 1310 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ******************************************************
C               **  STEP 5.4--                                      **
C               **  DETERMINE PLOT COORDINATES                      **
C               **  FOR THE Q CUSUM CONTROL CHART PLOT SUBCASE.       **
C               ******************************************************
C
 1400 CONTINUE
C
      ISTEPN='3.4'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,1405)
 1405 FORMAT('CUSUM CAPABILITY NOT YET AVAILABLE.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               ********************************************************
C               **  STEP 5.5--                                        **
C               **  TREAT THE Q P CONTROL CHART CASE                   **
C               **  PROPORTION DEFECTIVE PER BATCH (SUBSAMPLE)        **
C               **  NUMBER DEFECTIVE PER BATCH / TOTAL NUMBER IN BATCH
C               **  THE INPUT IS A DUAL SERIES--
C               **     1) NUMBER OF DEFECTIVE ITEMS IN THE SUBSAMPLE
C               **     2) TOTAL NUMBER OF ITEMS IN THE SAMPLE
C               **  THE CONFIDENCE BAND IS GOTTEN BY ASSUMING BINOMIAL**
C               ********************************************************
C
 1500 CONTINUE
C
      ISTEPN='5.5'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM1=0.0
      SUM2=0.0
      DO1510ISET=1,NUMSET
      SUM1=SUM1+Y(ISET)
      SUM2=SUM2+YN(ISET)
 1510 CONTINUE
      CTOTAL=SUM1
      ANTOT=SUM2
      PBARG=CTOTAL/ANTOT
      PRBARG=100.0*PBARG
C
      J=0
      DO1550ISET=1,NUMSET
C
      CI=Y(ISET)
      ANI=YN(ISET)
      NI=ANI+0.5
      IF(NI.LE.0)GOTO1550
C
      PI=CI/ANI
      PROPI=100.0*PI
      TAGI=XIDTEM(ISET)
C
      J=J+1
      Y2(J)=PROPI
      X2(J)=TAGI
      D2(J)=1.0
C
      J=J+1
      YMID=PRBARG
      Y2(J)=YMID
      X2(J)=TAGI
      D2(J)=2.0
C
      J=J+1
      VARPI=0.0
      IF(ANI.GT.0.0)VARPI=PBARG*(1.0-PBARG)/ANI
      SDPI=0.0
      IF(VARPI.GT.0.0)SDPI=SQRT(VARPI)
      SDPRI=100.0*SDPI
      YUPPER=YMID+3.0*SDPRI
      IF(YUPPER.GT.100.0)YUPPER=100.0
      Y2(J)=YUPPER
      X2(J)=TAGI
      D2(J)=3.0
C
      J=J+1
      YLOWER=YMID-3.0*SDPRI
      IF(YLOWER.LT.0.0)YLOWER=0.0
      Y2(J)=YLOWER
      X2(J)=TAGI
      D2(J)=4.0
C
      IF(CCTARG.EQ.CPUMIN)GOTO1571
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XIDTEM(ISET)
      D2(J)=5.0
 1571 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO1572
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XIDTEM(ISET)
      D2(J)=6.0
 1572 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO1573
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XIDTEM(ISET)
      D2(J)=7.0
 1573 CONTINUE
C
 1550 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ********************************************************
C               **  STEP 5.6--                                        **
C               **  TREAT THE Q PN CONTROL CHART CASE                   **
C               **  TOTAL NUMBER DEFECTIVE IN A BATCH (SUBSAMPLE)     **
C               **  SUM UP THE NUMBER OF DEFECTIVES PER BATCH (SUBSAMPLE)
C               **  THE NUMBER WILL BE  A NON-NEGATIVE INTEGER
C               **  THE INPUT IS A DUAL SERIES--
C               **     1) NUMBER OF DEFECTIVE ITEMS IN THE SUBSAMPLE
C               **     2) TOTAL NUMBER OF ITEMS IN THE SAMPLE
C               **  THE CONFIDENCE BAND IS GOTTEN BY ASSUMING BINOMIAL**
C               **  NOTE--THE PN CHART SHOULD BE USED ONLY WHEN
C               **        THE SUBSAMPLE SIZE IS CONSTANT.
C               **        FOR VARYING SUBSAMPLE SIZE, USE THE P CHART
C               **        (ISHIKAWA, GUIDE TO QUALITY CONTROL, PAGE 77)
C               ********************************************************
C
 1600 CONTINUE
C
      ISTEPN='5.6'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM1=0.0
      SUM2=0.0
      ANUMSE=NUMSET
      DO1610ISET=1,NUMSET
      SUM1=SUM1+Y(ISET)
      SUM2=SUM2+YN(ISET)
 1610 CONTINUE
      CTOTAL=SUM1
      ANTOT=SUM2
      PBARG=CTOTAL/ANTOT
      ANBARG=ANTOT/ANUMSE
      CBARG=PBARG*ANBARG
C
      J=0
      DO1650ISET=1,NUMSET
C
      CI=Y(ISET)
      ANI=YN(ISET)
      NI=ANI+0.5
      IF(NI.LE.0)GOTO1650
C
      PI=CI/ANI
      TAGI=XIDTEM(ISET)
C
      J=J+1
      Y2(J)=CI
      X2(J)=TAGI
      D2(J)=1.0
C
      J=J+1
      YMID=CBARG
      Y2(J)=YMID
      X2(J)=TAGI
      D2(J)=2.0
C
      J=J+1
      VARCI=0.0
      IF(ANBARG.GT.0.0)VARCI=ANBARG*PBARG*(1.0-PBARG)
      SDCI=0.0
      IF(VARCI.GT.0.0)SDCI=SQRT(VARCI)
      YUPPER=YMID+3.0*SDCI
      Y2(J)=YUPPER
      X2(J)=TAGI
      D2(J)=3.0
C
      J=J+1
      YLOWER=YMID-3.0*SDCI
      IF(YLOWER.LT.0.0)YLOWER=0.0
      Y2(J)=YLOWER
      X2(J)=TAGI
      D2(J)=4.0
C
      IF(CCTARG.EQ.CPUMIN)GOTO1671
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XIDTEM(ISET)
      D2(J)=5.0
 1671 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO1672
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XIDTEM(ISET)
      D2(J)=6.0
 1672 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO1673
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XIDTEM(ISET)
      D2(J)=7.0
 1673 CONTINUE
C
 1650 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ********************************************************
C               **  STEP 5.7--                                        **
C               **  TREAT THE Q U CONTROL CHART CASE (POISSON)         **
C               **  DEFECTIVE PER UNIT
C               **  DEFECTIVE PER UNIT AREA
C               **  NUMBER DEFECTIVE PER SUB-BATCH / LENGTH OR AREA
C               **  THE INPUT IS A DUAL SERIES--
C               **     1) NUMBER OF DEFECTIVE ITEMS IN THE SUBSAMPLE
C               **     2) LENGTH OR AREA OF THE ITEM
C               **  THE CONFIDENCE BAND IS GOTTEN BY ASSUMING POISSON**
C               ********************************************************
C
 1700 CONTINUE
C
      ISTEPN='5.7'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM1=0.0
      SUM2=0.0
      DO1710ISET=1,NUMSET
      SUM1=SUM1+Y(ISET)
      SUM2=SUM2+YN(ISET)
 1710 CONTINUE
      CTOTAL=SUM1
      SIZTOT=SUM2
      CBARG=CTOTAL/SIZTOT
C
      J=0
      DO1750ISET=1,NUMSET
C
      CI=Y(ISET)
      SIZEI=YN(ISET)
      NSIZEI=SIZEI+0.5
      IF(NSIZEI.LE.0)GOTO1750
C
      TAGI=XIDTEM(ISET)
C
      J=J+1
      Y2(J)=(-1.0)
      IF(SIZEI.NE.0.0)Y2(J)=CI/SIZEI
      X2(J)=TAGI
      D2(J)=1.0
C
      J=J+1
      YMID=CBARG
      Y2(J)=YMID
      X2(J)=TAGI
      D2(J)=2.0
C
      J=J+1
      VARCI=0.0
      IF(ANI.GT.0.0)VARCI=CBARG/SIZEI
      SDCI=0.0
      IF(VARCI.GT.0.0)SDCI=SQRT(VARCI)
      YUPPER=YMID+3.0*SDCI
      Y2(J)=YUPPER
      X2(J)=TAGI
      D2(J)=3.0
C
      J=J+1
      YLOWER=YMID-3.0*SDCI
      IF(YLOWER.LT.0.0)YLOWER=0.0
      Y2(J)=YLOWER
      X2(J)=TAGI
      D2(J)=4.0
C
      IF(CCTARG.EQ.CPUMIN)GOTO1771
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XIDTEM(ISET)
      D2(J)=5.0
 1771 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO1772
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XIDTEM(ISET)
      D2(J)=6.0
 1772 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO1773
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XIDTEM(ISET)
      D2(J)=7.0
 1773 CONTINUE
C
 1750 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ********************************************************
C               **  STEP 5.8--                                        **
C               **  TREAT THE Q C CONTROL CHART CASE (POISSON)         **
C               **  TOTAL NUMBER DEFECTIVE IN A BATCH (SUBSAMPLE)    **
C               **  SUM OF DEFECTIVES IN A BATCH (SUBSAMPLE)         **
C               **  THE INPUT IS USUALLY A SERIES OF INTEGERS        **
C               **  THE VALUE WILL BE A NON-NEGATIVE INTEGER         **
C               **  THE CONFIDENCE BAND IS GOTTEN BY ASSUMING POISSON**
C               **  NOTE--THE C CHART SHOULD BE USED ONLY WHEN
C               **        THE SUBSAMPLE SIZE IS CONSTANT.
C               **        FOR VARYING SUBSAMPLE SIZE, USE THE U CHART
C               **        (ISHIKAWA, GUIDE TO QUALITY CONTROL, PAGE 77)
C               ********************************************************
C
 1800 CONTINUE
C
      ISTEPN='5.8'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QCC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM1=0.0
      SUM2=0.0
      ANUMSE=NUMSET
      DO1810ISET=1,NUMSET
      SUM1=SUM1+Y(ISET)
      IF(NUMV2.LE.2)SUM2=SUM2+1
      IF(NUMV2.GE.3)SUM2=SUM2+YN(ISET)
 1810 CONTINUE
      CTOTAL=SUM1
      CBARG=CTOTAL/ANUMSE
C
      J=0
      DO1850ISET=1,NUMSET
C
      CI=Y(ISET)
      SIZEI=YN(ISET)
      NSIZEI=SIZEI+0.5
      IF(NSIZEI.LE.0)GOTO1850
C
      TAGI=XIDTEM(ISET)
C
      J=J+1
      Y2(J)=CI
      X2(J)=TAGI
      D2(J)=1.0
C
      J=J+1
      YMID=CBARG
      Y2(J)=YMID
      X2(J)=TAGI
      D2(J)=2.0
C
      J=J+1
      VARCI=0.0
      IF(ANI.GT.0.0)VARCI=CBARG
      SDCI=0.0
      IF(VARCI.GT.0.0)SDCI=SQRT(VARCI)
      YUPPER=YMID+3.0*SDCI
      Y2(J)=YUPPER
      X2(J)=TAGI
      D2(J)=3.0
C
      J=J+1
      YLOWER=YMID-3.0*SDCI
      IF(YLOWER.LT.0.0)YLOWER=0.0
      Y2(J)=YLOWER
      X2(J)=TAGI
      D2(J)=4.0
C
      IF(CCTARG.EQ.CPUMIN)GOTO1871
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XIDTEM(ISET)
      D2(J)=5.0
 1871 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO1872
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XIDTEM(ISET)
      D2(J)=6.0
 1872 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO1873
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XIDTEM(ISET)
      D2(J)=7.0
 1873 CONTINUE
C
 1850 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'QCC2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPQCC2--')
      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,ISIZE
 9013 FORMAT('NUMV2,ISIZE = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)AN,XBARG,SDG,RANGEG
 9014 FORMAT('AN,XBARG,SDG,RANGEG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ANUMSE,SIGMAE,RANGEE
 9015 FORMAT('ANUMSE,SIGMAE,RANGEE = ',3E15.7)
      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 DPQUAD(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PREICSION SWITCH
C              AS QUADRUPLE PRECISION.
C              THIS IN TURN SPECIFIES THAT SUBSEQUENT
C              CALCULATIONS WILL ALL BE CARRIED OUT
C              IN QUADRUPLE PRECISION.
C              THE SPECIFIED PRECISION SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IPREC.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFPR (A  HOLLERITH VARIABLE)
C                     --IHMXPR (A  HOLLERITH VARIABLE)
C     OUTPUT ARGUMENTS--IPREC  (A HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPR
      CHARACTER*4 IHMXPR
      CHARACTER*4 IPREC
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1130
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1130
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
      GOTO1130
C
 1120 CONTINUE
      IHOLD=IDEFPR
      GOTO1160
C
 1130 CONTINUE
      IHOLD='QUAD'
      GOTO1160
C
 1160 CONTINUE
      IF(IHOLD.EQ.'DOUB'.AND.IHMXPR.EQ.'SING')GOTO1170
      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'SING')GOTO1170
      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'DOUB')GOTO1170
      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'SING')GOTO1170
      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'DOUB')GOTO1170
      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'TRIP')GOTO1170
      GOTO1180
C
 1170 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('***** ERROR IN DPQUAD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)
 1173 FORMAT('      THE DESIRED PRECISION IS HIGHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)
 1174 FORMAT('      THAN PERMITTED ON THIS COMPUTER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1175)IHOLD
 1175 FORMAT('      DESIRED PRECISION           = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1176)IHMXPR
 1176 FORMAT('      MAXIMUM ALLOWABLE PRECISION = ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1180 CONTINUE
      IPREC=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1188)IPREC
 1188 FORMAT('THE PRECISION SWITCH HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPQUAN(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A QUANTILE PLOT
C              (USEFUL FOR DISTRIBUTIONALLY COMPARING 2 DATA SETS).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/5
C     ORIGINAL VERSION--MAY       1987.
C     UPDATED         --MARCH     1988.   ACTIVATE QUANTILE-QUANTILE
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C                                       MOVE SOME DIMENSIONS FROM DPQUA2
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION Y3(MAXOBV)
      DIMENSION Y4(MAXOBV)
      DIMENSION XD(MAXOBV)
      DIMENSION YD(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      DIMENSION YLARGE(MAXOBV)
      DIMENSION YSMALL(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
      EQUIVALENCE (GARBAG(IGARB4),Y4(1))
      EQUIVALENCE (GARBAG(IGARB5),XD(1))
      EQUIVALENCE (GARBAG(IGARB6),YD(1))
      EQUIVALENCE (GARBAG(IGARB7),YLARGE(1))
      EQUIVALENCE (GARBAG(IGARB8),YSMALL(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
      ISUBN1='DPQU'
      ISUBN2='AN  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'QUAN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPQUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NPLOTV,NPLOTP,NS
   52 FORMAT('NPLOTV,NPLOTP,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IANGLU,IBUGG2,IBUGG3,IBUGQ
   54 FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGQ = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASPL,MAXN
   56 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)MAXNPP
   58 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***********************************
C               **  TREAT THE QUANTILE PLOT CASE **
C               ***********************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'QUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO1111   MARCH 1988
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'QUAN'.AND.
     1   IHARG(2).EQ.'PLOT')GOTO1112
      GOTO9000
C
C1111 CONTINUE
CCCCC ILASTC=1
CCCCC CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
CCCCC GOTO1190
C
 1112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      ICASPL='QUAN'
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  CARRY OUT A GENERAL CHECK FOR THE                 **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'QUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'QUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'QUAN')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ********************************************************
C               **  STEP 14--                                         **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE                **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'QUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPQUAN--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A QUANTILE PLOT, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,IWIDTH)
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ****************************************************************
C               **  STEP 15--                                                  *
C               **  EXAMINE THE VARIABLES--                                    *
C               **  HAS EACH VARIABLE                                          *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISR1, ILISR2,                              *
C               **  IS THE LINE IN THE TABLE                                   *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               **  NOTE THAT     ICOLR1, ICOLR2,                              *
C               **  IS THE DATA COLUMN (1 TO 10+6)                             *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               ****************************************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'QUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPQUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,IWIDTH)
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPQUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,IWIDTH)
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'QUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
      IF(NIRIG2.GT.NIRIG1)NLOCAL=NIRIG2
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPQUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH A QUANTILE PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE VERTICAL AXIS VARIABLE         **
C               **       THE HORIZONTAL AXIS VARIABLE       **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'QUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      DO3310I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3310
      J=J+1
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
 3310 CONTINUE
      NS1=J
C
      J=0
      IMAX=NIRIG2
      IF(NQ.LT.NIRIG2)IMAX=NQ
      DO3320I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3320
      J=J+1
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
 3320 CONTINUE
      NS2=J
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT                **
C               **  AFTER SUBSETTING, EACH OF              **
C               **  THE 2 VARIABLES HAS AT LEAST           **
C               **  2 POINTS (THE MINIMUM NEEDED           **
C               **  TO YIELD A PLOT).                      **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'QUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUN1=0
      IF(NS1.LE.2)ICOUN1=NS1
      IF(NS1.LE.2)GOTO3419
      DO3410I=1,NS1
      IF(Y1(I).LE.-0.0001.OR.Y1(I).GE.0.0001)ICOUN1=ICOUN1+1
 3410 CONTINUE
 3419 CONTINUE
      IF(ICOUN1.LE.MINN2)GOTO3450
C
      ICOUN2=0
      IF(NS2.LE.2)ICOUN2=NS2
      IF(NS2.LE.2)GOTO3429
      DO3420I=1,NS2
      IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUN2=ICOUN2+1
 3420 CONTINUE
 3429 CONTINUE
      IF(ICOUN2.LE.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPQUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED SUBSETTING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH A QUANTILE PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)ICOUN1,ICOUN2
 3459 FORMAT('(ICOUN1, ICOUN2 = ',2I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3460)
 3460 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3461)(IANS(I),I=1,IWIDTH)
 3461 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ****************************************************************
C               **  STEP 41--                                                  *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                      *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.      *
C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .                *
C               **  THIS WILL BE BOTH ONES FOR BOTH CASES                      *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).              *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).              *
C               ****************************************************************
C
      ISTEPN='41'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'QUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS=NS1
      IF(NS2.GT.NS1)NS=NS2
CCCCC JUNE, 1990.  MOVE DIMENSION OF YLARGE, YSMALL FROM DPQUA2
      CALL DPQUA2(Y1,NS1,Y2,NS2,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,
     1YLARGE,YSMALL,
     1IBUGG3,ISUBRO,IERROR)
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'QUAN')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPQUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICASPL,MAXN,NUMVAR
 9014 FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9029
      DO9020I=1,NPLOTP
      WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
 9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9031)ICOUN1,ICOUN2
 9031 FORMAT('ICOUN1,ICOUN2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)IHRI11,IHRI12
 9051 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IHRI21,IHRI22
 9052 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)NS1,NS2,NS
 9053 FORMAT('NS1,NS2,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPQUA2(Y,NY,X,NX,ICASPL,MAXN,
     1Y2,X2,D2,N2,NPLOTV,
     1YLARGE,YSMALL,
     1IBUGG3,ISUBRO,IERROR)
CCCCC JUNE, 1990.  MOVE DIMENSION OF YLARGE, YSMALL TO DPQUA2
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A QUANTILE PLOT
C              (USEFUL FOR DISTRIBUTIONALLY COMPARING 2 DATA SETS).
C     NOTE--THE QUANTILES FOR THE FIRST  ARGUMENT WILL APPEAR VERTICALLY;
C           THE QUANTILES FOR THE SECOND ARGUMENT WILL APPEAR HORIZONTALLY.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/6
C     ORIGINAL VERSION--JUNE      1987.
C     UPDATED         --MARCH     1988.  PUT IN DIAGONAL REFERENCE LINE
C     UPDATED         --JUNE      1990.  MOVE SOME DIMENSIONS TO DPQUAN
C     UPDATED         --APRIL     1992.  N TO NX IN DEBUG STATEMENTS
C     UPDATED         --NOVEMBER  1994.  EQUATE ICASE TO ICASPL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASE
CCCCC ADD FOLLOWING LINE NOVEMBER 1994.
      CHARACTER*4 ICASPL
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
CCCCC MOVE DIMENSION TO DPQUAN (JUNE, 1990)
CCCCC DIMENSION YLARGE(MAXOBV)
CCCCC DIMENSION YSMALL(MAXOBV)
      DIMENSION YLARGE(*)
      DIMENSION YSMALL(*)
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='DPQU'
      ISUBN2='A2  '
C
      IERROR='NO'
C
CCCCC ADD FOLLOWING LINE NOVEMBER 1994.
      ICASE=ICASPL
C
      ANY=NY
      ANX=NX
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'QUA2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPQUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO
   52 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,53)ICASPL,MAXN,N,NPLOTV
CCC53 FORMAT('ICASPL,MAXN,N,NPLOTV = ',A4,2X,I8,I8,I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,MAXN,NX,NPLOTV
   53 FORMAT('ICASPL,MAXN,NX,NPLOTV = ',A4,2X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NY
   60 FORMAT(' NY = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NY.LE.0)GOTO63
      DO61I=1,NY
      WRITE(ICOUT,62)I,Y(I)
   62 FORMAT('I,Y(I) = ',I8,E12.5)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   63 CONTINUE
      WRITE(ICOUT,70)NX
   70 FORMAT(' NX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NX.LE.0)GOTO73
      DO71I=1,NX
      WRITE(ICOUT,72)I,X(I)
   72 FORMAT('I,X(I) = ',I8,E12.5)
      CALL DPWRST('XXX','BUG ')
   71 CONTINUE
   73 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NY.GE.1.AND.NX.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPQUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)NY,NX
 1114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',2I6)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(NY.GE.2.AND.NX.GE.2)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPQUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1130I=1,NY
      IF(Y(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPQUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      HOLD=X(1)
      DO1140I=1,NY
      IF(X(I).NE.HOLD)GOTO1149
 1140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPQUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)HOLD
 1143 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1149 CONTINUE
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  SORT Y AND SORT X                             **
C               ****************************************************
C
      CALL SORT(X,NX,X)
      CALL SORT(Y,NY,Y)
C
C               *****************************************
C               **  STEP 22--                          **
C               **  DETERMINE THE TYPE CASE            **
C               **  EQUAL SAMPLE SIZES OR NOT)         **
C               **  AND BRANCH ACORDINGLY              **
C               *****************************************
C
      ICASE='UNEQ'
      IF(NY.EQ.NX)ICASE='EQUA'
      IF(ICASE.EQ.'EQUA')GOTO5100
C
C               **************************************************
C               **  STEP 23--                                   **
C               **  DETERMINE THE SMALLER OF THE 2--            **
C               **  NY OR NX                                    **
C               **  DETERMINE THE LARGER OF THE 2--             **
C               **  NY OR NX                                    **
C               **************************************************
C
      NSMALL=NX
      IF(NY.LT.NX)NSMALL=NY
      ANSMAL=NSMALL
C
      NLARGE=NX
      IF(NY.GT.NX)NLARGE=NY
      ANLARG=NLARGE
C
C               ****************************************************
C               **  STEP 24--                                     **
C               **  STEP THROUGH THE VARIOUS SORTED VALUES OF     **
C               **  THE SMALLER OF Y OR X.                        **
C               **  COMPUTE A CORRESPONDING PERCENTAGE.           **
C               **  ESTIMATE THIS PERCENT  POINT                  **
C               **  IN THE LARGER OF Y OR X.                      **
C               ****************************************************
C
      DO2400I=1,NSMALL
      AI=I
      PSMALL=(AI-0.5)/ANSMAL
      IF(NY.LE.NX)YSMALL(I)=Y(I)
      IF(NY.GT.NX)YSMALL(I)=X(I)
C
      PLARGE=0.0
      DO2410J=1,NLARGE
      AJ=J
      J2=J
      J2M1=J2-1
      PPRIOR=PLARGE
      PLARGE=(AJ-0.5)/ANLARG
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QUA2')
     1WRITE(ICOUT,777)I,J,J2,J2M1,PSMALL,PLARGE,PPRIOR
  777 FORMAT('I,J,J2,J2M1,PSMALL,PLARGE,PPRIOR = ',4I8,3E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'QUA2')
     1CALL DPWRST('XXX','BUG ')
      IF(PLARGE.LT.PSMALL)GOTO2410
      IF(PLARGE.EQ.PSMALL)GOTO2411
      GOTO2412
C
 2411 CONTINUE
      IF(NY.LE.NX)YLARGE(I)=X(J2)
      IF(NY.GT.NX)YLARGE(I)=Y(J2)
      GOTO2400
C
 2412 CONTINUE
      RATIO=(PSMALL-PPRIOR)/(PLARGE-PPRIOR)
      IF(NY.LE.NX)YLARGE(I)=RATIO*X(J2M1)+(1.0-RATIO)*X(J2)
      IF(NY.GT.NX)YLARGE(I)=RATIO*Y(J2M1)+(1.0-RATIO)*Y(J2)
      GOTO2400
C
 2410 CONTINUE
C
 2400 CONTINUE
C
C               *******************************************
C               **  STEP 51--                            **
C               **  FORM PLOT COORDINATES                **
C               *******************************************
C
 5100 CONTINUE
      IF(ICASE.EQ.'EQUA')GOTO5110
      GOTO5120
C
 5110 CONTINUE
      J=0
      DO5111I=1,NY
      J=J+1
      Y2(J)=Y(J)
      X2(J)=X(J)
      D2(J)=1.0
 5111 CONTINUE
CCCCC N2=J        MARCH 1988
CCCCC NPLOTV=2    MARCH 1988
      GOTO5180
C
 5120 CONTINUE
      J=0
      DO5121I=1,NSMALL
      J=J+1
      IF(NY.LE.NX)Y2(J)=YSMALL(I)
      IF(NY.GT.NX)Y2(J)=YLARGE(I)
      IF(NY.LE.NX)X2(J)=YLARGE(I)
      IF(NY.GT.NX)X2(J)=YSMALL(I)
      D2(J)=1.0
 5121 CONTINUE
CCCCC N2=J        MARCH 1988
CCCCC NPLOTV=2    MARCH 1988
      GOTO5180
C
CCCCC THE FOLLOWING SECTION WAS INSERTED MARCH 1988
 5180 CONTINUE
      AMIN=X(1)
      IF(Y(1).LT.X(1))AMIN=Y(1)
      J=J+1
      Y2(J)=AMIN
      X2(J)=AMIN
      D2(J)=2.0
C
      AMAX=X(NX)
      IF(Y(NY).GT.X(NX))AMAX=Y(NY)
      J=J+1
      Y2(J)=AMAX
      X2(J)=AMAX
      D2(J)=2.0
C
      N2=J
      NPLOTV=3
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPQUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,MAXN,N2,IERROR
 9012 FORMAT('ICASPL,MAXN,N2,IERROR = ',A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASE
 9013 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9031)NLARGE
 9031 FORMAT('NLARGE = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9032I=1,NLARGE
      WRITE(ICOUT,9033)I,YLARGE(I)
 9033 FORMAT('I,YLARGE(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
      WRITE(ICOUT,9041)NSMALL
 9041 FORMAT('NSMALL = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9042I=1,NSMALL
      WRITE(ICOUT,9043)I,YSMALL(I)
 9043 FORMAT('I,YSMALL(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
      WRITE(ICOUT,9051)NY,NX,NSMALL,NLARGE
 9051 FORMAT('NY,NX,NSMALL,NLARGE = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)RATIO
 9052 FORMAT('RATIO = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)AMIN,AMAX
 9053 FORMAT('AMIN,AMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPQUCO(XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE CONFIDENCE LIMITS FOR QUANTILES (MEDIAN IS
C              A SPECIAL CASE).  METHOD BASED ON MARITZ-JARRETT
C              ESTIMATE FOR STANDARD ERROR.
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     REFERENCE--"INTRODUCTION TO ROBUST ESTIMATION AND HYPOTHESIS
C                TESTING", RAND R. WILCOX, ACADEMIC PRESS, 1997.
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/2
C     ORIGINAL VERSION--FEBRUARY  2003.
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
CCCCC CHARACTER*4 IH21
CCCCC CHARACTER*4 IH22
C
      CHARACTER*4 ICASAN
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION W(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),W(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTM'
      ISUBN2='CO  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXV2=1
      MINN2=3
C
      IFOUND='YES'
C
      NLEFT=0
      N2=0
C
      ICASEQ='UNKN'
C
C     *****************************************************
C     **  TREAT THE QUANTILE CONFIDENCE LIMITS CASE      **
C     *****************************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'QUCO')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPQUCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)ICASAN
   57 FORMAT('ICASAN = ',A4)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
C     *******************************************************
C     **  STEP 2--                                         **
C     **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C     *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'QUCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C     ********************************************
C     **  STEP 3--                              **
C     **  CHECK THE VALIDITY OF ARGUMENT 1      **
C     **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C     ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'QUCO')
     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 4--                                        **
C     **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
C     **  (NLEFT) FOR THE RESPONSE VARIABLE IS 2 OR MORE. **
C     ******************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'QUCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPQUCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FROM WHICH QUANTILE CONFIDENCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WERE TO HAVE BEEN CALCULATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,MAX(IWIDTH,80))
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C     *****************************************
C     **  STEP 5--                           **
C     **  CHECK TO SEE THE TYPE CASE--       **
C     **    1) UNQUALIFIED (THAT IS, FULL);  **
C     **    2) SUBSET/EXCEPT; OR             **
C     **    3) FOR.                          **
C     *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ON')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C     *********************************************
C     **  STEP 5--                               **
C     **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C     **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C     **  FORM THIS VARIABLE BY                  **
C     **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C     **  (FULL, SUBSET, OR FOR).                **
C     *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'QUCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,MAX(NLEFT,N2)
      ISUB(I)=1
  515 CONTINUE
      NQ=MAX(NLEFT,N2)
      GOTO550
C
  520 CONTINUE
      NIOLD=MAX(NLEFT,N2)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=MAX(NLEFT,N2)
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPQUCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FROM WHICH QUANTILE CONFIDENCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      ARE TO BE CALCULATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,MAX(IWIDTH,80))
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
  570 CONTINUE
      NS=J
C
C     ******************************************************
C     **  STEP 8--
C     **  PREPARE FOR ENTRANCE INTO DPQUC2--
C     **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C     ******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'QUCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,NS
      W(I)=1.0
 1110 CONTINUE
C
C     ******************************************************
C     **  STEP 9--                                        **
C     **  DETERMINE VALUE OF TRIMMING CONSTANTS (OBTAINED **
C     **  FROM PARAMETER P100)                            **
C     ******************************************************
C
      IF(ICASAN.EQ.'MECI')THEN
        P100=0.50
      ELSE
        IHP='P100'
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        P100=VALUE(ILOCP)
        IF(P100.GE.1.0 .AND. P100.LE.100.0)P100=P100/100.0
      ENDIF
C
      IF(0.0.LE.P100.AND.P100.LE.1.0)GOTO11589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11581)
11581 FORMAT('***** ERROR IN DPQUCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11582)
11582 FORMAT('THE QUANTILE FOR WHICH THE CONFIDENCE INTERVAL IS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11583)
11583 FORMAT('MTO BE COMPUTED MUST BE BETWEEN 0 AND 1, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11584)P100
11584 FORMAT('PARAMETER P100                    = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11586)
11586 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P100:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11587)
11587 FORMAT('      LET P1 = 0.5')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
11589 CONTINUE
C
C               *********************************
C               **  STEP 9--                   **
C               **  FORM THE CONFIDENCE LIMITS **
C               *********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'QUCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'QUCO')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPQUCO, AS WE ARE ABOUT TO CALL DPBWC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,MAXN,NS
 1212 FORMAT('NLEFT,MAXN,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I),W(I)
 1216 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL DPQUC2(Y,W,NS,X,NS2,XTEMP1,XTEMP2,MAXNXT,
     1P100,
     1ICAPSW,ICAPTY,
     1ICASAN,IBUGA3,ISUBRO,IERROR)
C
C     *****************
C     **  STEP 90--  **
C     **  EXIT       **
C     *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'QUCO')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPQUCO--')
      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 ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPQUC2(Y,W,N,X,N2,XTEMP1,XTEMP2,MAXNXT,
     1P100,
     1ICAPSW,ICAPTY,
     1ICASAN,IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE GENERATES QUANTILE CONFIDENCE LIMITS
C              FOR THE DATA IN THE INPUT VECTOR Y.
C              THE MEDIAN IS A SPECIAL CASE.  SPECIFICALLY,
C                   X(0.5) +/- NORPPF(1-ALPHA/2)*QUASE
C              WHERE QUASE IS THE MARITZ-JARRETT ESTIMATE OF
C              THE QUANTILE STANDARD ERROR.
C              METHOD FROM PAGE 87 OF THE RAND WILCOX BOOK
C              "INTRODUCTION TO ROBUST ESTIMATION AND HYPOTHESIS
C              TESTING", ACADEMIC PRESS, 1997.
C              ALSO VIA THE HETTMANSPERGER-SHEATHER INTERPOLATION
C              METHOD (ALSO PAGE 87 OF WILCOX).
C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                OF OBSERVATIONS
C                       N      = THE INTEGER NUMBER OF
C                                OBSERVATIONS IN THE VECTOR Y.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/2
C     ORIGINAL VERSION--FEBRUARY  2003.
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASAN
      CHARACTER*4 IQUASE
      CHARACTER*4 IQUAME
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION W(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION CONF(10)
      DIMENSION T(10)
      DIMENSION TSDM(10)
      DIMENSION ALOWER(10)
      DIMENSION AUPPER(10)
      DIMENSION ALOWE2(10)
      DIMENSION AUPPE2(10)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPQU'
      ISUBN2='C2  '
C
      IQUAME='ORDE'
      IQUASE='MJ'
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'QUC2')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPQUC2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)N,P100,IBUGA3
   52 FORMAT('N,P100,IBUGA3 = ',I8,2X,E15.7,2X,A4)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I),W(I),X(I)
   57 FORMAT('I,Y(I),W(I),X(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,58)ICASAN
   58 FORMAT('ICASAN   = ',A4)
      CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'QUC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GT.3)GOTO119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPQUC2--THE NUMBER OF OBSERVATIONS ',
     1'IN THE RESPONSE VARIABLE IS LESS THAN 3')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,112)N
  112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      HOLD=Y(1)
      DO135I=2,N
      IF(Y(I).NE.HOLD)GOTO139
  135 CONTINUE
  130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,131)HOLD
  131 FORMAT('***** NOTE FROM DPQUC2--THE RESPONSE VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
  139 CONTINUE
C
C               ***************************************************
C               **  STEP 3--                                     **
C               **  COMPUTE THE QUANTILE              ESTIMATE   **
C               **  COMPUTE THE QUANTILE     STANDARD ERROR      **
C               ***************************************************
C
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'QUC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      IF(ICASAN.EQ.'MECI')THEN
        CALL MEDIAN(Y,N,IWRITE,XTEMP1,MAXNXT,XQUANT,IBUGA3,IERROR)
      ELSE
        CALL QUANT(P100,Y,N,IWRITE,XTEMP1,MAXNXT,IQUAME,XQUANT,
     1  IBUGA3,IERROR)
      ENDIF
      CALL QUANSE(P100,Y,N,IWRITE,XTEMP1,MAXNXT,IQUASE,XQUASE,
     1IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 4--                         **
C               **  COMPUTE CONFIDENCE LIMITS        **
C               **  FOR VARIOUS PROBABILITY VALUES.  **
C               ***************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'QUC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CONF(1)=50.0
      CONF(2)=75.0
      CONF(3)=90.0
      CONF(4)=95.0
      CONF(5)=99.0
      CONF(6)=99.9
      CONF(7)=99.99
      CONF(8)=99.999
C
      DO1400I=1,8
        PCONF=CONF(I)/100.0
        CDF=0.5+PCONF/2.0
        CALL NORPPF(CDF,T(I))
        TSDM(I)=T(I)*XQUASE
        ALOWER(I)=XQUANT-TSDM(I)
        AUPPER(I)=XQUANT+TSDM(I)
 1400 CONTINUE
C
C               ***************************************
C               **  STEP 5--                         **
C               **  COMPUTE CONFIDENCE LIMITS        **
C               **  FOR HETTMANSPERGER-SHEATHER      **
C               **  INTERPOLATION METHOD.            **
C               ***************************************
C  
      IF(ICASAN.EQ.'MECI')THEN
        P=0.5
        AN=REAL(N)
        CALL SORT(Y,N,Y)
        DO2010I=1,8
          ALPHA=(100.0-CONF(I))/100.
          CALL BINPPF(ALPHA/2.0,P,N,AK)
          CALL BINCDF(AN-AK,P,N,CDF1)
          CALL BINCDF(AK-1.0,P,N,CDF2)
          GK=CDF1-CDF2
          IF(GK.GE.1.0-ALPHA)THEN
            CALL BINCDF(AN-AK-1.0,P,N,CDF1)
            CALL BINCDF(AK-1.0,P,N,CDF2)
            GKP1=CDF1-CDF2
            AKP=AK+1.0
          ELSE
            AK=AK-1.0
            CALL BINCDF(AN-AK,P,N,CDF1)
            CALL BINCDF(AK-1.0,P,N,CDF2)
            GKP1=CDF1-CDF2
            AKP=AK+1.0
          ENDIF
          ANMK=AN-AK
          ANMKP=ANMK+1.0
          AIVAR=(GK-1.0+ALPHA)/(GK-GKP1)
          ALAMB=((AN-AK)*AIVAR)/(AK+(AN-2.0*AK)*AIVAR)
          ALOWE2(I)=ALAMB*Y(INT(AKP)) + (1.0-ALAMB)*Y(INT(AK))
          AUPPE2(I)=ALAMB*Y(INT(ANMK)) + (1.0-ALAMB)*Y(INT(ANMKP))
 2010   CONTINUE
      ENDIF
C
C               ****************************
C               **  STEP 7--              **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'QUC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
CCCCC OCTOBER 2003: WRITE OUTPUT IN HTML FORMAT
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5004   FORMAT('<BR><BR>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Confidence Limits for Median<BR>')
 5018   FORMAT('      (Based on Maritz-Jarrett Standard Error for ',
     1         'Quantiles)</B>')
 5019   FORMAT('   </CAPTION>')
 5021   FORMAT('      <B>Confidence Limits for Quantile ',
     1         '(Q<sub>0</sub> = ',F6.3,')<BR>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'MECI')THEN
          WRITE(ICOUT,5017)
        ELSE
          WRITE(ICOUT,5021)P100
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5018)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5045   FORMAT('         Number of Observations:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5031   FORMAT('         ',G15.7)
 5033   FORMAT('         ',I8)
 5039   FORMAT('   </TR>')
 5051   FORMAT('         Estimate of Median:')
 5052   FORMAT('         Estimate of Quantile:')
 5053   FORMAT('         Quantile Standard Error:')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5033)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'MECI')THEN
          WRITE(ICOUT,5051)
        ELSE
          WRITE(ICOUT,5052)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)XQUANT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)XQUASE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: START TABLE AND DEFINE A CAPTION
C
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3B: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5127   FORMAT('      </TH>')
 5139   FORMAT('   </TR>')
 5131   FORMAT('         Confidence<BR>Value (%)')
 5132   FORMAT('         Z<BR>Value')
 5133   FORMAT('         Z X Standard Error)')
 5134   FORMAT('         Lower<br>Limit')
 5135   FORMAT('         Upper<br>Limit')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5132)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5135)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5143   FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5147   FORMAT('      </TD>')
 5151   FORMAT('         ',F8.3)
 5152   FORMAT('         ',G12.6)
 5149   FORMAT('   </TR>')
        DO5180I=1,8
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)CONF(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)T(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)TSDM(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)ALOWER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)AUPPER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
 5180   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
 5199   FORMAT('<PRE>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5199)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Confidence Limits for the Median }',2X,A1,A1)
 8013 FORMAT(A1,'end{center}')
 8016 FORMAT(5X,'{',A1,'bf Confidence Limits for Quantile ($Q_0$ = ',
     1       F6.3,'}',2X,A1,A1)
 8017 FORMAT(5X,'{',A1,'bf (Based on the Maritz-Jarrett Standard ',
     1       'Error)}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'MECI')THEN
          WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8016)IBASLC,P100,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8017)IBASLC
        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,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Estimate of the Median: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Estimate of the Quantile: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Quantile Standard Error: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Degrees of Freedom: & ',I8,2X,A1,A1)
 8049 FORMAT(5X,A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'MECI')THEN
          WRITE(ICOUT,8022)XQUANT,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8023)XQUANT,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XQUASE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120 FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121 FORMAT(5X,'{',A1,'bf Confidence} & {',A1,'bf Z } & & ',
     1       '{',A1,'bf Lower } & {',A1,'bf Upper}',2X,A1,A1)
 8122 FORMAT(5X,'{',A1,'bf Value (',A1,'%) } & {',A1,'bf Value} & {',A1,
     1       'bf Z x Standard Error)} & {',A1,'bf Limit} & {',A1,
     1       'bf Limit }',2X,A1,A1)
 8123 FORMAT(5X,2(F8.3,' & '),2(G12.6,' & '),G12.6,2X,A1,A1)
 8130 FORMAT(5X,A1,'hline')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                   IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8130)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8160I=1,8
          WRITE(ICOUT,8123)CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I),
     1                     IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8160   CONTINUE
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8199 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8199)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C PLACEHOLDER FOR RTF FORMAT OUTPUT
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'MECI')THEN
          WRITE(ICOUT,810)
  810     FORMAT(
     1'                   CONFIDENCE LIMITS FOR MEDIAN')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,811)P100
  811     FORMAT(
     1'                   CONFIDENCE LIMITS FOR QUANTILE (Q0 = ',
     1F6.3,')')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,812)
  812   FORMAT(
     1'                   (BASED ON MARITZ-JARRETT STANDARD ERROR ',
     1'FOR QUANTILES)')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,815)N
  815   FORMAT(
     1'          NUMBER OF OBSERVATIONS     = ',I8)
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'MECI')THEN
          WRITE(ICOUT,821)XQUANT
  821     FORMAT(
     1'          ESTIMATE OF MEDIAN             = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,822)XQUANT
  822     FORMAT(
     1'          ESTIMATE OF QUANTILE           = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,823)XQUASE
  823   FORMAT(
     1'          QUANTILE     STANDARD ERROR    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,832)
  832   FORMAT(
     1'   CONFIDENCE   Z     Z X STDERR       LOWER         UPPER     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,833)
  833   FORMAT(
     1'   VALUE (%)  VALUE                    LIMIT         LIMIT     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,834)
  834   FORMAT(
     1'---------------------------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO840I=1,8
          WRITE(ICOUT,841)CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I)
  841     FORMAT(
     1'   ',F8.3,F8.3,2X,G12.6,2X,G12.6,2X,G12.6)
          CALL DPWRST('XXX','WRIT')
  840   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
C
      IF(ICASAN.NE.'MECI')GOTO9000
      IF(IPRINT.EQ.'ON')THEN
CCCCC OCTOBER 2003: WRITE OUTPUT IN HTML FORMAT
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5501   FORMAT('</PRE>')
 5504   FORMAT('<BR><BR>')
        WRITE(ICOUT,5501)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5504)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5561   FORMAT('<UL>')
 5563   FORMAT('<TABLE NOBORDER>')
 5565   FORMAT('   <CAPTION ALIGN=CENTER>')
 5567   FORMAT('      <B>Confidence Limits for the Median<BR>')
 5568   FORMAT('      (Based on Hettmansperger-Sheather)</B>')
 5569   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5561)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5563)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5565)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5567)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5568)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5569)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE DATA ROW
C
 5541   FORMAT('   <TR>')
 5543   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
 5545   FORMAT('         Number of Observations:')
 5547   FORMAT('      </TD>')
 5549   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5531   FORMAT('         ',G15.7)
 5533   FORMAT('         ',I8)
 5539   FORMAT('   </TR>')
 5556   FORMAT('         Estimate of Median:')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5545)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5533)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5539)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5531)XQUANT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5539)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5591   FORMAT('</TABLE>')
 5593   FORMAT('</UL>')
 5599   FORMAT('<PRE>')
        WRITE(ICOUT,5591)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5593)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: START TABLE AND DEFINE A CAPTION
C
        WRITE(ICOUT,5504)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5561)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5563)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3B: DEFINE HEADER ROW
C
 5621   FORMAT('   <TR>')
 5623   FORMAT('      <TH ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5627   FORMAT('      </TH>')
 5639   FORMAT('   </TR>')
 5631   FORMAT('         Confidence<BR>Value (%)')
 5634   FORMAT('         Lower<br>Limit')
 5635   FORMAT('         Upper<br>Limit')
 5661   FORMAT('      <TD COLSPAN=3>')
 5662   FORMAT('          <HR>')
        WRITE(ICOUT,5621)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5631)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5634)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5635)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5639)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5661)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5662)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5539)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5641   FORMAT('   <TR>')
 5643   FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5647   FORMAT('      </TD>')
 5651   FORMAT('         ',F8.3)
 5652   FORMAT('         ',G12.6)
 5649   FORMAT('   </TR>')
        DO5680I=1,8
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)CONF(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5652)ALOWE2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5652)AUPPE2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
 5680   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5691   FORMAT('</TABLE>')
 5693   FORMAT('</UL>')
 5699   FORMAT('<PRE>')
        WRITE(ICOUT,5691)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5693)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5699)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8501 FORMAT(A1,'end{verbatim}')
 8503 FORMAT(A1,'begin{table}')
 8507 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8509 FORMAT(A1,'begin{center}')
 8511 FORMAT(5X,'{',A1,'bf Confidence Limits for the Median }',
     1       2X,A1,A1)
 8517 FORMAT(5X,'{',A1,'bf (Based on Hettmansperger-Sheather)}')
 8513 FORMAT(A1,'end{center}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8501)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8503)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8509)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8511)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8517)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8507)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8507)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8513)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8520 FORMAT(5X,A1,'begin{tabular} {lr}')
 8521 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8522 FORMAT(5X,'Estimate of the Median: & ',G15.7,2X,A1,A1)
 8549 FORMAT(5X,A1,'end{tabular}')
        WRITE(ICOUT,8509)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8520)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8521)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8522)XQUANT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8549)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8591 FORMAT(A1,'end{table}')
 8593 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8593)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8620 FORMAT(5X,A1,'begin{tabular} {ccc}')
 8621 FORMAT(5X,'{',A1,'bf Confidence} & {',A1,'bf Lower} & {',A1,
     1       'bf Upper}',2X,A1,A1)
 8622 FORMAT(5X,'{',A1,'bf Value (',A1,'%)} &  {',A1,
     1       'bf Limit} & {',A1,'bf Limit}',2X,A1,A1)
 8623 FORMAT(5X,F8.3,' & ',G12.6,' & ',G12.6,2X,A1,A1)
 8630 FORMAT(5X,A1,'hline')
        WRITE(ICOUT,8509)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8620)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8621)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8622)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8630)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8660I=1,8
          WRITE(ICOUT,8623)CONF(I),ALOWE2(I),AUPPE2(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8660   CONTINUE
        WRITE(ICOUT,8549)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8699 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8593)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8591)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8699)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C PLACEHOLDER FOR RTF FORMAT OUTPUT
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,910)
  910   FORMAT(
     1'                   CONFIDENCE LIMITS FOR MEDIAN')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,912)
  912   FORMAT(
     1  '                   (BASED ON HETTMANSPERGER-SHEATHER ',
     1  ' INTERPOLATION)')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,915)N
  915   FORMAT(
     1  '          NUMBER OF OBSERVATIONS     = ',I9)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,921)XQUANT
  921   FORMAT(
     1  '          ESTIMATE OF MEDIAN             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,932)
  932   FORMAT(
     1'   CONFIDENCE   LOWER         UPPER     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,933)
  933   FORMAT(
     1'   VALUE (%)    LIMIT         LIMIT     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,934)
  934   FORMAT(
     1'---------------------------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO940I=1,8
          WRITE(ICOUT,941)CONF(I),ALOWE2(I),AUPPE2(I)
  941       FORMAT(
     1'   ',F9.3,2X,G12.6,2X,G12.6)
          CALL DPWRST('XXX','WRIT')
  940     CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'QUC2')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPQUC2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),W(I)
 9017 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPQUER(IANSLC,IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--ENTER A QUERY AT THE END OF THE DATAPLOT QUERY FILE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --JANUARY   1989.  GENERALIZE APPEND OPERATION (ALAN)
C     UPDATED         --APRIL     1989.  FIX ILLEGAL TRANSFER TO END OF LOOP
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANSLC
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IANSI
      CHARACTER*80 ICANS
      CHARACTER*80 ICQUER
      CHARACTER*1 ICJUNK
C  AUGUST,1987 BUG FIX: SOME MACHINES DO NOT ALLOW FILES TO BE
C  APPENDED TO (CAN NOT READ AND WRITE TO THE SAME FILE).  IN
C  PARTICULAR, THE UNIVAC 1100/80'S AND CYBER MACHINES.
C  SOLUTION IS TO STORE THE QUERY, CLOSE AND RE-OPEN THE FILE
C  AND WRITE OUT THE STORED LINES.
      PARAMETER (MAXQRY=100)
      CHARACTER*80 ICJNK2(MAXQRY)
C  END FIX
C
      DIMENSION IANSLC(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPQU'
      ISUBN2='ER  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'QUER')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPQUER--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IWIDTH
   54 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,55)(IANSLC(I),I=1,IWIDTH)
   55 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IQUENU
   61 FORMAT('IQUENU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IQUENA
   62 FORMAT('IQUENA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IQUEST
   63 FORMAT('IQUEST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IQUEFO
   64 FORMAT('IQUEFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IQUEAC
   65 FORMAT('IQUEAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)IQUEFO
   66 FORMAT('IQUEFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)IQUECS
   67 FORMAT('IQUECS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=IQUENU
      IFILE=IQUENA
      ISTAT=IQUEST
      IFORM=IQUEFO
      IACCES=IQUEAC
      IPROT=IQUEPR
      ICURST=IQUECS
C
      ISUBN0='QUER'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'QUER')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               ********************************************
C               **  STEP 12--                             **
C               **  CHECK TO SEE IF QUERY FILE EXISTS     **
C               ********************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPQUER--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE ENTERED QUERY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE RECORDED BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES SUCH QUERIES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,IQUEST
 1217 FORMAT('ISTAT,IQUEST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               ****************************
C               **  STEP 13--             **
C               **  EXTRACT THE QUERY     **
C               ****************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1310I=1,80
      IANSI=IANSLC(I)
      ICANS(I:I)=IANSI(1:1)
 1310 CONTINUE
C
      ISTART=1
      ISTOP=IWIDTH
      IWORD=2
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ICQUER,NCQUER,
     1IBUGS2,ISUBRO,IERROR)
C
      IF(NCQUER.GE.1)GOTO1329
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('***** ERROR IN DPQUER--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1322)
 1322 FORMAT('      A MESSAGE IS REQUIRED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1323)
 1323 FORMAT('      IN THE QUERY COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1324)
 1324 FORMAT('      (FOR EXAMPLE,    QUERY WHAT IS DEFAULT COLOR?)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('      BUT NO MESSAGE WAS GIVEN HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)
 1326 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1327)(IANSLC(I),I=1,IWIDTH)
 1327 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,999)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1329 CONTINUE
C
      J=0
      IF(ICOL1.GT.IWIDTH)GOTO1339
      DO1330I=ICOL1,IWIDTH
      J=J+1
      ICQUER(J:J)=ICANS(I:I)
 1330 CONTINUE
      NCQUER=J
 1339 CONTINUE
C
      CALL DPDB80(ICQUER,JMAX,IBUGS2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      NCQUER=JMAX
C
      IF(NCQUER.GE.1)GOTO1349
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1341)
 1341 FORMAT('***** ERROR IN DPQUER--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1342)
 1342 FORMAT('      A MESSAGE IS REQUIRED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1343)
 1343 FORMAT('      IN THE QUERY COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1344)
 1344 FORMAT('      (FOR EXAMPLE,    QUERY HOW DO I GENERATE ',
     1'3-D PLOTS?)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1345)
 1345 FORMAT('      BUT NONE WAS GIVEN HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1346)
 1346 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1347)(IANSLC(I),I=1,IWIDTH)
 1347 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,999)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1349 CONTINUE
C
 1390 CONTINUE
C
C               *********************
C               **  STEP 31--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               **********************************************
C               **  STEP 41--                               **
C               **  READ THE FILE.                          **
C               **  FIND THE LAST LINE OF THE FILE.         **
C               **********************************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLIN=0
      DO4120I=1,100000
      I2=I
      READ(IOUNIT,4121,END=4129)ICJUNK
 4121 FORMAT(A1)
 4120 CONTINUE
 4129 CONTINUE
      NUMLIN=I2-1
      IF(NUMLIN.LE.0)NUMLIN=0
 4190 CONTINUE
C  BUG FIX
      NUMSKP=0
      IF(NUMLIN.LE.MAXQRY)GOTO4195
      NUMSKP=NUMLIN-MAXQRY
 4195 CONTINUE
C  END FIX
C
C               ************************
C               **  STEP 42--         **
C               **  REWIND THE FILE.  **
C               ************************
C
      ISTEPN='42'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      REWIND IOUNIT
C
C               **********************************************
C               **  STEP 43--                               **
C               **  READ THE FILE                           **
C               **  DOWN TO THE LAST LINE OF THE FILE.      **
C               **********************************************
C
      ISTEPN='43'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMLIN.LE.0)GOTO4390
C  BUG FIX
CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1989
CCCCC IF(NUMSKP.LT.1)GOTO4310
      IF(NUMSKP.LT.1)GOTO4311
      DO4310I=1,NUMSKP
      READ(IOUNIT,4321,END=4390)ICJUNK
 4300 CONTINUE
 4310 CONTINUE
CCCCC THE FOLLOWING LINE WAS INSERTED APRIL 1989
 4311 CONTINUE
      DO4315I=NUMSKP+1,NUMLIN
      READ(IOUNIT,4316,END=4390)ICJNK2(I)
 4315 CONTINUE
 4316 FORMAT(A80)
CCCCC DO4320I=1,NUMLIN
CCCCC READ(IOUNIT,4321,END=4390)ICJUNK
 4321 FORMAT(A1)
C4320 CONTINUE
C  END FIX
 4390 CONTINUE
C  BUG FIX: CLOSE THE FILE, OPEN IT AND WRITE OUT STORED LINES
C
C               ***********************
C               **  STEP 431--       **
C               **  CLOSE THE FILE.  **
C               ***********************
C
      ISTEPN='431'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='ON'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C               *********************
C               **  STEP 432-      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='432'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
      NTEMP=NUMLIN-NUMSKP
      DO4350I=1,NTEMP
      WRITE(IOUNIT,4351)ICJNK2(I)
 4350 CONTINUE
 4351 FORMAT(A80)
C  END FIX
C
C
C               **********************************************
C               **  STEP 44--                               **
C               **  WRITE TO THE FILE.                      **
C               **  APPEND THE QUERY TO THE FILE.           **
C               **********************************************
C
      ISTEPN='44'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(IOUNIT,4421)(ICQUER(J:J),J=1,NCQUER)
 4421 FORMAT(80A1)
C
C               ***********************
C               **  STEP 51--        **
C               **  CLOSE THE FILE.  **
C               ***********************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'QUER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='ON'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'QUER')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPQUER--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IENDFI
 9028 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9041)IQUERY
C9041 FORMAT('IQUERY = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRAND(ICASRA,ISEED,ILOCNU,
     1IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--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    MAY 1990
C              26) WALD    MAY 1990
C              27) RECIPROCAL INVERSE GAUSSIAN    MAY 1990
C              28) FATIGUE LIFE    MAY 1990
C              29) GENERALIZED PARETO      DECEMBER   1993
C              30) POWER FUNCTION          APRIL      1995
C              31) HYPERGEOMETRIC          AUGUST     1995
C              32) NON-CENTRAL CHI-SQUARE  AUGUST     1995
C              33) NON-CENTRAL F           AUGUST     1995
C              34) DOUBLY NON-CENTRAL F    AUGUST     1995
C              35) FOLDED NORMAL           OCTOBER    1995
C              36) HALF-CAUCHY             OCTOBER    1995
C              37) NORMAL MIXTURE          MAY        1998
C              38) POWER LAW               JUNE       1998
C              39) GENERALIZED TUKEY-LAMBDA AUGUST    2001
C              40) INVERTED WEIBULL        SEPTEMBER  2001
C              41) DOUBLE WEIBULL          OCTOBER    2001
C              42) DOUBLE GAMMA            OCTOBER    2001
C              43) LOG    GAMMA            OCTOBER    2001
C              44) INVERTED GAMMA          OCTOBER    2001
C              45) COSINE                  OCTOBER    2001
C              46) ANGLIT                  OCTOBER    2001
C              47) HYPERBOLIC SECANT       OCTOBER    2001
C              48) ARCSIN                  OCTOBER    2001
C              49) LOG DOUBLE EXPONENTIAL  OCTOBER    2001
C              50) GENERALIZED EXTREM VALU OCTOBER    2001
C              51) EXPONENTIATED WEIBULL   OCTOBER    2001
C              52) GOMPERTZ                OCTOBER    2001
C              53) HALF-LOGISTIC           OCTOBER    2001
C              54) POWER EXPONENTIAL       OCTOBER    2001
C              55) ALPHA                   OCTOBER    2001
C              56) BRADFORD                OCTOBER    2001
C              57) RECIPROCAL              OCTOBER    2001
C              58) JOHNSON SB              OCTOBER    2001
C              59) JOHNSON SU              OCTOBER    2001
C              60) POWER NORMAL            OCTOBER    2001
C              61) LOG-LOGISTIC            OCTOBER    2001
C              62) GEOMETRIC EXTR EXPO     NOVEMBER   2001
C              63) POWER LOGNORMAL         NOVEMBER   2001
C              64) BETA-BINOMIAL           DECEMBER   2001
C              65) TWO-SIDED POWER         MAY        2002
C              66) BIWEIBULL               MAY        2002
C              66) LOGARITHMIC SERIES      AUGUST     2002
C              67) G-AND-H                 JANUARY    2003
C              68) SLASH                   JANUARY    2003
C              69) LANDAU                  APRIL      2003
C              70) INVERTED BETA           MAY        2003
C              71) ERROR (=SUBBOTIN        MAY        2003
C                         =EXPONENTIAL POWER
C                         =GENERAL ERROR)
C              72) TRAPEZOID               JUNE       2003
C              73) VON MISES               JUNE       2003
C              74) PARETO SECOND KIND      JUNE       2003
C              75) WRAPPED CAUCHY          JUNE       2003
C              76) GENERALIZED TRAPEZOID   JUNE       2003
C              77) TRUNCATED NORMAL        JULY       2003
C              78) CHI                     JULY       2003
C              79) FOLDED CAUCHY           JULY       2003
C              80) MIELKE'S BETA-KAPPA     JULY       2003
C              81) GENERALIZED EXPONENTIAL JULY       2003
C              82) TRUNCATED   EXPONENTIAL JULY       2003
C              83) GENERALIZED GAMMA       SEPTEMBER  2003
C              84) FOLDED T                NOVEMBER   2003
C              85) SKEWED NORMAL           NOVEMBER   2003
C              86) SKEWED T                NOVEMBER   2003
C              87) ZIPF                    NOVEMBER   2003
C              88) GOMPERTZ-MAKEHAM        DECEMBER   2003
C              89) GENERALIZED INVERSE GAUSSIAN   DECEMBER   2003
C                  (NOT ACTIVATED YET)
C              90) LOG SKEWED NORMAL       MARCH      2004
C              91) LOG SKEWED T            MARCH      2004
C              92) NON-CENTRAL T           MARCH      2004
C              93) DOUBLY NON-CENTRAL T    MARCH      2004
C              94) GENERALIZED HALF-LOGISTIC  MARCH   2004
C              95) GENERALIZED LOGISTIC    MARCH      2004
C              96) POLYA                   MARCH      2004
C              97) HERMITE                 APRIL      2004
C              98) YULE                    APRIL      2004
C              99) WARING                  APRIL      2004
C             100) GENERALIZED WARING      APRIL      2004
C             101) NON-CENTRAL BETA        MAY        2004
C             102) DOUBLY NON-CENTRAL BETA MAY        2004
C             103) SKEW DOUBLE EXPONENTIAL JUNE       2004
C             104) ASYMMETRIC DOUBLE EXPONENTIAL   JUNE  2004
C             105) MAXWELL                 JUNE       2004
C             106) RAYLEIGH                JUNE       2004
C             107) MCLEISH                 AUGUST     2004
C             108) BESSEL I-FUNCTION       AUGUST     2004
C             109) BESSEL K-FUNCTION       AUGUST     2004 (NOT WORK)
C             110) GENERALIZED MCLEISH     SEPTEMBER  2004
C             111) HYPERBOLIC              SEPTEMBER  2004 (NOT WORK)
C             112) GENERALIZED LOGISTIC TYPE 5   FEBRUARY  2006
C             113) WAKEBY                  FEBRUARY  2006
C             114) BETA NORMAL             MARCH     2006
C             115) GENERALIZED LOGISTIC TYPE 2 MARCH 2006
C             116) GENERALIZED LOGISTIC TYPE 3 MARCH 2006
C             117) GENERALIZED LOGISTIC TYPE 4 MARCH 2006
C             118) ASYMMETRIC LOG DOUBLE EXPONENTIAL  MARCH  2006
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 BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --JUNE      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1988. DISCRETE UNIFORM
C     UPDATED         --DECEMBER  1988. BOOTSTRAP INDEX
C     UPDATED         --DECEMBER  1988. RANDOM PERMUTATION
C     UPDATED         --JANUARY   1989. JACKNIFE INDEX
C     UPDATED         --MAY       1993. MINMAX FOR EV1/EV2/WEIB DIST.
C     UPDATED         --OCTOBER   1993. JACKNIFE INDEX TO DPMATC
C     UPDATED         --DECEMBER  1993. GENERALIZED PARETO
C     UPDATED         --MARCH     1994. DPCOS2.INC
C     UPDATED         --APRIL     1995. POWER FUNCTION
C     UPDATED         --AUGUST    1995. HYPERGEOMETRIC, NON-CENTRAL
C                                       CHI-SQUARE, SINGLY AND DOUBLY
C                                       NON-CENTRAL F
C     UPDATED         --MAY       1998. NORMAL MIXTURE
C     UPDATED         --JUNE      1998. POWER LAW
C     UPDATED         --AUGUST    2001. GENERALIZED LAMBDA
C     UPDATED         --SEPTEMBER 2001. INVERTED WEIBULL
C     UPDATED         --OCTOBER   2001. DOUBLE WEIBULL
C     UPDATED         --OCTOBER   2001. DOUBLE GAMMA
C     UPDATED         --OCTOBER   2001. LOG GAMMA
C     UPDATED         --OCTOBER   2001. INVERTED GAMMA
C     UPDATED         --OCTOBER   2001. COSINE
C     UPDATED         --OCTOBER   2001. ANGLIT
C     UPDATED         --OCTOBER   2001. HYPERBOLIC SECANT
C     UPDATED         --OCTOBER   2001. ARCSIN
C     UPDATED         --OCTOBER   2001. LOG DOUBLE EXPONENTIAL
C     UPDATED         --OCTOBER   2001. GENERALIZED EXTREME VALUE
C     UPDATED         --OCTOBER   2001. EXPONENTIATED WEIBULL
C     UPDATED         --OCTOBER   2001. GOMPERTZ
C     UPDATED         --OCTOBER   2001. HALF-LOGISTIC
C     UPDATED         --OCTOBER   2001. POWER EXPONENTIAL
C     UPDATED         --OCTOBER   2001. ALPHA
C     UPDATED         --OCTOBER   2001. BRADFORD
C     UPDATED         --OCTOBER   2001. RECIPROCAL
C     UPDATED         --OCTOBER   2001. JOHNSON SU
C     UPDATED         --OCTOBER   2001. JOHNSON SB
C     UPDATED         --OCTOBER   2001. POWER NORMAL
C     UPDATED         --OCTOBER   2001. LOG-LOGISTIC
C     UPDATED         --NOVEMBER  2001. GEOMETRIC EXTREME EXPO
C     UPDATED         --NOVEMBER  2001. POWER LOGNORMAL
C     UPDATED         --DECEMBER  2001. BETA-BINOMIAL
C     UPDATED         --MAY       2002. TWO-SIDED POWER
C     UPDATED         --MAY       2002. BIWEIBULL
C     UPDATED         --AUGUST    2002. LOGARITHMIC SERIES
C     UPDATED         --JANUARY   2003. G-AND-H, SLASH
C     UPDATED         --APRIL     2003. ADD SHAPE PARAMETER FOR
C                                       LOGNORMAL
C     UPDATED         --APRIL     2003. LANDAU
C     UPDATED         --MAY       2003. INVERTED BETA
C     UPDATED         --MAY       2003. ERROR (=SUBBOTIN=EXPOENTIAL
C                                       POWER=GENERAL ERROR)
C     UPDATED         --JUNE      2003. TRAPEZOID, VON MISES,
C                                       PARETO SECOND KIND,
C                                       WRAPPED CAUCHY,
C                                       GENERALIZED TRAPEZOID
C     UPDATED         --JULY      2003. CHI, TRUNCATED NORMAL,
C                                       FOLDED CAUCHY,
C                                       MIELKE'S BETA-KAPPA,
C                                       GENERALIZED EXPONENTIAL,
C                                       TRUNCATED EXPONENTIAL
C     UPDATED         --SEPTEMBER 2003. GENERALIZED GAMMA
C     UPDATED         --NOVEMBER  2003. FOLDED T
C     UPDATED         --NOVEMBER  2003. SKEWED NORMAL
C     UPDATED         --NOVEMBER  2003. SKEWED T
C     UPDATED         --NOVEMBER  2003. ZIPF
C     UPDATED         --DECEMBER  2003. GOMPERTZ-MAKEHAM
C     UPDATED         --DECEMBER  2003. GENERALIZED INVERSE GAUSSIAN
C                                       (NOT IMPLEMENTED YET)
C     UPDATED         --MARCH     2004. LOG SKEWED NORMAL
C     UPDATED         --MARCH     2004. LOG SKEWED T
C     UPDATED         --MARCH     2004. ALTERNATE DEFINITION OF
C                                       GEOMETRIC
C     UPDATED         --MARCH     2004. NON-CENTRAL T
C     UPDATED         --MARCH     2004. DOUBLY NON-CENTRAL T
C     UPDATED         --MARCH     2004. GENERALIZED HALF-LOGISTIC
C     UPDATED         --MARCH     2004. GENERALIZED LOGISTIC
C     UPDATED         --MARCH     2004. POLYA
C     UPDATED         --APRIL     2004. HERMITE
C     UPDATED         --APRIL     2004. YULE
C     UPDATED         --APRIL     2004. WARING
C     UPDATED         --APRIL     2004. GENERALIZED WARING
C     UPDATED         --MAY       2004. NON-CENTRAL BETA
C     UPDATED         --MAY       2004. DOUBLY NON-CENTRAL BETA
C     UPDATED         --MAY       2004. REAL VALUES FOR CHI-SQUARE
C                                       RANDOM NUMBERS
C     UPDATED         --MAY       2004. NON-CENTRAL CHI-SQUARE AS
C                                       SEPARATE SUBROUTINE
C     UPDATED         --JUNE      2004. SKEW DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. ASYMMETRIC DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. ARGUMENT LIST TO GEPRAN
C     UPDATED         --JUNE      2004. MAXWELL, RAYLEIGH
C     UPDATED         --JULY      2004. ALTERNATE DEFINITIION FOR
C                                       GOMPERTZ-MAKEHAM
C     UPDATED         --OCTOBER   2004. FOR PARETO, TREAT A AS A
C                                       SHAPE PARAMETER
C     UPDATED         --JULY      2005. CALL LIST TO LGARAN AND SNRAN
C     UPDATED         --FEBRUARY  2006. GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006. WAKEBY
C     UPDATED         --FEBRUARY  2006. ARGUMENT LIST TO GLDRAN
C     UPDATED         --MARCH     2006. BETA-NORMAL
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 2
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 3
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 4
C     UPDATED         --MARCH     2006. ASYMMETRIC DOUBLE EXPONENTIAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASRA
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IWRITE
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHWUSE
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*26 IDIST
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
CCCCC THE FOLLOWING LINE WAS ADDED (FOR MINMAX)   MAY 1993
      INCLUDE 'DPCOSU.INC'
CCCCC THE FOLLOWING LINE WAS ADDED (FOR MINMAX)   MARCH 1994
      INCLUDE 'DPCOS2.INC'
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION XTEMP(1)
CCCCC MARCH 2004.  ADD FOLLOWING LINE
      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-----DATA STATEMENTS-------------------------------------------------
C
      DATA EPS/0.000001/
      DATA ALAMLG/0.00001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPRA'
      ISUBN2='N   '
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
      IFOUND='YES'
C
      NS2=0
C
C               ***********************************************
C               **  TREAT THE RANDOM NUMBER GENERATION CASE  **
C               **       1) FOR A FULL VARIABLE, OR          **
C               **       2) FOR PART OF A VARIABLE.          **
C               ***********************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGQ
   52 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASRA,ISEED,ILOCNU
   53 FORMAT('ICASRA,ISEED,ILOCNU = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1993
      WRITE(ICOUT,61)MINMAX
   61 FORMAT('MINMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
      NEWCOL='NO'
C
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=3
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 3--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN        *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  NOTE THAT     ILEFT      IS THE NAME OF THE VARIABLE       *
C               **  ON THE LEFT.                                               *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               **  NOTE THAT     ICOLL    IS THE DATA COLUMN (1 TO 12)        *
C               **  FOR THE NAME OF THE LEFT.                                  *
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC ILEFT=IHOL(2)
CCCCC ILEFT2=IHOL2(2)
      ILEFT=IHARG(1)
      ILEFT2=IHARG2(1)
      DO310I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO329
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO380
  310 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO320
      GOTO330
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)MAXNAM
  323 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  329 CONTINUE
      ILISTL=I2
      GOTO330
C
  330 CONTINUE
      NLEFT=0
      ICOLL=NUMCOL+1
      IF(ICOLL.GT.MAXCOL)GOTO340
      GOTO390
C
  340 CONTINUE
      WRITE(ICOUT,341)
  341 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,342)
  342 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,343)MAXCOL
  343 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,344)
  344 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,345)
  345 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,346)
  346 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,347)
  347 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,348)
  348 FORMAT('      IF       LET X(I) = 3.14         FAILED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,349)
  349 FORMAT('      THEN ONE MIGHT ENTER     NAME X 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,350)
  350 FORMAT('      (THEREBY EQUATING THE NAME X WITH COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,351)
  351 FORMAT('      FOLLOWED BY              LET X = 3.14')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,352)
  352 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,353)
  353 FORMAT('      WITH THE NUMERIC CONSTANTS 3.14)')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  380 CONTINUE
      ILISTL=I2
      ICOLL=IVALUE(ILISTL)
      NLEFT=IN(ILISTL)
C
  390 CONTINUE
C
C               *******************************************************
C               **  STEP 4--                                         **
C               **  CHECK THAT THE INPUT CASE (ICASRA)               **
C               **  IS ONE OF THE ALLOWABLE 100+ DISTRIBUTIONS       **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASRA.EQ.'UNIF')GOTO490
      IF(ICASRA.EQ.'NORM')GOTO490
      IF(ICASRA.EQ.'LOGI')GOTO490
      IF(ICASRA.EQ.'DOUB')GOTO490
      IF(ICASRA.EQ.'CAUC')GOTO490
      IF(ICASRA.EQ.'LAMB')GOTO490
      IF(ICASRA.EQ.'LOGN')GOTO490
      IF(ICASRA.EQ.'HALF')GOTO490
      IF(ICASRA.EQ.'T')GOTO490
      IF(ICASRA.EQ.'CHIS')GOTO490
      IF(ICASRA.EQ.'F')GOTO490
      IF(ICASRA.EQ.'EXPO')GOTO490
      IF(ICASRA.EQ.'GAMM')GOTO490
      IF(ICASRA.EQ.'BETA')GOTO490
      IF(ICASRA.EQ.'WEIB')GOTO490
      IF(ICASRA.EQ.'EXV1')GOTO490
      IF(ICASRA.EQ.'EXV2')GOTO490
      IF(ICASRA.EQ.'PARE')GOTO490
      IF(ICASRA.EQ.'BINO')GOTO490
      IF(ICASRA.EQ.'GEOM')GOTO490
      IF(ICASRA.EQ.'POIS')GOTO490
      IF(ICASRA.EQ.'NEGB')GOTO490
      IF(ICASRA.EQ.'SEMI')GOTO490
      IF(ICASRA.EQ.'TRIA')GOTO490
      IF(ICASRA.EQ.'DIUN')GOTO490
      IF(ICASRA.EQ.'BOOT')GOTO490
      IF(ICASRA.EQ.'PERM')GOTO490
CCCCC OCTOBER 1993.  JACKNIFE INDEX IN DPMATC
CCCCC IF(ICASRA.EQ.'JACK')GOTO490
      IF(ICASRA.EQ.'IG')GOTO490
      IF(ICASRA.EQ.'WALD')GOTO490
      IF(ICASRA.EQ.'RIG')GOTO490
      IF(ICASRA.EQ.'FL')GOTO490
CCCCC THE FOLLOWING LINE WAS ADDED     DECEMBER 1993
      IF(ICASRA.EQ.'GEP')GOTO490
CCCCC THE FOLLOWING LINE WAS ADDED     APRIL 1995
      IF(ICASRA.EQ.'POWF')GOTO490
CCCCC THE FOLLOWING 4 LINES WERE ADDED AUGUST 1995
      IF(ICASRA.EQ.'HYPE')GOTO490
      IF(ICASRA.EQ.'NCCS')GOTO490
      IF(ICASRA.EQ.'NCF ')GOTO490
      IF(ICASRA.EQ.'DNCF')GOTO490
CCCCC THE FOLLOWING 2 LINES WERE ADDED OCTOBER 1995
      IF(ICASRA.EQ.'FNRM')GOTO490
      IF(ICASRA.EQ.'HFCA')GOTO490
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1998
      IF(ICASRA.EQ.'NMRM')GOTO490
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1998
      IF(ICASRA.EQ.'POWL')GOTO490
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 2001
      IF(ICASRA.EQ.'GLAM')GOTO490
CCCCC THE FOLLOWING LINE WAS ADDED SEPTEMBER 2001
      IF(ICASRA.EQ.'IWEI')GOTO490
CCCCC THE FOLLOWING 10 LINES WERE ADDED OCTOBER 2001
      IF(ICASRA.EQ.'DWEI')GOTO490
      IF(ICASRA.EQ.'DGAM')GOTO490
      IF(ICASRA.EQ.'LGAM')GOTO490
      IF(ICASRA.EQ.'IGAM')GOTO490
      IF(ICASRA.EQ.'COSI')GOTO490
      IF(ICASRA.EQ.'ANGL')GOTO490
      IF(ICASRA.EQ.'HSEC')GOTO490
      IF(ICASRA.EQ.'ARCS')GOTO490
      IF(ICASRA.EQ.'LDEX')GOTO490
      IF(ICASRA.EQ.'GEVA')GOTO490
      IF(ICASRA.EQ.'EWEI')GOTO490
      IF(ICASRA.EQ.'GOMP')GOTO490
      IF(ICASRA.EQ.'HALO')GOTO490
      IF(ICASRA.EQ.'POEX')GOTO490
      IF(ICASRA.EQ.'ALPH')GOTO490
      IF(ICASRA.EQ.'BRAD')GOTO490
      IF(ICASRA.EQ.'RECI')GOTO490
      IF(ICASRA.EQ.'JOSB')GOTO490
      IF(ICASRA.EQ.'JOSU')GOTO490
      IF(ICASRA.EQ.'PNOR')GOTO490
      IF(ICASRA.EQ.'LLOG')GOTO490
CCCCC THE FOLLOWING 2 LINES WERE ADDED NOVEMBER 2001
      IF(ICASRA.EQ.'GEEE')GOTO490
      IF(ICASRA.EQ.'PLNO')GOTO490
      IF(ICASRA.EQ.'BBIN')GOTO490
      IF(ICASRA.EQ.'POLY')GOTO490
      IF(ICASRA.EQ.'STSP')GOTO490
      IF(ICASRA.EQ.'BIWE')GOTO490
      IF(ICASRA.EQ.'LOGS')GOTO490
      IF(ICASRA.EQ.'GH  ')GOTO490
      IF(ICASRA.EQ.'SLAS')GOTO490
      IF(ICASRA.EQ.'LAND')GOTO490
      IF(ICASRA.EQ.'IBET')GOTO490
      IF(ICASRA.EQ.'ERRO')GOTO490
      IF(ICASRA.EQ.'TRAP')GOTO490
      IF(ICASRA.EQ.'VONM')GOTO490
      IF(ICASRA.EQ.'WRCA')GOTO490
      IF(ICASRA.EQ.'PAR2')GOTO490
      IF(ICASRA.EQ.'GTRA')GOTO490
      IF(ICASRA.EQ.'TNOR')GOTO490
      IF(ICASRA.EQ.'CHI ')GOTO490
      IF(ICASRA.EQ.'FCAU')GOTO490
      IF(ICASRA.EQ.'BKAP')GOTO490
      IF(ICASRA.EQ.'GEXP')GOTO490
      IF(ICASRA.EQ.'TEXP')GOTO490
      IF(ICASRA.EQ.'GGD ')GOTO490
      IF(ICASRA.EQ.'FT  ')GOTO490
      IF(ICASRA.EQ.'SKWN')GOTO490
      IF(ICASRA.EQ.'SKWT')GOTO490
      IF(ICASRA.EQ.'ZIPF')GOTO490
      IF(ICASRA.EQ.'GMAK')GOTO490
      IF(ICASRA.EQ.'GIG ')GOTO490
      IF(ICASRA.EQ.'SKLN')GOTO490
      IF(ICASRA.EQ.'SKLT')GOTO490
      IF(ICASRA.EQ.'NCT ')GOTO490
      IF(ICASRA.EQ.'DNCT')GOTO490
      IF(ICASRA.EQ.'GHLO')GOTO490
      IF(ICASRA.EQ.'GLOG')GOTO490
      IF(ICASRA.EQ.'HERM')GOTO490
      IF(ICASRA.EQ.'YULE')GOTO490
      IF(ICASRA.EQ.'WARI')GOTO490
      IF(ICASRA.EQ.'GWAR')GOTO490
      IF(ICASRA.EQ.'NCBE')GOTO490
      IF(ICASRA.EQ.'DNCB')GOTO490
      IF(ICASRA.EQ.'SKDE')GOTO490
      IF(ICASRA.EQ.'ASDE')GOTO490
      IF(ICASRA.EQ.'MAXW')GOTO490
      IF(ICASRA.EQ.'RAYL')GOTO490
      IF(ICASRA.EQ.'GASD')GOTO490
      IF(ICASRA.EQ.'MCLE')GOTO490
      IF(ICASRA.EQ.'BESI')GOTO490
      IF(ICASRA.EQ.'BESK')GOTO490
      IF(ICASRA.EQ.'GMCL')GOTO490
      IF(ICASRA.EQ.'HBOL')GOTO490
      IF(ICASRA.EQ.'G5LO')GOTO490
      IF(ICASRA.EQ.'WAKE')GOTO490
      IF(ICASRA.EQ.'BNOR')GOTO490
      IF(ICASRA.EQ.'G2LO')GOTO490
      IF(ICASRA.EQ.'G3LO')GOTO490
      IF(ICASRA.EQ.'G4LO')GOTO490
      IF(ICASRA.EQ.'ALDE')GOTO490
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,401)
  401 FORMAT('***** INTERNAL ERROR IN DPRAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,402)
  402 FORMAT('      AT BRANCH POINT 4001--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,403)
  403 FORMAT('      ICASRA NOT EQUAL ONE OF THE ALLOWABLE 100+--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,404)
  404 FORMAT('      UNIF, NORM, LOGI, DOUB, CAUC, ETC.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,405)ICASRA
  405 FORMAT('      VALUE OF ICASRA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,406)
  406 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,407)(IANS(I),I=1,IWIDTH)
  407 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
C
C               *****************************************
C               **  STEP 6--                           **
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='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO670
      DO610J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO620
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO620
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO630
  610 CONTINUE
      GOTO680
C
  620 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO680
C
  630 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO680
C
  670 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,671)
  671 FORMAT('***** INTERNAL ERROR IN DPRAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,672)
  672 FORMAT('      AT BRANCH POINT 5081--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,673)
  673 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,674)
  674 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,675)NUMARG
  675 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,676)
  676 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,677)(IANS(I),I=1,IWIDTH)
  677 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  680 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO690
      WRITE(ICOUT,681)NUMARG,ILOCQ,ICASEQ
  681 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
  690 CONTINUE
C
C               ******************************************************
C               **  STEP 7--                                        **
C               **  BRANCH TO THE APPROPRIATE SUBCASE               **
C               **  (BASED ON THE QUALIFIER);                       **
C               **  DETERMINE THE NUMBER (= NRAN)                   **
C               **  OF RANDOM NUMBERS TO BE GENERATED.              **
C               **  NOTE THAT THE VARIABLE NIISUB                   **
C               **  IS THE LENGTH OF THE RESULTING                  **
C               **  VARIABLE ISUB(.).                               **
C               **  NOTE THAT DPFOR AUTOMATICALLY EXTENDS           **
C               **  THE INPUT LENGTH OF ISUB(.) IF NECESSARY.       **
C               **  (HENCE THE REDEFINITION OF NIISUB TO NINEW      **
C               **  AFTER THE CALL TO DPFOR.                        **
C               ******************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC OCTOBER 1993.  JACKNIFE INDEX TO DPMATC.
CCCCC IF(ICASRA.EQ.'JACK')GOTO1280
      IF(ICASEQ.EQ.'FULL')GOTO710
      IF(ICASEQ.EQ.'SUBS')GOTO720
      IF(ICASEQ.EQ.'FOR')GOTO730
C
  710 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      DO715I=1,NIISUB
      ISUB(I)=1
  715 CONTINUE
      NRAN=NIISUB
      GOTO750
C
  720 CONTINUE
      NIISUB=MAXN
      CALL DPSUBS(NIISUB,ILOCS,NS,IBUGQ,IERROR)
      NRAN=NS
      GOTO750
C
  730 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      CALL DPFOR(NIISUB,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIISUB=NINEW
      NRAN=NS
      GOTO750
C
  750 CONTINUE
C
C               ******************************************
C               **  STEP 8--                            **
C               **  GENERATE    NRAN    RANDOM NUMBERS  **
C               **  FROM THE SPECIFIED DISTRIBUTION.    **
C               **  STORE THEM TEMPORARILY IN           **
C               **  THE VECTOR Y(.).                    **
C               ******************************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL 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.'EXV2')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
CCCCC OCTOBER 1993.  JACKNIFE INDEX TO DPMATC
CCCCC IF(ICASRA.EQ.'JACK')GOTO1280
CCCCC THE FOLLOWING 4 LINES WERE ADDED MAY 1990
      IF(ICASRA.EQ.'IG')GOTO1290
      IF(ICASRA.EQ.'WALD')GOTO1300
      IF(ICASRA.EQ.'RIG')GOTO1310
      IF(ICASRA.EQ.'FL')GOTO1320
CCCCC THE FOLLOWING LINE WAS ADDED     DECEMBER 1993
      IF(ICASRA.EQ.'GEP')GOTO1330
CCCCC THE FOLLOWING LINE WAS ADDED     APRIL 1995
      IF(ICASRA.EQ.'POWF')GOTO1340
CCCCC THE FOLLOWING 4 LINES WERE ADDED AUGUST 1995
      IF(ICASRA.EQ.'HYPE')GOTO1350
      IF(ICASRA.EQ.'NCCS')GOTO1360
      IF(ICASRA.EQ.'NCF ')GOTO1370
      IF(ICASRA.EQ.'DNCF')GOTO1380
CCCCC THE FOLLOWING 2 LINES WERE ADDED OCTOBER 1995
      IF(ICASRA.EQ.'FNRM')GOTO1390
      IF(ICASRA.EQ.'HFCA')GOTO1400
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1998
      IF(ICASRA.EQ.'NMRM')GOTO1410
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1998
      IF(ICASRA.EQ.'POWL')GOTO1440
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 2001
      IF(ICASRA.EQ.'GLAM')GOTO1460
CCCCC THE FOLLOWING LINE WAS ADDED SEPTEMBER 2001
      IF(ICASRA.EQ.'IWEI')GOTO1480
CCCCC THE FOLLOWING 10 LINES WERE ADDED OCTOBER 2001
      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
CCCCC THE FOLLOWING 10 LINES WERE ADDED OCTOBER 2001
      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
      IF(ICASRA.EQ.'G5LO')GOTO2670
      IF(ICASRA.EQ.'WAKE')GOTO2680
      IF(ICASRA.EQ.'BNOR')GOTO2700
      IF(ICASRA.EQ.'G2LO')GOTO2720
      IF(ICASRA.EQ.'G3LO')GOTO2730
      IF(ICASRA.EQ.'G4LO')GOTO2740
      IF(ICASRA.EQ.'ALDE')GOTO2770
C
 5950 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5951)
 5951 FORMAT('***** INTERNAL ERROR IN DPRAND')
      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 24--')
      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 ')
      WRITE(ICOUT,5957)
 5957 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5958)(IANS(I),I=1,IWIDTH)
 5958 FORMAT(80A1)
      IF(IWIDTH.GE.1)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
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMBA=VALUE(ILOCP)
C
      IF(-ALAMLG.LE.ALAMBA.AND.ALAMBA.LE.ALAMLG)GOTO1065
      GOTO1067
C
 1065 CONTINUE
      CALL LOGRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1067 CONTINUE
      CALL LAMRAN(NRAN,ALAMBA,ISEED,Y)
      GOTO2990
C
 1070 CONTINUE
C
      IHP='SIGM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        SIGMA=1.0
      ELSE
        SIGMA=VALUE(ILOCP)
      ENDIF
C
      IF(SIGMA.LE.0.0)THEN
        WRITE(ICOUT,1071)
 1071   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1072)
 1072   FORMAT('      THE SPECIFIED SHAPE PARAMETER SIGMA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1073)
 1073   FORMAT('      LOGNORMAL DISTRIBUTION MUST BE POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1075)
 1075   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1076)SIGMA
 1076   FORMAT('      THE SPECIFIED VALUE OF SIGMA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL LGNRAN(NRAN,SIGMA,ISEED,Y)
      GOTO2990
C
 1080 CONTINUE
      CALL HFNRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1090 CONTINUE
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU=VALUE(ILOCP)
C
      IF(ANU.GE.0.0)GOTO1097
      WRITE(ICOUT,1091)
 1091 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1092)
 1092 FORMAT('      THE SPECIFIED TAIL LENGTH PARAMETER NU FOR THE T')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1094)
 1094 FORMAT('      DISTRIBUTION MUST BE POSITIVE;  SUCH WAS NOT THE ',
     1       'CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1096)ANU
 1096 FORMAT('      THE SPECIFIED VALUE OF NU = ',F12.5)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1097 CONTINUE
      CALL TRAN(NRAN,ANU,ISEED,Y)
      GOTO2990
C
 1100 CONTINUE
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU=VALUE(ILOCP)
C
      IF(ANU.GE.0.0)GOTO1107
      WRITE(ICOUT,1101)
 1101 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)
 1102 FORMAT('      THE SPECIFIED SHAPE PARAMETER NU FOR THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)
 1103 FORMAT('      CHI-SQUARED DISTRIBUTION MUST BE POSITIVE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1105)
 1105 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1106)ANU
 1106 FORMAT('      THE SPECIFIED VALUE OF NU = ',G15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1107 CONTINUE
      CALL CHSRAN(NRAN,ANU,ISEED,Y)
      GOTO2990
C
 1110 CONTINUE
      IHP='NU1 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU1=VALUE(ILOCP)
C
      IHP='NU2 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU2=VALUE(ILOCP)
C
      IF(ANU1.GT.0.0.AND.ANU2.GT.0.0)GOTO1117
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE SPECIFIED SHAPE PARAMETERS NU1 AND NU2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      FOR THE F DISTRIBUTION MUST BE POSITIVE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)ANU1,ANU2
 1116 FORMAT('      THE SPECIFIED VALUES OF NU1 AND NU2 = ',F12.5,
     1' AND ',F12.5, '(RESPECTIVELY)')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1117 CONTINUE
      CALL FRAN(NRAN,ANU1,ANU2,ISEED,Y)
      GOTO2990
C
 1120 CONTINUE
      CALL EXPRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1130 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.GT.0)GOTO1137
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)
 1133 FORMAT('      FOR THE GAMMA DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)GAMMA
 1136 FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1137 CONTINUE
      CALL GAMRAN(NRAN,GAMMA,ISEED,Y)
      GOTO2990
C
 1140 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(ALPHA.GT.0.0.AND.BETA.GE.0.0)GOTO1147
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      THE SPECIFIED SHAPE PARAMETERS ',
     1'ALPHA AND BETA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      FOR THE BETA DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1146)ALPHA,BETA
 1146 FORMAT('      THE SPECIFIED VALUES OF ALPHA AND BETA = ',
     1E15.7,' AND ',E15.7, '(RESPECTIVELY)')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1147 CONTINUE
      CALL BETRAN(NRAN,ALPHA,BETA,ISEED,Y)
      GOTO2990
C
 1150 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.GT.0)GOTO1157
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      FOR THE WEIBULL DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)
 1154 FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)GAMMA
 1156 FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1157 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGED    MAY 1993
CCCCC CALL WEIRAN(NRAN,GAMMA,ISEED,Y)
      CALL WEIRAN(NRAN,GAMMA,MINMAX,ISEED,Y)
      GOTO2990
C
 1160 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGED    MAY 1993
CCCCC CALL EV1RAN(NRAN,ISEED,Y)
      CALL EV1RAN(NRAN,MINMAX,ISEED,Y)
      GOTO2990
C
 1170 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.GT.0)GOTO1177
      WRITE(ICOUT,1171)
 1171 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)
 1173 FORMAT('      FOR THE EXTREME VALUE TYPE 2 DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)
 1174 FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1175)
 1175 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1176)GAMMA
 1176 FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1177 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGE     MAY 1993
CCCCC CALL EV2RAN(NRAN,GAMMA,ISEED,Y)
      CALL EV2RAN(NRAN,GAMMA,MINMAX,ISEED,Y)
      GOTO2990
C
 1180 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1181)
 1181   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1182)
 1182   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1183)
 1183   FORMAT('      FOR THE PARETO DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1184)
 1184   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1185)
 1185   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1186)GAMMA
 1186   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='A   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        A=1.0
      ELSE
        A=VALUE(ILOCP)
      ENDIF
C
      IF(A.LE.0.0)THEN
        WRITE(ICOUT,11181)
11181   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11182)
11182   FORMAT('      THE SPECIFIED SHAPE PARAMETER A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11183)
11183   FORMAT('      FOR THE PARETO DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11184)
11184   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11185)
11185   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11186)A
11186   FORMAT('      THE SPECIFIED VALUE OF A = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL PARRAN(NRAN,GAMMA,A,ISEED,Y)
      GOTO2990
C
 1190 CONTINUE
      IHP='N   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      NPAR=VALUE(ILOCP)+EPS
C
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      P=VALUE(ILOCP)
C
      IF(NPAR.GE.1.AND.0.0.LT.P.AND.P.LT.1.0)GOTO1197
      WRITE(ICOUT,1191)
 1191 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1192)
 1192 FORMAT('      THE SPECIFIED INTEGER    NUMBER OF TRIALS    ',
     1'PARAMETER N')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1193)
 1193 FORMAT('      FOR THE BINOMIAL DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)
 1194 FORMAT('      MUST BE 1 OR LARGER, AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)
 1195 FORMAT('      THE SPECIFIED    PROBABILITY OF SUCCESS    ',
     1'PARAMETER P')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)
 1196 FORMAT('      MUST BE BETWEEN 0 AND 1 (EXCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8197)
 8197 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1199)NPAR,P
 1199 FORMAT('      THE SPECIFIED VALUES OF N AND P = ',I8,
     1' AND ',E15.7,' (RESPECTIVELY)')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1197 CONTINUE
      CALL BINRAN(NRAN,P,NPAR,ISEED,Y)
      GOTO2990
C
 1200 CONTINUE
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      P=VALUE(ILOCP)
C
      IF(0.0.LT.P.AND.P.LT.1.0)GOTO1207
      WRITE(ICOUT,1201)
 1201 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1202)
 1202 FORMAT('      THE SPECIFIED    PROBABILITY OF SUCCESS    ',
     1'PARAMETER P')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1203)
 1203 FORMAT('      FOR THE GEOMETRIC DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1204)
 1204 FORMAT('      MUST BE BETWEEN 0 AND 1 (EXCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1205)
 1205 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1206)P
 1206 FORMAT('      THE SPECIFIED VALUE OF P = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1207 CONTINUE
      IF(IGEODF.EQ.'DLMF')THEN
        CALL GE2RAN(NRAN,P,ISEED,Y)
      ELSE
        CALL GEORAN(NRAN,P,ISEED,Y)
      ENDIF
      GOTO2990
C
 1210 CONTINUE
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMBA=VALUE(ILOCP)
C
      IF(ALAMBA.GT.0)GOTO1217
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE SPECIFIED SHAPE PARAMETER LAMBDA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      FOR THE POISSON DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)ALAMBA
 1216 FORMAT('      THE SPECIFIED VALUE OF LAMBDA = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1217 CONTINUE
      CALL POIRAN(NRAN,ALAMBA,ISEED,Y)
      GOTO2990
C
 1220 CONTINUE
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      P=VALUE(ILOCP)
C
      IHP='K   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AK=VALUE(ILOCP)
C
      IF(0.0.LT.P.AND.P.LT.1.0.AND.0.LT.AK)GOTO1227
      WRITE(ICOUT,1221)
 1221 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)
 1222 FORMAT('      THE SPECIFIED    PROBABILITY OF SUCCESS    ',
     1'PARAMETER P')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)
 1223 FORMAT('      FOR THE NEGATIVE BINOMIAL DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1224)
 1224 FORMAT('      MUST BE BETWEEN 0 AND 1 (EXCLUSIVELY); AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('      THE SPECIFIED    NUMBER OF SUCCESSES    ',
     1'PARAMETER K')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1226)
 1226 FORMAT('      MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8227)
 8227 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1229)P,AK
 1229 FORMAT('      THE SPECIFIED VALUES OF P AND K = ',F10.5,
     1' AND ',F10.5,' (RESPECTIVELY)')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1227 CONTINUE
      CALL NBRAN(NRAN,P,AK,ISEED,Y)
      GOTO2990
C
 1230 CONTINUE
      CALL SEMRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1240 CONTINUE
C
      ZLOWLM=-1.0
      ZUPPLM=1.0
C
      IHP='LOWL'
      IHP2='IMIT'
      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
        ZLOWLM=-1.0
      ELSE
        ZLOWLM=VALUE(ILOCP)
      ENDIF
C
      IHP='UPPL'
      IHP2='IMIT'
      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
        ZUPPLM=1.0
      ELSE
        ZUPPLM=VALUE(ILOCP)
      ENDIF
      ALOWLM=MIN(ZLOWLM,ZUPPLM)
      AUPPLM=MAX(ZLOWLM,ZUPPLM)
C
      IHP='C   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      C=VALUE(ILOCP)
C
      IF(C.LE.ALOWLM .OR. C.GE.AUPPLM)THEN
        WRITE(ICOUT,1241)
 1241   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1242)
 1242   FORMAT('      THE SPECIFIED SHAPE PARAMETER C FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1243)
 1243   FORMAT('      TRIANGULAR DISTRIBUTION MUST BE IN THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1244)ALOWLM,AUPPLM
 1244   FORMAT('      INTERVAL (',G15.7,',',G15.7,');')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1245)
 1245   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1246)C
 1246   FORMAT('      THE SPECIFIED VALUE OF C = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL TRIRAN(NRAN,C,ALOWLM,AUPPLM,ISEED,Y)
      GOTO2990
C
 1250 CONTINUE
      IHP='N   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      NPAR=VALUE(ILOCP)+EPS
C
      IF(NPAR.GE.1)GOTO1257
      WRITE(ICOUT,1251)
 1251 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1252)
 1252 FORMAT('      THE SPECIFIED INTEGER    NUMBER OF ITEMS    ',
     1'PARAMETER N')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1253)
 1253 FORMAT('      FOR THE DISCRETE UNIFORM DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1254)
 1254 FORMAT('      MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8197)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1259)NPAR
 1259 FORMAT('      THE SPECIFIED VALUE OF N =  ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1257 CONTINUE
      CALL DUNRAN(NRAN,NPAR,ISEED,Y)
      GOTO2990
C
 1260 CONTINUE
      IF(NRAN.GE.1)GOTO1267
      WRITE(ICOUT,1261)
 1261 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1262)
 1262 FORMAT('      THE SPECIFIED INTEGER    NUMBER OF ITEMS    ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1263)
 1263 FORMAT('      IN THE BOOTSTRAP INDEX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1264)
 1264 FORMAT('      MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8197)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1269)NRAN
 1269 FORMAT('      THE SPECIFIED NUMBER OF ITEMS =  ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1267 CONTINUE
CCCCC CALL DUNRAN(NRAN,NRAN,ISEED,Y)
      CALL DUNRA2(NRAN,NRAN,ISEED,Y)
      GOTO2990
C
 1270 CONTINUE
      IF(NRAN.GE.1)GOTO1277
      WRITE(ICOUT,1271)
 1271 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1272)
 1272 FORMAT('      THE SPECIFIED INTEGER    NUMBER OF ITEMS    ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1273)
 1273 FORMAT('      IN THE RANDOM PERMUTATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1274)
 1274 FORMAT('      MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8197)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1279)NRAN
 1279 FORMAT('      THE SPECIFIED NUMBER OF ITEMS =  ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1277 CONTINUE
      CALL RANPER(NRAN,ISEED,Y)
      GOTO2990
C
CCCCC OCTOBER 1993.  THIS CODE IS NO LONGER ACTIVE.  MOVED TO DPMATC.
 1280 CONTINUE
      IF(NRAN.GE.1)GOTO1287
      WRITE(ICOUT,1281)
 1281 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)
 1282 FORMAT('      THE SPECIFIED INTEGER    NUMBER OF ITEMS    ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1283)
 1283 FORMAT('      IN THE (RANDOM) JACKNIFE INDEX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1284)
 1284 FORMAT('      MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8197)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1289)NRAN
 1289 FORMAT('      THE SPECIFIED NUMBER OF ITEMS =  ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1287 CONTINUE
      CALL RANPER(NRAN,ISEED,Y)
      DO1288I=1,NRAN
      AI=I
      IYI=Y(I)+0.1
      IF(IYI.EQ.NRAN)Y(I)=0.0
      IF(IYI.NE.NRAN)Y(I)=AI
 1288 CONTINUE
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1290 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IHP='MU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        AMU=1.0
      ELSE
        AMU=VALUE(ILOCP)
      ENDIF
C
      IF(GAMMA.LE.0)THEN
        WRITE(ICOUT,1291)
 1291   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1292)
 1292   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1293)
 1293   FORMAT('      INVERSE GAUSSIAN DISTRIBUTION MUST BE STRICTLY')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1294)
 1294   FORMAT('      LARGER THAN 0;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1295)GAMMA
 1295   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IF(AMU.LE.0)THEN
        WRITE(ICOUT,1296)
 1296   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1297)
 1297   FORMAT('      THE SPECIFIED SHAPE PARAMETER MU FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1298)
 1298   FORMAT('      INVERSE GAUSSIAN DISTRIBUTION MUST BE STRICTLY')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1299)
 1299   FORMAT('      LARGER THAN 0;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,91299)AMU
91299   FORMAT('      THE SPECIFIED VALUE OF MU = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL IGRAN(NRAN,GAMMA,AMU,ISEED,Y)
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1300 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.GT.0)GOTO1307
      WRITE(ICOUT,1301)
 1301 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1302)
 1302 FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1303)
 1303 FORMAT('      FOR THE WALD DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1304)
 1304 FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1305)
 1305 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1306)GAMMA
 1306 FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1307 CONTINUE
      CALL WALRAN(NRAN,GAMMA,ISEED,Y)
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1310 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1311)
 1311   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1312)
 1312   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1313)
 1313   FORMAT('      RECIPROCAL INVERSE GAUSSIAN DISTRIBUTION MUST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1314)
 1314   FORMAT('      BE STRICTLY LARGER THAN 0; SUCH WAS NOT THE ',
     1         'CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1315)GAMMA
 1315   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='MU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        AMU=1.0
      ELSE
        AMU=VALUE(ILOCP)
      ENDIF
C
      IF(AMU.LE.0.0)THEN
        WRITE(ICOUT,1316)
 1316   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1317)
 1317   FORMAT('      THE SPECIFIED SHAPE PARAMETER MU FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1318)
 1318   FORMAT('      RECIPROCAL INVERSE GAUSSIAN DISTRIBUTION MUST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1319)
 1319   FORMAT('      BE STRICTLY LARGER THAN 0; SUCH WAS NOT THE ',
     1         'CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,91315)AMU
91315   FORMAT('      THE SPECIFIED VALUE OF AMU = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL RIGRAN(NRAN,GAMMA,AMU,ISEED,Y)
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1320 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.GT.0)GOTO1327
      WRITE(ICOUT,1321)
 1321 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1322)
 1322 FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1323)
 1323 FORMAT('      FOR THE FATIGUE LIFE DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1324)
 1324 FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)GAMMA
 1326 FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1327 CONTINUE
      CALL FLRAN(NRAN,GAMMA,ISEED,Y)
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED      DECEMBER 1993
 1330 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      CALL GEPRAN(NRAN,GAMMA,MINMAX,IGEPDF,ISEED,Y)
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED      APRIL 1995
 1340 CONTINUE
      IHP='C   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      C=VALUE(ILOCP)
C
      CALL POWRAN(NRAN,C,ISEED,Y)
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED      AUGUST 1995
 1350 CONTINUE
      IHP='K   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AK=VALUE(ILOCP)
C
      IHP='N   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AN=VALUE(ILOCP)
C
      IHP='M   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AM=VALUE(ILOCP)
C
      NN1=INT(AN+0.5)
      NN2=INT(AM-AN+0.5)
      KK=INT(AK+0.5)
      DO1352II=1,NRAN
      CALL HYPRAN(KK,NN1,NN2,ISEED,JX)
      IF(JX.EQ.-1)THEN
        WRITE(ICOUT,1354)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1356)INT(AK),INT(AM),INT(AN)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1354 FORMAT('****** ERROR IN GENERATING HYPERGEOMETRIC RANDOM ',
     1'NUMBERS.')
 1356 FORMAT('       THE VALUES OF K, M, AND N = ',3I8)
      Y(II)=REAL(JX)
 1352 CONTINUE
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED      AUGUST 1995
 1360 CONTINUE
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU=VALUE(ILOCP)
      IF(ANU.LE.0.0)THEN
        WRITE(ICOUT,1361)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1362)ANU
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1361 FORMAT('****** ERROR IN GENERATING NON-CENTRAL CHI-SQUARE RANDOM ',
     1'NUMBERS.')
 1362 FORMAT('       THE VALUE OF NU (= ',F15.7,') IS NON-POSITIVE')
C
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMBA=VALUE(ILOCP)
      IF(ALAMBA.LT.0.0)THEN
        WRITE(ICOUT,1363)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1364)ALAMBA
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1363 FORMAT('****** ERROR IN GENERATING NON-CENTRAL CHI-SQUARE RANDOM ',
     1'NUMBERS.')
 1364 FORMAT('       THE VALUE OF LAMBDA (= ',F15.7,') IS LESS THAN 0.')
C
      CALL NCCRAN(NRAN,ANU,ALAMBA,ISEED,Y)
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED      AUGUST 1995
 1370 CONTINUE
      IHP='NU1 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU1=VALUE(ILOCP)
      IF(ANU1.LE.0.0)THEN
        WRITE(ICOUT,1371)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1372)ANU1
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1371 FORMAT('****** ERROR IN GENERATING NON-CENTRAL F RANDOM ',
     1'NUMBERS.')
 1372 FORMAT('       THE VALUE OF NU1 (= ',F15.7,') IS LESS THAN 1.')
C
      IHP='NU2 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU2=VALUE(ILOCP)
      IF(ANU2.LT.1.0)THEN
        WRITE(ICOUT,1373)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1374)ANU
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1373 FORMAT('****** ERROR IN GENERATING NON-CENTRAL F RANDOM ',
     1'NUMBERS.')
 1374 FORMAT('       THE VALUE OF NU2 (= ',F15.7,') IS LESS THAN 1.')
C
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB1=VALUE(ILOCP)
      IF(ALAMB1.LT.0.0)THEN
        WRITE(ICOUT,1375)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1376)ALAMB1
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1375 FORMAT('****** ERROR IN GENERATING NON-CENTRAL F RANDOM ',
     1'NUMBERS.')
 1376 FORMAT('       THE VALUE OF LAMBDA (= ',F15.7,') IS LESS THAN ',
     1'0.')
C
      CALL NCFRAN(NRAN,ANU1,ANU2,ALAMB1,ISEED,Y)
      GOTO2990
C
CCCCC THE FOLLOWING SECTION WAS ADDED      AUGUST 1995
 1380 CONTINUE
      IHP='NU1 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU1=VALUE(ILOCP)
      IF(ANU1.LE.0.0)THEN
        WRITE(ICOUT,1381)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1382)ANU1
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1381 FORMAT('****** ERROR IN GENERATING DOUBLY NON-CENTRAL F RANDOM ',
     1'NUMBERS.')
 1382 FORMAT('       THE VALUE OF NU1 (= ',F15.7,') IS LESS THAN 1.')
C
      IHP='NU2 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU2=VALUE(ILOCP)
      IF(ANU2.LE.0.0)THEN
        WRITE(ICOUT,1383)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1384)ANU2
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1383 FORMAT('****** ERROR IN GENERATING DOUBLY NON-CENTRAL F RANDOM ',
     1'NUMBERS.')
 1384 FORMAT('       THE VALUE OF NU2 (= ',F15.7,') IS LESS THAN 1.')
C
      IHP='LAMB'
      IHP2='DA1 '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB1=VALUE(ILOCP)
      IF(ALAMB1.LT.0.0)THEN
        WRITE(ICOUT,1385)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1386)ALAMB1
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1385 FORMAT('****** ERROR IN GENERATING DOUBLY NON-CENTRAL F RANDOM ',
     1'NUMBERS.')
 1386 FORMAT('       THE VALUE OF LAMBDA1 (= ',F15.7,') IS LESS THAN ',
     1'0.')
C
      IHP='LAMB'
      IHP2='DA2 '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB2=VALUE(ILOCP)
      IF(ALAMB2.LT.0.0)THEN
        WRITE(ICOUT,1387)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1388)ALAMB2
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1387 FORMAT('****** ERROR IN GENERATING DOUBLY NON-CENTRAL F RANDOM ',
     1'NUMBERS.')
 1388 FORMAT('       THE VALUE OF LAMBDA2 (= ',F15.7,') IS LESS THAN ',
     1'0.')
C
      CALL DNFRAN(NRAN,ANU1,ANU2,ALAMB1,ALAMB2,ISEED,Y)
      GOTO2990
C
 1390 CONTINUE
      IHP='MU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      U=VALUE(ILOCP)
C
      IHP='SD  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      SD=VALUE(ILOCP)
C
      IF(SD.GT.0.0)GOTO1397
      WRITE(ICOUT,1391)
 1391 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1392)
 1392 FORMAT('      THE SPECIFIED SHAPE PARAMETER SD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1393)
 1393 FORMAT('      FOR THE FOLDED NORMAL DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1394)
 1394 FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1395)
 1395 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1396)SD
 1396 FORMAT('      THE SPECIFIED VALUE OF SD = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1397 CONTINUE
      CALL FNRRAN(NRAN,U,SD,ISEED,Y)
      GOTO2990
C
 1400 CONTINUE
      CALL HFCRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1410 CONTINUE
C
      IHP='U1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      U1=VALUE(ILOCP)
C
      IHP='U2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      U2=VALUE(ILOCP)
C
      IHP='SD1 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      SD1=VALUE(ILOCP)
C
      IF(SD1.GE.0.0)GOTO1417
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      THE SPECIFIED SHAPE PARAMETER SD1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      FOR THE NORMAL MIXTURE DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
 1414 FORMAT('      MUST BE GREATER THAN 0.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)SD1
 1416 FORMAT('      THE SPECIFIED VALUE OF SD1 = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1417 CONTINUE
C
      IHP='SD2 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      SD2=VALUE(ILOCP)
C
      IF(SD2.GE.0.0)GOTO1427
      WRITE(ICOUT,1421)
 1421 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)
 1422 FORMAT('      THE SPECIFIED SHAPE PARAMETER SD2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      FOR THE NORMAL MIXTURE DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1424)
 1424 FORMAT('      MUST BE GREATER THAN 0.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1426)SD2
 1426 FORMAT('      THE SPECIFIED VALUE OF SD2 = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1427 CONTINUE
C
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      P=VALUE(ILOCP)
C
      IF(P.GE.0.0.AND.P.LE.1.0)GOTO1437
      WRITE(ICOUT,1431)
 1431 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1432)
 1432 FORMAT('      THE SPECIFIED SHAPE PARAMETER P')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1433)
 1433 FORMAT('      FOR THE NORMAL MIXTURE DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1434)
 1434 FORMAT('      MUST BE IN THE INTERVAL (0,1).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1435)
 1435 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1436)P
 1436 FORMAT('      THE SPECIFIED VALUE OF P = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1437 CONTINUE
C
      CALL NMXRAN(NRAN,U1,SD1,U2,SD2,P,ISEED,Y)
      GOTO2990
C
 1440 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.GT.0.0)GOTO1447
      WRITE(ICOUT,1441)
 1441 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1442)
 1442 FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1443)
 1443 FORMAT('      FOR THE POWER LAW DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1444)
 1444 FORMAT('      MUST BE GREATER THAN 0.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1445)
 1445 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1446)ALPHA
 1446 FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1447 CONTINUE
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(BETA.GT.0.0)GOTO1457
      WRITE(ICOUT,1451)
 1451 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1452)
 1452 FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1453)
 1453 FORMAT('      FOR THE POWER LAW DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1454)
 1454 FORMAT('      MUST BE GREATER THAN 0.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1455)
 1455 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1456)BETA
 1456 FORMAT('      THE SPECIFIED VALUE OF BETA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1457 CONTINUE
C
      CALL PWLRAN(NRAN,ALPHA,BETA,ISEED,Y)
      GOTO2990
C
 1460 CONTINUE
C
      IHP='LAMB'
      IHP2='DA3 '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB3=VALUE(ILOCP)
C
      IHP='LAMB'
      IHP2='DA4 '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB4=VALUE(ILOCP)
C
      IF(IGLDDF.EQ.'RAMB')THEN
        IWRITE='ERRO'
        CALL GLDCHK(ALAMB3,ALAMB4,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
        IF(IFLAG.EQ.1)THEN
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
      CALL GLDRAN(NRAN,ALAMB3,ALAMB4,IGLDDF,ISEED,Y)
      GOTO2990
C
 1480 CONTINUE
C
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1481)
 1481   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1482)
 1482   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1483)
 1483   FORMAT('      FOR THE INVERTED WEIBULL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1484)
 1484   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1485)
 1485   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1486)GAMMA
 1486   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL IWERAN(NRAN,GAMMA,ISEED,Y)
      GOTO2990
C
 1490 CONTINUE
C
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1491)
 1491   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1492)
 1492   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1493)
 1493   FORMAT('      FOR THE DOUBLE WEIBULL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1494)
 1494   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1495)
 1495   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1496)GAMMA
 1496   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL DWERAN(NRAN,GAMMA,ISEED,Y)
      GOTO2990
C
 1500 CONTINUE
C
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1501)
 1501   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1502)
 1502   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1503)
 1503   FORMAT('      FOR THE DOUBLE GAMMA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1504)
 1504   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1505)
 1505   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1506)GAMMA
 1506   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL DGARAN(NRAN,GAMMA,ISEED,Y)
      GOTO2990
C
 1510 CONTINUE
C
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1511)
 1511   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1512)
 1512   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1513)
 1513   FORMAT('      FOR THE LOG GAMMA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1514)
 1514   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1515)
 1515   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1516)GAMMA
 1516   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL LGARAN(NRAN,GAMMA,ILGADF,ISEED,Y)
      GOTO2990
C
 1520 CONTINUE
C
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1521)
 1521   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1522)
 1522   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1523)
 1523   FORMAT('      FOR THE INVERTED GAMMA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1524)
 1524   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1525)
 1525   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1526)GAMMA
 1526   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL IGARAN(NRAN,GAMMA,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
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,1571)
 1571   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1572)
 1572   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1573)
 1573   FORMAT('      FOR THE LOG DOUBLE EXPONENTIAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1574)
 1574   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1575)
 1575   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1576)ALPHA
 1576   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL LDERAN(NRAN,ALPHA,ISEED,Y)
      GOTO2990
C
 1580 CONTINUE
C
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      CALL GEVRAN(NRAN,GAMMA,MINMAX,ISEED,Y)
      GOTO2990
C
 1590 CONTINUE
C
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IHP='THET'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      THETA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1591)
 1591   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1592)
 1592   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1593)
 1593   FORMAT('      FOR THE EXPONENTIATED WEIBULL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1594)
 1594   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1595)
 1595   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1596)GAMMA
 1596   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      IF(THETA.LE.0.0)THEN
        WRITE(ICOUT,11591)
11591   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11592)
11592   FORMAT('      THE SPECIFIED SHAPE PARAMETER THETA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11593)
11593   FORMAT('      FOR THE EXPONENTIATED WEIBULL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11594)
11594   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11595)
11595   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11596)THETA
11596   FORMAT('      THE SPECIFIED VALUE OF THETA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL EWERAN(NRAN,GAMMA,THETA,ISEED,Y)
      GOTO2990
C
 1600 CONTINUE
C
      IHP='C   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      C=VALUE(ILOCP)
C
      IHP='B   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      B=VALUE(ILOCP)
C
      IF(C.LE.1.0)THEN
        WRITE(ICOUT,1601)
 1601   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1602)
 1602   FORMAT('      THE SPECIFIED SHAPE PARAMETER C')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1603)
 1603   FORMAT('      FOR THE GOMPERTZ DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1604)
 1604   FORMAT('      MUST BE STRICTLY LARGER THAN 1;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1605)
 1605   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1606)C
 1606   FORMAT('      THE SPECIFIED VALUE OF C = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      IF(B.LE.0.0)THEN
        WRITE(ICOUT,11601)
11601   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11602)
11602   FORMAT('      THE SPECIFIED SHAPE PARAMETER B')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11603)
11603   FORMAT('      FOR THE GOMPERTZ DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11604)
11604   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11605)
11605   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11606)B
11606   FORMAT('      THE SPECIFIED VALUE OF B = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL GOMRAN(NRAN,C,B,ISEED,Y)
      GOTO2990
C
 1610 CONTINUE
C
      IF(IFLGHL.EQ.1)THEN
        IHP='GAMM'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GAMMA=VALUE(ILOCP)
C
        IF(GAMMA.LE.0.0)THEN
          WRITE(ICOUT,11611)
11611     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11612)
11612     FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11613)
11613     FORMAT('      FOR THE GENERALIZED HALF-LOGISTIC ',
     1           'DISTRIBUTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11614)
11614     FORMAT('      MUST BE IN THE INTERVAL (0,5]')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11615)
11615     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11616)GAMMA
11616     FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
      ELSE
        GAMMA=-1.0
      ENDIF
C
      CALL HFLRAN(NRAN,GAMMA,ISEED,Y)
      GOTO2990
C
 1620 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,1621)
 1621   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1622)
 1622   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1623)
 1623   FORMAT('      FOR THE POWER EXPONENTIAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1624)
 1624   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1625)
 1625   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1626)ALPHA
 1626   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,11621)
11621   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11622)
11622   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11623)
11623   FORMAT('      FOR THE POWER EXPONENTIAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11624)
11624   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11625)
11625   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11626)BETA
11626   FORMAT('      THE SPECIFIED VALUE OF BETA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL PEXRAN(NRAN,ALPHA,BETA,ISEED,Y)
      GOTO2990
C
 1630 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,1631)
 1631   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1632)
 1632   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1633)
 1633   FORMAT('      FOR THE ALPHA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1634)
 1634   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1635)
 1635   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1636)ALPHA
 1636   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,11631)
11631   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11632)
11632   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11633)
11633   FORMAT('      FOR THE ALPHA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11634)
11634   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11635)
11635   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11636)BETA
11636   FORMAT('      THE SPECIFIED VALUE OF BETA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL ALPRAN(NRAN,ALPHA,BETA,ISEED,Y)
      GOTO2990
C
 1640 CONTINUE
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,1641)
 1641   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1642)
 1642   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1643)
 1643   FORMAT('      FOR THE BRADFORD DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1644)
 1644   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1645)
 1645   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1646)BETA
 1646   FORMAT('      THE SPECIFIED VALUE OF BETA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL BRARAN(NRAN,BETA,ISEED,Y)
      GOTO2990
C
 1650 CONTINUE
C
      IHP='B   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      B=VALUE(ILOCP)
C
      IF(B.LE.0.0)THEN
        WRITE(ICOUT,1651)
 1651   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1652)
 1652   FORMAT('      THE SPECIFIED SHAPE PARAMETER B')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1653)
 1653   FORMAT('      FOR THE RECIPROCAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1654)
 1654   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1655)
 1655   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1656)B
 1656   FORMAT('      THE SPECIFIED VALUE OF B = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL RECRAN(NRAN,B,ISEED,Y)
      GOTO2990
C
 1660 CONTINUE
C
      IHP='ALPH'
      IHP2='A1  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA1=VALUE(ILOCP)
C
      IHP='ALPH'
      IHP2='A2  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA2=VALUE(ILOCP)
C
      IF(ALPHA2.LE.0.0)THEN
        WRITE(ICOUT,1661)
 1661   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1662)
 1662   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1663)
 1663   FORMAT('      FOR THE JOHNSON SB DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1664)
 1664   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1665)
 1665   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1666)ALPHA2
 1666   FORMAT('      THE SPECIFIED VALUE OF ALPHA2 = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL JSBRAN(NRAN,ALPHA1,ALPHA2,ISEED,Y)
      GOTO2990
C
 1670 CONTINUE
C
      IHP='ALPH'
      IHP2='A1  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA1=VALUE(ILOCP)
C
      IHP='ALPH'
      IHP2='A2  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA2=VALUE(ILOCP)
C
      IF(ALPHA2.LE.0.0)THEN
        WRITE(ICOUT,1671)
 1671   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1672)
 1672   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1673)
 1673   FORMAT('      FOR THE JOHNSON SB DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1674)
 1674   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1675)
 1675   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1676)ALPHA2
 1676   FORMAT('      THE SPECIFIED VALUE OF ALPHA2 = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL JSURAN(NRAN,ALPHA1,ALPHA2,ISEED,Y)
      GOTO2990
C
 1680 CONTINUE
C
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      P=VALUE(ILOCP)
C
      IF(P.LE.0.0)THEN
        WRITE(ICOUT,1681)
 1681   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1682)
 1682   FORMAT('      THE SPECIFIED SHAPE PARAMETER P')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1683)
 1683   FORMAT('      FOR THE POWER NORMAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1684)
 1684   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1685)
 1685   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1686)P
 1686   FORMAT('      THE SPECIFIED VALUE OF P = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL PNRRAN(NRAN,P,ISEED,Y)
      GOTO2990
C
 1690 CONTINUE
C
      IHP='DELT'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      DELTA=VALUE(ILOCP)
C
      IF(DELTA.LE.0.0)THEN
        WRITE(ICOUT,1691)
 1691   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1692)
 1692   FORMAT('      THE SPECIFIED SHAPE PARAMETER DELTA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1693)
 1693   FORMAT('      FOR THE LOG-LOGISTIC DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1694)
 1694   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1695)
 1695   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1696)DELTA
 1696   FORMAT('      THE SPECIFIED VALUE OF DELTA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL LLGRAN(NRAN,DELTA,ISEED,Y)
      GOTO2990
C
 1700 CONTINUE
C
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1701)
 1701   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1702)
 1702   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1703)
 1703   FORMAT('      FOR THE GEOMETRIC EXTREME EXPONENTIAL ',
     1         'DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1704)
 1704   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1705)
 1705   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1706)GAMMA
 1706   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL GEERAN(NRAN,GAMMA,ISEED,Y)
      GOTO2990
C
 1710 CONTINUE
C
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      P=VALUE(ILOCP)
C
      IF(P.LE.0.0)THEN
        WRITE(ICOUT,1711)
 1711   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1712)
 1712   FORMAT('      THE SPECIFIED SHAPE PARAMETER P')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1713)
 1713   FORMAT('      FOR THE POWER LOGNORMAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1714)
 1714   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1715)
 1715   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1716)P
 1716   FORMAT('      THE SPECIFIED VALUE OF P = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='SD  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        SD=1.0
      ELSE
        SD=VALUE(ILOCP)
      ENDIF
C
      IF(SD.LE.0.0)THEN
        WRITE(ICOUT,1721)
 1721   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1722)
 1722   FORMAT('      THE SPECIFIED SHAPE PARAMETER SD')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1723)
 1723   FORMAT('      FOR THE POWER LOGNORMAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1724)
 1724   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1725)
 1725   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1726)SD
 1726   FORMAT('      THE SPECIFIED VALUE OF SD = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL PLNRAN(NRAN,P,SD,ISEED,Y)
      GOTO2990
C
 1730 CONTINUE
C
      IF(ICASRA.EQ.'POLY')THEN
        IDIST='POLYA DISTRIBUTION'
      ELSE
        IDIST='BETA-BINOMIAL DISTRIBUTION'
      ENDIF
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,1731)
 1731   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1732)
 1732   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1733)IDIST
 1733   FORMAT('      FOR THE ',A26)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1734)
 1734   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1735)
 1735   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1736)ALPHA
 1736   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,1741)
 1741   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1742)
 1742   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1743)IDIST
 1743   FORMAT('      FOR THE ',A26)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1744)
 1744   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1745)
 1745   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1746)BETA
 1746   FORMAT('      THE SPECIFIED VALUE OF BETA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='N   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      N=INT(VALUE(ILOCP)+0.5)
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,1751)
 1751   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1752)
 1752   FORMAT('      THE SPECIFIED SHAPE PARAMETER N')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1753)IDIST
 1753   FORMAT('      FOR THE ',A26)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1754)
 1754   FORMAT('      MUST BE AT LEAST 1;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1755)
 1755   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1756)N
 1756   FORMAT('      THE SPECIFIED VALUE OF N = ',I8)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IF(ICASRA.EQ.'POLY')THEN
        CALL BBNRAN(ALPHA,BETA,N,NRAN,ISEED,Y)
      ELSE
        CALL BBNRAN(BETA,ALPHA,N,NRAN,ISEED,Y)
      ENDIF
      GOTO2990
C
 1760 CONTINUE
C
      IHP='THET'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      THETA=VALUE(ILOCP)
C
      IF(THETA.LT.0.0 .OR.THETA.GT.1.0)THEN
        WRITE(ICOUT,1761)
 1761   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1762)
 1762   FORMAT('      THE SPECIFIED SHAPE PARAMETER THETA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1763)
 1763   FORMAT('      FOR THE TWO-SIDED POWER DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1764)
 1764   FORMAT('      MUST BE IN THE INTERVAL (0,1);')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1765)
 1765   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1766)THETA
 1766   FORMAT('      THE SPECIFIED VALUE OF THETA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='N   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AN=VALUE(ILOCP)
C
      IF(AN.LE.0.0)THEN
        WRITE(ICOUT,1771)
 1771   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1772)
 1772   FORMAT('      THE SPECIFIED SHAPE PARAMETER N')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1773)
 1773   FORMAT('      FOR THE TWO-SIDED POWER DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1774)
 1774   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1775)
 1775   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1776)AN
 1776   FORMAT('      THE SPECIFIED VALUE OF N = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL TSPRAN(NRAN,THETA,AN,ISEED,Y)
      GOTO2990
C
 1790 CONTINUE
C
      IHP='SCAL'
      IHP2='E1  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ASCAL1=VALUE(ILOCP)
C
      IF(ASCAL1.LE.0.0)THEN
        WRITE(ICOUT,1791)
 1791   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1792)
 1792   FORMAT('      THE SPECIFIED SHAPE PARAMETER SCALE1')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1793)
 1793   FORMAT('      FOR THE BIWEIBULL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1794)
 1794   FORMAT('      MUST BE STRICTLY POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1795)
 1795   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1796)ASCAL1
 1796   FORMAT('      THE SPECIFIED VALUE OF SCALE1 = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='GAMM'
      IHP2='A1  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA1=VALUE(ILOCP)
C
      IF(GAMMA1.LE.0.0)THEN
        WRITE(ICOUT,1801)
 1801   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1802)
 1802   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA1')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1803)
 1803   FORMAT('      FOR THE BIWEIBULL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1804)
 1804   FORMAT('      MUST BE STRICTLY POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1805)
 1805   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1806)GAMMA1
 1806   FORMAT('      THE SPECIFIED VALUE OF GAMMA1 = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='SCAL'
      IHP2='E2  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ASCAL2=VALUE(ILOCP)
C
      IF(ASCAL2.LE.0.0)THEN
        WRITE(ICOUT,1811)
 1811   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1812)
 1812   FORMAT('      THE SPECIFIED SHAPE PARAMETER SCALE2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1813)
 1813   FORMAT('      FOR THE BIWEIBULL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1814)
 1814   FORMAT('      MUST BE STRICTLY POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1815)
 1815   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1816)ASCAL2
 1816   FORMAT('      THE SPECIFIED VALUE OF SCALE2 = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='GAMM'
      IHP2='A2  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA2=VALUE(ILOCP)
C
      IF(GAMMA2.LE.0.0)THEN
        WRITE(ICOUT,1821)
 1821   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1822)
 1822   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1823)
 1823   FORMAT('      FOR THE BIWEIBULL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1824)
 1824   FORMAT('      MUST BE STRICTLY POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1825)
 1825   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1826)GAMMA2
 1826   FORMAT('      THE SPECIFIED VALUE OF GAMMA2 = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='LOC2'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALOC2=VALUE(ILOCP)
C
      IF(ALOC2.LE.0.0)THEN
        WRITE(ICOUT,1831)
 1831   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1832)
 1832   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALOC2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1833)
 1833   FORMAT('      FOR THE BIWEIBULL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1834)
 1834   FORMAT('      MUST BE STRICTLY POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1835)
 1835   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1836)ALOC2
 1836   FORMAT('      THE SPECIFIED VALUE OF LOC2 = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL BWERAN(NRAN,ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,ISEED,Y)
      GOTO2990
C
 1850 CONTINUE
      IHP='THET'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      THETA=VALUE(ILOCP)
C
      IF(0.0.LT.THETA.AND.THETA.LT.1.0)GOTO1857
      WRITE(ICOUT,1851)
 1851 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1852)
 1852 FORMAT('      THE SPECIFIED SHAPE PARAMETER THETA FOR THE ',
     1'LOGARITHMIC SERIES DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1854)
 1854 FORMAT('      MUST BE BETWEEN 0 AND 1 (EXCLUSIVELY); SUCH WAS',
     1' NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1856)THETA
 1856 FORMAT('      THE SPECIFIED VALUE OF THETA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1857 CONTINUE
      CALL DLGRAN(NRAN,THETA,ISEED,Y)
      GOTO2990
C
 1860 CONTINUE
      IHP='G   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      G=VALUE(ILOCP)
C
      IF(G.GE.0.0)GOTO1867
      WRITE(ICOUT,1861)
 1861 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1862)
 1862 FORMAT('      THE SPECIFIED SHAPE PARAMETER G FOR THE ',
     1'G-AND-H DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1864)
 1864 FORMAT('      MUST BE NON-NEGATIVE; SUCH WAS NOT THE CASE ',
     1' HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1866)G
 1866 FORMAT('      THE SPECIFIED VALUE OF G = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1867 CONTINUE
C
      IHP='H   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AH=VALUE(ILOCP)
C
      IF(AH.GE.0.0)GOTO1877
      WRITE(ICOUT,1871)
 1871 FORMAT('***** ERROR IN DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1872)
 1872 FORMAT('      THE SPECIFIED SHAPE PARAMETER H FOR THE ',
     1'G-AND-H DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1874)
 1874 FORMAT('      MUST BE NON-NEGATIVE; SUCH WAS NOT THE CASE ',
     1' HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1876)AH
 1876 FORMAT('      THE SPECIFIED VALUE OF H = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1877 CONTINUE
      CALL GHRAN(NRAN,G,AH,ISEED,Y)
      GOTO2990
C
 1880 CONTINUE
      CALL SLARAN(NRAN,ISEED,Y)
      GOTO2990
C
 1890 CONTINUE
      CALL LANRAN(NRAN,ISEED,Y)
      GOTO2990
C
 1900 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,1901)
 1901   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1902)
 1902   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE ',
     1         'INVERTED BETA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1904)
 1904   FORMAT('      MUST BE POSITIVE; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1906)ALPHA
 1906   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,1911)
 1911   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1912)
 1912   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA FOR THE ',
     1         'INVERTED BETA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1914)
 1914   FORMAT('      MUST BE POSITIVE; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1916)BETA
 1916   FORMAT('      THE SPECIFIED VALUE OF BETA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      CALL IBRAN(NRAN,ALPHA,BETA,ISEED,Y)
      GOTO2990
C
 1920 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LT.1.0)THEN
        WRITE(ICOUT,1921)
 1921   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1922)
 1922   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE ',
     1         'ERROR DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1924)
 1924   FORMAT('      MUST BE POSITIVE; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1926)ALPHA
 1926   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL ERRRAN(NRAN,ALPHA,ISEED,Y)
      GOTO2990
C
 1930 CONTINUE
      IHP='A   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      A=VALUE(ILOCP)
C
      IHP='B   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      B=VALUE(ILOCP)
C
      IHP='C   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      C=VALUE(ILOCP)
C
      IHP='D   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      DZ=VALUE(ILOCP)
C
      IF(A.GT.B .OR. B.GT.C .OR. C.GT.DZ)THEN
        WRITE(ICOUT,1932)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1933)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1934)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1936)A,B,C,DZ
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
 1932 FORMAT(
     1'***** FATAL ERROR--FOR THE TRAPEZOID DISTRIBUTION, THE FOUR')
 1933 FORMAT(
     1'      SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
 1934 FORMAT(
     1'         A <= B <= C <= D')
 1936 FORMAT(
     1'      A, B, C, D = ',4E15.7)
C
      CALL TRARAN(NRAN,A,B,C,DZ,ISEED,Y)
      GOTO2990
C
 1940 CONTINUE
      IHP='B   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      B=VALUE(ILOCP)
C
      IF(B.LE.0.0)THEN
        WRITE(ICOUT,1941)
 1941   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1942)
 1942   FORMAT('      THE SPECIFIED SHAPE PARAMETER B FOR THE ',
     1         'VON MISES DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1944)
 1944   FORMAT('      MUST BE POSITIVE; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1946)B
 1946   FORMAT('      THE SPECIFIED VALUE OF B = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL VONRAN(NRAN,B,ISEED,Y)
      GOTO2990
C
 1950 CONTINUE
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IF(GAMMA.LE.0.0)THEN
        WRITE(ICOUT,1951)
 1951   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1952)
 1952   FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA FOR THE ',
     1         'PARETO SECOND KIND DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1953)
 1953   FORMAT('      MUST BE POSITIVE; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1954)GAMMA
 1954   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='A   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        A=1.0
      ELSE
        A=VALUE(ILOCP)
      ENDIF
C
      IF(A.LE.0.0)THEN
        WRITE(ICOUT,1951)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1956)
 1956   FORMAT('      THE SPECIFIED SHAPE PARAMETER A FOR THE ',
     1         'PARETO SECOND KIND DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1957)
 1957   FORMAT('      MUST BE POSITIVE; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1958)A
 1958   FORMAT('      THE SPECIFIED VALUE OF A = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL PA2RAN(NRAN,GAMMA,A,ISEED,Y)
      GOTO2990
C
 1960 CONTINUE
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      P=VALUE(ILOCP)
C
      IF(P.LT.0.0.OR.P.GE.1.0)THEN
        WRITE(ICOUT,1961)
 1961   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1962)
 1962   FORMAT('      THE SPECIFIED SHAPE PARAMETER P FOR THE ',
     1         'WRAPPED CAUCHY DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1964)
 1964   FORMAT('      MUST BE IN THE INTERVAL (0,1]; SUCH WAS NOT THE ',
     1         'CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1966)P
 1966   FORMAT('      THE SPECIFIED VALUE OF P = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL WCARAN(NRAN,P,ISEED,Y)
      GOTO2990
C
 1970 CONTINUE
      IHP='A   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      A=VALUE(ILOCP)
C
      IHP='B   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      B=VALUE(ILOCP)
C
      IHP='C   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      C=VALUE(ILOCP)
C
      IHP='D   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      DZ=VALUE(ILOCP)
C
      IHP='NU1 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU1=VALUE(ILOCP)
C
      IHP='NU3 '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU3=VALUE(ILOCP)
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(A.GT.B .OR. B.GT.C .OR. C.GT.DZ)THEN
        WRITE(ICOUT,1972)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1973)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1974)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1976)A,B,C,DZ
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
 1972 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
 1973 FORMAT(
     1'      THE FOUR SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
 1974 FORMAT(
     1'         A <= B <= C <= D')
 1976 FORMAT(
     1'      A, B, C, D = ',4E15.7)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,1981)
 1981   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1982)
 1982   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE ',
     1         'GENERALIZED TRAPEZOID DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1984)
 1984   FORMAT('      MUST BE POSITIVE; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1986)ALPHA
 1986   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IF(ANU1.LE.0.0)THEN
        WRITE(ICOUT,1991)
 1991   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1992)
 1992   FORMAT('      THE SPECIFIED SHAPE PARAMETER ANU1 FOR THE ',
     1         'GENERALIZED TRAPEZOID DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1994)
 1994   FORMAT('      MUST BE POSITIVE; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1996)ANU1
 1996   FORMAT('      THE SPECIFIED VALUE OF ANU1 = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IF(ANU3.LE.0.0)THEN
        WRITE(ICOUT,2001)
 2001   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2002)
 2002   FORMAT('      THE SPECIFIED SHAPE PARAMETER ANU3 FOR THE ',
     1         'GENERALIZED TRAPEZOID DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2004)
 2004   FORMAT('      MUST BE POSITIVE; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2006)ANU3
 2006   FORMAT('      THE SPECIFIED VALUE OF ANU3 = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL GTRRAN(NRAN,A,B,C,DZ,ANU1,ANU3,ALPHA,ISEED,Y)
      GOTO2990
C
 2010 CONTINUE
      IHP='A   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      A=VALUE(ILOCP)
C
      IHP='B   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      B=VALUE(ILOCP)
C
      IF(A.GT.B)THEN
        ATEMP=A
        A=B
        B=ATEMP
      ENDIF
C
      IHP='MU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      U=VALUE(ILOCP)
C
      IHP='SD  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      SD=VALUE(ILOCP)
C
      IF(A.EQ.B)THEN
        WRITE(ICOUT,2011)
 2011   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2012)
 2012   FORMAT('      FOR THE TRUNCATED NORMAL DISTRIBUTION, THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2014)
 2014   FORMAT('      TRUNCATION BOUNDS A AND B SHOULD NOT BE EQUAL;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2015)
 2015   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2016)A,B
 2016   FORMAT('      THE SPECIFIED VALUES OF A, B = ',2E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IF(SD.LE.0.0)THEN
        WRITE(ICOUT,2021)
 2021   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2022)
 2022   FORMAT('      THE SPECIFIED STANDARD DEVIATION PARAMETER SD')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2024)
 2024   FORMAT('      FOR THE TRUNCATED NORMAL DISTRIBUTION MUST BE ',
     1         'POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2025)
 2025   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2026)SD
 2026   FORMAT('      THE SPECIFIED VALUE OF SD = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL TNRRAN(NRAN,A,B,U,SD,ISEED,Y)
      GOTO2990
C
 2040 CONTINUE
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      NU=VALUE(ILOCP)+EPS
      ANU=REAL(NU)
C
      IF(ANU.LT.0.9999)THEN
        WRITE(ICOUT,2041)
 2041   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2042)
 2042   FORMAT('      THE SPECIFIED INTEGER SHAPE PARAMETER NU FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2044)
 2044   FORMAT('      CHI DISTRIBUTION MUST BE 1 OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2045)
 2045   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2046)NU
 2046   FORMAT('      THE SPECIFIED VALUE OF NU = ',I8)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL CHRAN(NRAN,ANU,ISEED,Y)
      GOTO2990
C
 2050 CONTINUE
      IHP='LOC '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALOC=VALUE(ILOCP)
C
      IHP='SCAL'
      IHP2='E   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ASCALE=VALUE(ILOCP)
C
      IF(ASCALE.LE.0.0)THEN
        WRITE(ICOUT,2051)
 2051   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2052)
 2052   FORMAT('      THE SPECIFIED SCALE PARAMETER SCALE FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2054)
 2054   FORMAT('      FOLDED CAUCHY DISTRIBUTION MUST BE POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2055)
 2055   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2056)ASCALE
 2056   FORMAT('      THE SPECIFIED VALUE OF SCALE  = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL FCARAN(NRAN,ALOC,ASCALE,ISEED,Y)
      GOTO2990
C
 2060 CONTINUE
      IHP='K   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AK=VALUE(ILOCP)
C
      IF(AK.LE.0.0)THEN
        WRITE(ICOUT,2061)
 2061   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2062)
 2062   FORMAT('      THE SPECIFIED SHAPE PARAMETER, K, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2064)
 2064   FORMAT('      MIELKE BETA-KAPPA DISTRIBUTION MUST BE POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2065)
 2065   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2066)AK
 2066   FORMAT('      THE SPECIFIED VALUE OF K      = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,2071)
 2071   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2072)
 2072   FORMAT('      THE SPECIFIED SHAPE PARAMETER, BETA, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2074)
 2074   FORMAT('      MIELKE BETA-KAPPA DISTRIBUTION MUST BE POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2075)
 2075   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2076)BETA
 2076   FORMAT('      THE SPECIFIED VALUE OF BETA   = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='THET'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      THETA=VALUE(ILOCP)
C
      IF(THETA.LE.0.0)THEN
        WRITE(ICOUT,2081)
 2081   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2082)
 2082   FORMAT('      THE SPECIFIED SHAPE PARAMETER, THETA, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2084)
 2084   FORMAT('      MIELKE BETA-KAPPA DISTRIBUTION MUST BE POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2085)
 2085   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2086)THETA
 2086   FORMAT('      THE SPECIFIED VALUE OF THETA  = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL KAPRAN(NRAN,AK,BETA,THETA,ISEED,Y)
      GOTO2990
C
 2090 CONTINUE
      IHP='LAMB'
      IHP2='DA1 '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAM1=VALUE(ILOCP)
C
      IF(ALAM1.LE.0.0)THEN
        WRITE(ICOUT,2091)
 2091   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2092)
 2092   FORMAT('      THE SPECIFIED SHAPE PARAMETER, LAMBDA1, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2094)
 2094   FORMAT('      GENERALIZED EXPONENTIAL DISTRIBUTION MUST BE ',
     1         'POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2095)
 2095   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2096)ALAM1
 2096   FORMAT('      THE SPECIFIED VALUE OF LAMBDA1     = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='LAMB'
      IHP2='DA12'
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAM12=VALUE(ILOCP)
C
      IF(ALAM12.LE.0.0)THEN
        WRITE(ICOUT,2101)
 2101   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2102)
 2102   FORMAT('      THE SPECIFIED SHAPE PARAMETER, LAMBDA12, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2104)
 2104   FORMAT('      GENERALIZED EXPONENTIAL DISTRIBUTION MUST BE ',
     1         'POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2105)
 2105   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2106)ALAM12
 2106   FORMAT('      THE SPECIFIED VALUE OF LAMBDA12    = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='S   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      S=VALUE(ILOCP)
C
      IF(S.LE.0.0)THEN
        WRITE(ICOUT,2111)
 2111   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2112)
 2112   FORMAT('      THE SPECIFIED SHAPE PARAMETER, S, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2114)
 2114   FORMAT('      GENERALIZED EXPONENTIAL DISTRIBUTION MUST BE ',
     1         'POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2115)
 2115   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2116)S
 2116   FORMAT('      THE SPECIFIED VALUE OF S     = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL GEXRAN(NRAN,ALAM12,ALAM12,S,ISEED,Y)
      GOTO2990
C
 2120 CONTINUE
      IHP='X0  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      X0=VALUE(ILOCP)
C
      IF(X0.LE.0.0)THEN
        WRITE(ICOUT,2121)
 2121   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2122)
 2122   FORMAT('      THE SPECIFIED TRUNCATION PARAMETER, X0, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2124)
 2124   FORMAT('      TRUNCATED EXPONENTIAL DISTRIBUTION MUST BE ',
     1         'POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2125)
 2125   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2126)X0
 2126   FORMAT('      THE SPECIFIED VALUE OF X0          = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='M   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        AM=0.0
      ELSE
        AM=VALUE(ILOCP)
      ENDIF
C
      IF(AM.LT.0.0)THEN
        WRITE(ICOUT,2131)
 2131   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2132)
 2132   FORMAT('      THE SPECIFIED LOCATION PARAMETER, M, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2134)
 2134   FORMAT('      TRUNCATED EXPONENTIAL DISTRIBUTION MUST BE ',
     1         'NON-NEGATIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2135)
 2135   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2136)AM
 2136   FORMAT('      THE SPECIFIED VALUE OF M           = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='SD  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        SD=0.0
      ELSE
        SD=VALUE(ILOCP)
      ENDIF
C
      IF(SD.LE.0.0)THEN
        WRITE(ICOUT,2141)
 2141   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2142)
 2142   FORMAT('      THE SPECIFIED SCALE PARAMETER, SD, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2144)
 2144   FORMAT('      TRUNCATED EXPONENTIAL DISTRIBUTION MUST BE ',
     1         'POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2145)
 2145   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2146)SD
 2146   FORMAT('      THE SPECIFIED VALUE OF SD          = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL TNERAN(NRAN,X0,AM,SD,ISEED,Y)
      GOTO2990
C
 2150 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2151)
 2151   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2152)
 2152   FORMAT('      THE SPECIFIED SHAPE PARAMETER, ALPHA, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2154)
 2154   FORMAT('      GENERALIZED GAMMA DISTRIBUTION MUST BE ',
     1         'POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2155)
 2155   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2156)ALPHA
 2156   FORMAT('      THE SPECIFIED VALUE OF ALPHA       = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='C   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      C=VALUE(ILOCP)
C
      IF(C.EQ.0.0)THEN
        WRITE(ICOUT,2161)
 2161   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2162)
 2162   FORMAT('      THE SPECIFIED SHAPE PARAMETER, C, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2164)
 2164   FORMAT('      GENERALIZED GAMMA DISTRIBUTION MUST NOT BE ',
     1         'ZERO;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2165)
 2165   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2166)C
 2166   FORMAT('      THE SPECIFIED VALUE OF C       = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL GGDRAN(NRAN,ALPHA,C,ISEED,Y)
      GOTO2990
C
 2170 CONTINUE
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU=VALUE(ILOCP)
      NU=INT(ANU+0.5)
C
      IF(NU.LT.1)THEN
        WRITE(ICOUT,2171)
 2171   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2172)
 2172   FORMAT('      THE SPECIFIED SHAPE PARAMETER, NU, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2174)
 2174   FORMAT('      FOLDED T DISTRIBUTION MUST BE A POSITIVE ',
     1         'INTEGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2175)
 2175   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2176)NU
 2176   FORMAT('      THE SPECIFIED VALUE OF NU          = ',I8)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL FTRAN(NRAN,NU,ISEED,Y)
      GOTO2990
C
 2180 CONTINUE
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALMBDA=VALUE(ILOCP)
C
      CALL SNRAN(NRAN,ALMBDA,ISKNDF,ISEED,Y)
      GOTO2990
C
 2190 CONTINUE
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU=VALUE(ILOCP)
      NU=INT(ANU+0.5)
C
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALMBDA=VALUE(ILOCP)
C
      IF(NU.LT.1)THEN
        WRITE(ICOUT,2191)
 2191   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2192)
 2192   FORMAT('      THE SPECIFIED SHAPE PARAMETER, NU, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2194)
 2194   FORMAT('      SKEWED T DISTRIBUTION MUST BE A POSITIVE ',
     1         'INTEGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2195)
 2195   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2196)NU
 2196   FORMAT('      THE SPECIFIED VALUE OF NU          = ',I8)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL STRAN(NRAN,NU,ALMBDA,ISEED,Y)
      GOTO2990
C
 2200 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LT.1.0)THEN
        WRITE(ICOUT,2201)
 2201   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2202)
 2202   FORMAT('      THE SPECIFIED SHAPE PARAMETER, ALPHA, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2204)
 2204   FORMAT('      ZIPF DISTRIBUTION MUST BE > 1.  SUCH WAS NOT ',
     1         'THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2206)ALPHA
 2206   FORMAT('      THE SPECIFIED VALUE OF ALPHA        = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL ZIPRAN(NRAN,ALPHA,ISEED,Y)
      GOTO2990
C
 2210 CONTINUE
      IF(IMAKDF.EQ.'DLMF')THEN
        IHP='XI  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        XI=VALUE(ILOCP)
C
        IF(XI.LE.0.0)THEN
          WRITE(ICOUT,2211)
 2211     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2212)
 2212     FORMAT('      THE SPECIFIED SHAPE PARAMETER, XI, FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2214)
 2214     FORMAT('      COMPERTZ-MAKEHAM DISTRIBUTION MUST BE ',
     1           'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2216)XI
 2216     FORMAT('      THE SPECIFIED VALUE OF XI           = ',
     1           G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IHP='LAMB'
        IHP2='DA  '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ALAMB=VALUE(ILOCP)
C
        IF(ALAMB.LE.0.0)THEN
          WRITE(ICOUT,2221)
 2221     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2222)
 2222     FORMAT('      THE SPECIFIED SHAPE PARAMETER, LAMBDA, ',
     1           'FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2224)
 2224     FORMAT('      COMPERTZ-MAKEHAM DISTRIBUTION MUST BE ',
     1           'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2226)ALAMB
 2226     FORMAT('      THE SPECIFIED VALUE OF ALAMB        = ',
     1           G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IHP='THET'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        THETA=VALUE(ILOCP)
C
        IF(THETA.LT.0.0)THEN
          WRITE(ICOUT,2231)
 2231     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2232)
 2232     FORMAT('      THE SPECIFIED SHAPE PARAMETER, THETA, ',
     1           'FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2234)
 2234     FORMAT('      COMPERTZ-MAKEHAM DISTRIBUTION MUST BE ',
     1           'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2236)THETA
 2236     FORMAT('      THE SPECIFIED VALUE OF THETA        = ',
     1           G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        CALL MAKRAN(NRAN,XI,ALAMB,THETA,ISEED,Y)
      ELSEIF(IMAKDF.EQ.'MEEK')THEN
        IHP='GAMM'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GAMMA=VALUE(ILOCP)
C
        IF(GAMMA.LE.0.0)THEN
          WRITE(ICOUT,22211)
22211     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22212)
22212     FORMAT('      THE SPECIFIED SHAPE PARAMETER, GAMMA, FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22214)
22214     FORMAT('      COMPERTZ-MAKEHAM DISTRIBUTION MUST BE ',
     1           'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22216)GAMMA
22216     FORMAT('      THE SPECIFIED VALUE OF GAMMA           = ',
     1           G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IHP='LAMB'
        IHP2='DA  '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ALAMB=VALUE(ILOCP)
C
        IF(ALAMB.LT.0.0)THEN
          WRITE(ICOUT,22221)
22221     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22222)
22222     FORMAT('      THE SPECIFIED SHAPE PARAMETER, LAMBDA, ',
     1           'FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22224)
22224     FORMAT('      COMPERTZ-MAKEHAM DISTRIBUTION MUST BE ',
     1           'NON-NEGATIVE.   SUCH WAS NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22226)ALAMB
22226     FORMAT('      THE SPECIFIED VALUE OF ALAMB        = ',
     1           G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IHP='K   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        AK=VALUE(ILOCP)
C
        IF(AK.LE.0.0)THEN
          WRITE(ICOUT,22231)
22231     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22232)
22232     FORMAT('      THE SPECIFIED SHAPE PARAMETER, K, ',
     1           'FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22234)
22234     FORMAT('      COMPERTZ-MAKEHAM DISTRIBUTION MUST BE ',
     1           'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22236)AK
22236     FORMAT('      THE SPECIFIED VALUE OF K        = ',
     1           G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        XI=GAMMA/AK
        THETA=ALAMB/GAMMA
        ALAMB=AK
        CALL MAKRAN(NRAN,XI,ALAMB,THETA,ISEED,Y)
      ELSEIF(IMAKDF.EQ.'REPA')THEN
C
        IHP='ZETA'
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ZETA=VALUE(ILOCP)
C
        IHP='ETA '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ETA=VALUE(ILOCP)
C
        IF(ETA.LT.0.0)THEN
          WRITE(ICOUT,32231)
32231     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,32232)
32232     FORMAT('      THE SPECIFIED SHAPE PARAMETER, ETA, ',
     1           'FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,32234)
32234     FORMAT('      COMPERTZ-MAKEHAM DISTRIBUTION MUST BE ',
     1           'NON-NEGATIVE.   SUCH WAS NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,32236)ETA
32236     FORMAT('      THE SPECIFIED VALUE OF ETA         = ',
     1           G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        CALL MA2RAN(NRAN,ZETA,ETA,ISEED,Y)
      ENDIF
      GOTO2990
C
 2240 CONTINUE
      IHP='CHI '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      CHI=VALUE(ILOCP)
C
      IF(CHI.LE.0.0)THEN
        WRITE(ICOUT,2241)
 2241   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2242)
 2242   FORMAT('      THE SPECIFIED SHAPE PARAMETER, CHI, FOR THE ',
     1         'GENERALIZE INVERSE GAUSSIAN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2244)
 2244   FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS NOT ',
     1         'THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2246)CHI
 2246   FORMAT('      THE SPECIFIED VALUE OF CHI          = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB=VALUE(ILOCP)
C
      IF(ALAMB.LE.0.0)THEN
        WRITE(ICOUT,2251)
 2251   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2252)
 2252   FORMAT('      THE SPECIFIED SHAPE PARAMETER, LAMBDA, FOR ',
     1         'THE GENERALIZED INVERSE GAUSSIAN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2254)
 2254   FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS NOT ',
     1         'THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2256)ALAMB
 2256   FORMAT('      THE SPECIFIED VALUE OF ALAMB        = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='THET'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      THETA=VALUE(ILOCP)
C
      IF(THETA.LT.0.0)THEN
        WRITE(ICOUT,2261)
 2261   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2262)
 2262   FORMAT('      THE SPECIFIED SHAPE PARAMETER, LAMBDA, FOR THE',
     1         ' GENERALIZED INVERSE GAUSSIAN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2264)
 2264   FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS NOT ',
     1         'THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2266)THETA
 2266   FORMAT('      THE SPECIFIED VALUE OF THETA        = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL GIGRAN(NRAN,CHI,ALAMB,THETA,ISEED,Y)
      GOTO2990
C
 2270 CONTINUE
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALMBDA=VALUE(ILOCP)
C
CCCCC DEFAULT SD PARAMETER TO 1
C
      IHP='SD  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        SD=1.0
      ELSE
        SD=VALUE(ILOCP)
      ENDIF
C
      IF(SD.LE.0.0)THEN
        WRITE(ICOUT,2271)
 2271   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2272)
 2272   FORMAT('      THE SPECIFIED SHAPE PARAMETER, SD, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2274)
 2274   FORMAT('      LOG-SKEW-NORMAL DISTRIBUTION MUST BE ',
     1         'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2276)SD
 2276   FORMAT('      THE SPECIFIED VALUE OF SD        = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL LSNRAN(NRAN,ALMBDA,SD,ISEED,Y)
      GOTO2990
C
 2280 CONTINUE
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALMBDA=VALUE(ILOCP)
C
CCCCC DEFAULT SD PARAMETER TO 1
C
      IHP='SD  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        SD=1.0
      ELSE
        SD=VALUE(ILOCP)
      ENDIF
C
      IF(SD.LE.0.0)THEN
        WRITE(ICOUT,2281)
 2281   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2282)
 2282   FORMAT('      THE SPECIFIED SHAPE PARAMETER, SD, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2284)
 2284   FORMAT('      LOG-SKEW-T DISTRIBUTION MUST BE ',
     1         'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2286)SD
 2286   FORMAT('      THE SPECIFIED VALUE OF SD        = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      NU=INT(VALUE(ILOCP)+0.5)
C
      IF(NU.LE.0)THEN
        WRITE(ICOUT,2291)
 2291   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2292)
 2292   FORMAT('      THE SPECIFIED SHAPE PARAMETER, NU, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2294)
 2294   FORMAT('      LOG-SKEW-T DISTRIBUTION MUST BE ',
     1         'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2296)NU
 2296   FORMAT('      THE SPECIFIED VALUE OF NU        = ',I8)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      CALL LSTRAN(NRAN,NU,ALMBDA,SD,ISEED,Y)
      GOTO2990
C
 2300 CONTINUE
C
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      ALAMB=VALUE(ILOCP)
C
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU=VALUE(ILOCP)
C
      IF(ANU.LE.0.0)THEN
        WRITE(ICOUT,2301)
 2301   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2302)
 2302   FORMAT('      THE SPECIFIED SHAPE PARAMETER, NU, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2304)
 2304   FORMAT('      NON-CENTRAL T DISTRIBUTION MUST BE ',
     1         'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2306)ANU
 2306   FORMAT('      THE SPECIFIED VALUE OF NU        = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL NCTRAN(NRAN,ANU,ALAMB,ISEED,Y)
      GOTO2990
C
 2310 CONTINUE
      IHP='LAMB'
      IHP2='DA1 '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB1=VALUE(ILOCP)
C
      IHP='LAMB'
      IHP2='DA2 '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      ALAMB2=VALUE(ILOCP)
C
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU=VALUE(ILOCP)
C
      IF(ANU.LE.0.0)THEN
        WRITE(ICOUT,2311)
 2311   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2312)
 2312   FORMAT('      THE SPECIFIED SHAPE PARAMETER, NU, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2314)
 2314   FORMAT('      DOUBLY NON-CENTRAL T DISTRIBUTION MUST BE ',
     1         'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2316)ANU
 2316   FORMAT('      THE SPECIFIED VALUE OF ANU        = ',F12.5)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      CALL DNTRAN(NRAN,ANU,ALAMB1,ALAMB2,ISEED,Y)
      GOTO2990
C
 2330 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2331)
 2331   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2332)
 2332   FORMAT('      THE SPECIFIED SHAPE PARAMETER, ALPHA, FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2334)
 2334   FORMAT('      GENERALIZED LOGISTIC DISTRIBUTION MUST BE ',
     1         'POSITIVE.   SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2336)ALPHA
 2336   FORMAT('      THE SPECIFIED VALUE OF ALPHA     = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      CALL GLORAN(NRAN,ALPHA,ISEED,Y)
      GOTO2990
C
 2340 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2341)
 2341   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2342)
 2342   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2343)IDIST
 2343   FORMAT('      FOR THE HERMITE DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2344)
 2344   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2345)
 2345   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2346)ALPHA
 2346   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,2351)
 2351   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2352)
 2352   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2353)IDIST
 2353   FORMAT('      FOR THE ',A26)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2354)
 2354   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2355)
 2355   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2356)BETA
 2356   FORMAT('      THE SPECIFIED VALUE OF BETA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL HERRAN(ALPHA,BETA,NRAN,ISEED,Y)
      GOTO2990
C
 2360 CONTINUE
C
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      P=VALUE(ILOCP)
C
      IF(P.LT.0.1)THEN
        WRITE(ICOUT,2361)
 2361   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2362)
 2362   FORMAT('      THE SPECIFIED SHAPE PARAMETER P')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2363)IDIST
 2363   FORMAT('      FOR THE YULE DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2364)
 2364   FORMAT('      MUST BE >= 0.1;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2366)P
 2366   FORMAT('      THE SPECIFIED VALUE OF P = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL YULRAN(NRAN,P,ISEED,Y)
      GOTO2990
C
 2370 CONTINUE
C
      IHP='A   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      A=VALUE(ILOCP)
C
      IF(A.LE.0.0)THEN
        WRITE(ICOUT,2371)
 2371   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2372)
 2372   FORMAT('      THE SPECIFIED SHAPE PARAMETER A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2373)IDIST
 2373   FORMAT('      FOR THE WARING DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2374)
 2374   FORMAT('      MUST BE > 0;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2375)A
 2375   FORMAT('      THE SPECIFIED VALUE OF A = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='C   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      C=VALUE(ILOCP)
C
      IF(C.LE.0.0)THEN
        WRITE(ICOUT,2376)
 2376   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2377)
 2377   FORMAT('      THE SPECIFIED SHAPE PARAMETER A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2378)
 2378   FORMAT('      FOR THE WARING DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2379)
 2379   FORMAT('      MUST BE > 0;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2380)C
 2380   FORMAT('      THE SPECIFIED VALUE OF C = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IF(C.LE.A)THEN
        WRITE(ICOUT,2381)
 2381   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2382)
 2382   FORMAT('      THE SPECIFIED SHAPE PARAMETER C MUST BE GREATER')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2383)
 2383   FORMAT('      THAN THE SPECIFIED PARAMETER A FOR THE WARING ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2384)
 2384   FORMAT('      DISTRIBUTION;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2386)C
 2386   FORMAT('      THE SPECIFIED VALUE OF C = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2387)A
 2387   FORMAT('      THE SPECIFIED VALUE OF A = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      B=1.0
      CALL GWARAN(NRAN,A,B,C,ISEED,Y)
      GOTO2990
C
 2390 CONTINUE
C
      IHP='A   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      A=VALUE(ILOCP)
C
      IF(A.LE.0.0)THEN
        WRITE(ICOUT,2391)
 2391   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2392)
 2392   FORMAT('      THE SPECIFIED SHAPE PARAMETER A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2393)IDIST
 2393   FORMAT('      FOR THE GENERALIZED WARING DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2394)
 2394   FORMAT('      MUST BE > 0;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2396)A
 2396   FORMAT('      THE SPECIFIED VALUE OF A = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='B   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      B=VALUE(ILOCP)
C
      IF(B.LE.0.0)THEN
        WRITE(ICOUT,2401)
 2401   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2402)
 2402   FORMAT('      THE SPECIFIED SHAPE PARAMETER A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2403)IDIST
 2403   FORMAT('      FOR THE GENERALIZED WARING DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2404)
 2404   FORMAT('      MUST BE >= 0;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2406)B
 2406   FORMAT('      THE SPECIFIED VALUE OF B = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='C   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      C=VALUE(ILOCP)
C
      IF(C.LE.0.0)THEN
        WRITE(ICOUT,2411)
 2411   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2412)
 2412   FORMAT('      THE SPECIFIED SHAPE PARAMETER C')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2413)IDIST
 2413   FORMAT('      FOR THE GENERALIZED WARING DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2414)
 2414   FORMAT('      MUST BE > 0;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2416)C
 2416   FORMAT('      THE SPECIFIED VALUE OF A = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL GWARAN(NRAN,A,B,C,ISEED,Y)
      GOTO2990
C
 2420 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2421)
 2421   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2422)
 2422   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2423)
 2423   FORMAT('      FOR THE NON-CENTRAL BETA DISTRIBUTION MUST BE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2424)
 2424   FORMAT('      POSITIVE;  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2426)ALPHA
 2426   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,2431)
 2431   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2432)
 2432   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2433)
 2433   FORMAT('      FOR THE NON-CENTRAL BETA DISTRIBUTION MUST BE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2434)
 2434   FORMAT('      POSITIVE;  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2436)BETA
 2436   FORMAT('      THE SPECIFIED VALUE OF BETA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB=VALUE(ILOCP)
C
      IF(ALAMB.LE.0.0)THEN
        WRITE(ICOUT,2441)
 2441   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2442)
 2442   FORMAT('      THE SPECIFIED NON-CENTRALITY PARAMETER LAMBDA ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2443)
 2443   FORMAT('      FOR THE NON-CENTRAL BETA DISTRIBUTION MUST BE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2444)
 2444   FORMAT('      POSITIVE;  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2446)ALAMB
 2446   FORMAT('      THE SPECIFIED VALUE OF LAMBDA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL NCBRAN(NRAN,ALPHA,BETA,ALAMB,ISEED,Y)
      GOTO2990
C
 2450 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2451)
 2451   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2452)
 2452   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2453)
 2453   FORMAT('      FOR THE DOUBLY NON-CENTRAL BETA DISTRIBUTION ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2454)
 2454   FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2456)ALPHA
 2456   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,2461)
 2461   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2462)
 2462   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2463)
 2463   FORMAT('      FOR THE DOUBLY NON-CENTRAL BETA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2464)
 2464   FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2466)BETA
 2466   FORMAT('      THE SPECIFIED VALUE OF BETA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='LAMB'
      IHP2='DA1 '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB1=VALUE(ILOCP)
C
      IF(ALAMB1.LE.0.0)THEN
        WRITE(ICOUT,2471)
 2471   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2472)
 2472   FORMAT('      THE SPECIFIED NON-CENTRALITY PARAMETER LAMBDA1')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2473)
 2473   FORMAT('      FOR THE DOUBLY NON-CENTRAL BETA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2474)
 2474   FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2476)ALAMB1
 2476   FORMAT('      THE SPECIFIED VALUE OF LAMBDA1 = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='LAMB'
      IHP2='DA2 '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALAMB2=VALUE(ILOCP)
C
      IF(ALAMB2.LE.0.0)THEN
        WRITE(ICOUT,2481)
 2481   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2482)
 2482   FORMAT('      THE SPECIFIED NON-CENTRALITY PARAMETER LAMBDA2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2483)
 2483   FORMAT('      FOR THE DOUBLY NON-CENTRAL BETA DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2484)
 2484   FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2486)ALAMB2
 2486   FORMAT('      THE SPECIFIED VALUE OF LAMBDA2 = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL DNBRAN(NRAN,ALPHA,BETA,ALAMB1,ALAMB2,ISEED,Y)
      GOTO2990
C
 2490 CONTINUE
      IHP='LAMB'
      IHP2='DA  '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALMBDA=VALUE(ILOCP)
C
      IF(ALMBDA.LT.0.0)THEN
        WRITE(ICOUT,2491)
 2491   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2492)
 2492   FORMAT('      THE SPECIFIED SHAPE PARAMETER LAMBDA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2493)
 2493   FORMAT('      FOR THE SKEW DOUBLE EXPONENTIAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2494)
 2494   FORMAT('      MUST BE NON-NEGATIVE;  SUCH WAS NOT THE CASE ',
     1         'HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2496)ALMBDA
 2496   FORMAT('      THE SPECIFIED VALUE OF LAMBDA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL SDERAN(NRAN,ALMBDA,ISEED,Y)
      GOTO2990
C
 2500 CONTINUE
      IF(IADEDF.EQ.'K')THEN
        IHP='K   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        AK=VALUE(ILOCP)
C
        IF(AK.LE.0.0)THEN
          WRITE(ICOUT,2501)
 2501     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2502)
 2502     FORMAT('      THE SPECIFIED SHAPE PARAMETER K FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2503)
 2503     FORMAT('      ASYMMETIC DOUBLE EXPONENTIAL DISTRIBUTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2504)
 2504     FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE ',
     1           'HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2506)AK
 2506     FORMAT('      THE SPECIFIED VALUE OF K = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        CALL ADERAN(NRAN,AK,IADEDF,ISEED,Y)
      ELSE
        IHP='MU  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        AMU=VALUE(ILOCP)
        CALL ADERAN(NRAN,AMU,IADEDF,ISEED,Y)
      ENDIF
      GOTO2990
C
 2520 CONTINUE
C
      IHP='SIGM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        SIGMA=1.0
      ELSE
        SIGMA=VALUE(ILOCP)
      ENDIF
C
      IF(SIGMA.LE.0.0)THEN
        WRITE(ICOUT,2521)
 2521   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2522)
 2522   FORMAT('      THE SPECIFIED SHAPE PARAMETER SIGMA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2523)
 2523   FORMAT('      MAXWELL DISTRIBUTION MUST BE POSITIVE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2525)
 2525   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2526)SIGMA
 2526   FORMAT('      THE SPECIFIED VALUE OF SIGMA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL MAXRAN(NRAN,SIGMA,ISEED,Y)
      GOTO2990
C
 2530 CONTINUE
C
      CALL RAYRAN(NRAN,ISEED,Y)
      GOTO2990
C
 2540 CONTINUE
CCCCC IF(IADEDF.EQ.'K')THEN
        IHP='K   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        AK=VALUE(ILOCP)
C
        IF(AK.LE.0.0)THEN
          WRITE(ICOUT,2541)
 2541     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2542)
 2542     FORMAT('      THE SPECIFIED SHAPE PARAMETER K FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2543)
 2543     FORMAT('      GENERALIZED ASYMMETIC DOUBLE EXPONENTIAL ',
     1           'DISTRIBUTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2544)
 2544     FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE ',
     1           'HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2546)AK
 2546     FORMAT('      THE SPECIFIED VALUE OF K = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IHP='TAU '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        TAU=VALUE(ILOCP)
C
        IF(TAU.LE.0.0)THEN
          WRITE(ICOUT,2551)
 2551     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2552)
 2552     FORMAT('      THE SPECIFIED SHAPE PARAMETER TAU FOR THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2553)
 2553     FORMAT('      GENERALIZED ASYMMETIC DOUBLE EXPONENTIAL ',
     1           'DISTRIBUTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2554)
 2554     FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE ',
     1           'HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2556)TAU
 2556     FORMAT('      THE SPECIFIED VALUE OF TAU = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        CALL GALRAN(NRAN,AK,TAU,IADEDF,ISEED,Y)
CCCCC ELSE
CCCCC   IHP='MU  '
CCCCC   IHP2='    '
CCCCC   IHWUSE='P'
CCCCC   MESSAG='YES'
CCCCC   CALL CHECKN(IHP,IHP2,IHWUSE,
CCCCC1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
CCCCC1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
CCCCC   IF(IERROR.EQ.'YES')GOTO9000
CCCCC   AMU=VALUE(ILOCP)
CCCCC   CALL ADERAN(NRAN,AMU,IADEDF,ISEED,Y)
CCCCC ENDIF
      GOTO2990
C
 2560 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      CALL MCLRAN(NRAN,ALPHA,ISEED,Y)
      GOTO2990
C
 2570 CONTINUE
      IF(IBEIDF.EQ.'1')THEN
        IHP='SIGM'
        IHP2='A1SQ'
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        S1SQ=VALUE(ILOCP)
C
        IF(S1SQ.LE.0.0)THEN
          WRITE(ICOUT,2571)
 2571     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2572)
 2572     FORMAT('      THE SPECIFIED SHAPE PARAMETER, SIGMA1SQ, FOR ',
     1         'THE BESSEL I-FUNCTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2574)
 2574     FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS ',
     1           'NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2576)S1SQ
 2576     FORMAT('      THE SPECIFIED VALUE OF SIGMA1SQ     = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IHP='SIGM'
        IHP2='A2SQ'
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        S2SQ=VALUE(ILOCP)
C
        IF(S2SQ.LE.0.0)THEN
          WRITE(ICOUT,2581)
 2581     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2582)
 2582     FORMAT('      THE SPECIFIED SHAPE PARAMETER, SIGMA1SQ, FOR ',
     1           'THE BESSEL I-FUNCTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2584)
 2584     FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS ',
     1         'NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2586)S2SQ
 2586     FORMAT('      THE SPECIFIED VALUE OF SIGMA1SQ     = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IHP='NU  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ANU=VALUE(ILOCP)
C
        IF(ANU.LE.0.0)THEN
          WRITE(ICOUT,2591)
 2591     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2592)
 2592     FORMAT('      THE SPECIFIED SHAPE PARAMETER, NU, FOR ',
     1         'THE BESSEL I-FUNCTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2594)
 2594     FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS ',
     1         'NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2596)ANU
 2596     FORMAT('      THE SPECIFIED VALUE OF NU           = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        CALL BEIRAN(NRAN,S1SQ,S2SQ,ANU,IBEIDF,ISEED,Y)
        GOTO2990
      ELSE
        IHP='B   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        B=VALUE(ILOCP)
C
        IF(B.LE.0.0)THEN
          WRITE(ICOUT,22571)
22571     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22572)
22572     FORMAT('      THE SPECIFIED SHAPE PARAMETER, B, FOR ',
     1         'THE BESSEL I-FUNCTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22574)
22574     FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS ',
     1           'NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22576)B
22576     FORMAT('      THE SPECIFIED VALUE OF B            = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IHP='C   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        C=VALUE(ILOCP)
C
        IF(C.LE.0.0)THEN
          WRITE(ICOUT,22581)
22581     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22582)
22582     FORMAT('      THE SPECIFIED SHAPE PARAMETER, C, FOR ',
     1           'THE BESSEL I-FUNCTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22584)
22584     FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS ',
     1         'NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22586)C
22586     FORMAT('      THE SPECIFIED VALUE OF C            = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IHP='M   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        AM=VALUE(ILOCP)
C
        IF(AM.LE.0.5)THEN
          WRITE(ICOUT,22591)
22591     FORMAT('***** ERROR IN DPRAND--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22592)
22592     FORMAT('      THE SPECIFIED SHAPE PARAMETER, M, FOR ',
     1         'THE BESSEL I-FUNCTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22594)
22594     FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS ',
     1         'NOT THE CASE HERE;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,22596)AM
22596     FORMAT('      THE SPECIFIED VALUE OF M            = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        CALL BEIRAN(NRAN,B,C,AM,IBEIDF,ISEED,Y)
        GOTO2990
      ENDIF
C
 2600 CONTINUE
      IHP='SIGM'
      IHP2='A1SQ'
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      S1SQ=VALUE(ILOCP)
C
      IF(S1SQ.LE.0.0)THEN
        WRITE(ICOUT,2601)
 2601   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2602)
 2602   FORMAT('      THE SPECIFIED SHAPE PARAMETER, SIGMA1SQ, FOR ',
     1         'THE BESSEL K-FUNCTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2604)
 2604   FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS NOT ',
     1         'THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2606)S1SQ
 2606   FORMAT('      THE SPECIFIED VALUE OF SIGMA1SQ     = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='SIGM'
      IHP2='A2SQ'
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      S2SQ=VALUE(ILOCP)
C
      IF(S2SQ.LE.0.0)THEN
        WRITE(ICOUT,2611)
 2611   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2612)
 2612   FORMAT('      THE SPECIFIED SHAPE PARAMETER, SIGMA1SQ, FOR ',
     1         'THE BESSEL K-FUNCTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2614)
 2614   FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS NOT ',
     1         'THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2616)S2SQ
 2616   FORMAT('      THE SPECIFIED VALUE OF SIGMA1SQ     = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='NU  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ANU=VALUE(ILOCP)
C
      IF(ANU.LE.0.0)THEN
        WRITE(ICOUT,2621)
 2621   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2622)
 2622   FORMAT('      THE SPECIFIED SHAPE PARAMETER, NU, FOR ',
     1         'THE BESSEL I-FUNCTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2624)
 2624   FORMAT('      DISTRIBUTION MUST BE POSITIVE.   SUCH WAS NOT ',
     1         'THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2626)ANU
 2626   FORMAT('      THE SPECIFIED VALUE OF NU           = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
CCCCC CALL BEKRAN(NRAN,S1SQ,S2SQ,ANU,ISEED,Y)
      GOTO2990
C
 2630 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2631)
 2631   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2632)
 2632   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2633)
 2633   FORMAT('      FOR THE GENERALIZED MCLEISH DISTRIBUTION ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2634)
 2634   FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2636)ALPHA
 2636   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='A   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      A=VALUE(ILOCP)
C
      IF(ABS(A).GE.1.0)THEN
        WRITE(ICOUT,2641)
 2641   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2642)
 2642   FORMAT('      THE ABSOLUTE VALUE OF THE SPECIFIED SHAPE ',
     1         'PARAMETER A FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2643)
 2643   FORMAT('      FOR THE GENERALIZED MCLEISH DISTRIBUTION ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2644)
 2644   FORMAT('      MUST BE LESS THAN 1;  SUCH WAS NOT THE CASE ',
     1         'HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2646)A
 2646   FORMAT('      THE SPECIFIED VALUE OF A = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL GMCRAN(NRAN,ALPHA,A,ISEED,Y)
      GOTO2990
C
 2650 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2651)
 2651   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2652)
 2652   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2653)
 2653   FORMAT('      FOR THE HYPERBOLIC DISTRIBUTION ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2654)
 2654   FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2656)ALPHA
 2656   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='XI  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      XI=VALUE(ILOCP)
C
      IF(XI.LE.0.0)THEN
        WRITE(ICOUT,2661)
 2661   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2662)
 2662   FORMAT('      THE SPECIFIED SHAPE PARAMETER XI FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2663)
 2663   FORMAT('      FOR THE HYPERBOLIC DISTRIBUTION ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2664)
 2664   FORMAT('      MUST BE POSITIVE;  SUCH WAS NOT THE CASE ',
     1         'HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2666)XI
 2666   FORMAT('      THE SPECIFIED VALUE OF XI = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
CCCCC CALL HBORAN(NRAN,ALPHA,XI,ISEED,Y)
      GOTO2990
C
 2670 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      CALL GL5RAN(NRAN,ALPHA,ISEED,Y)
      GOTO2990
C
 2680 CONTINUE
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IHP='GAMM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GAMMA=VALUE(ILOCP)
C
      IHP='DELT'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      DELTA=VALUE(ILOCP)
C
      IFLAG=0
      SCALE=1.0
      IF(BETA+DELTA.LE.0.0.AND.
     1   (BETA.NE.0.0.OR.GAMMA.NE.0.0.OR.DELTA.NE.0.0))IFLAG=1
      IF(SCALE.EQ.0.0.AND.BETA.NE.0.0)IFLAG=1
      IF(GAMMA.EQ.0.0.AND.DELTA.NE.0.0)IFLAG=1
      IF(GAMMA.LT.0.0.OR.SCALE+GAMMA.LT.0.0)IFLAG=1
      IF(SCALE.EQ.0.0.AND.GAMMA.EQ.0.0)IFLAG=1
C
      IF(IFLAG.EQ.1)THEN
        WRITE(ICOUT,2681)
 2681   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2682)
 2682   FORMAT('      THE VALUES FOR THE SPECIFIED SHAPE PARAMETERS ',
     1         'BETA, GAMMA, AND DELTA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2683)
 2683   FORMAT('      ARE INVALID FOR THE WAKEBY DISTRIBUTION.  THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2684)
 2684   FORMAT('      FOLLOWING CONDITIONS ARE INVALID:')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2686)
 2686   FORMAT('      1. BETA + DELTA <= 0 AND')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2688)
 2688   FORMAT('         BETA <> 0 OR GAMMA <>0 OR DELTA <>0')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2690)
 2690   FORMAT('      2. SCALE = 0 AND BETA <> 0')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2692)
 2692   FORMAT('      3. GAMMA = 0 AND DELTA <> 0')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2694)
 2694   FORMAT('      4. GAMMA < 0 OR SCALE + GAMMA < 0')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2696)
 2696   FORMAT('      5. SCALE = 0 AND GAMMA = 0')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2697)ALPHA
 2697   FORMAT('      THE SPECIFIED VALUE OF BETA  = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2698)GAMMA
 2698   FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2699)DELTA
 2699   FORMAT('      THE SPECIFIED VALUE OF DELTA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL WAKRAN(NRAN,BETA,GAMMA,DELTA,ISEED,Y)
      GOTO2990
C
 2700 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2701)
 2701   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2702)
 2702   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE ',
     1         'BETA-NORMAL')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2704)
 2704   FORMAT('      DISTRIBUTION MUST BE POSITIVE;  SUCH WAS ',
     1         'NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2706)ALPHA
 2706   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,2711)
 2711   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2712)
 2712   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA FOR THE ',
     1         'BETA-NORMAL')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2714)
 2714   FORMAT('      DISTRIBUTION MUST BE POSITIVE;  SUCH WAS ',
     1         'NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2716)BETA
 2716   FORMAT('      THE SPECIFIED VALUE OF BETA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL BNORAN(NRAN,ALPHA,BETA,ISEED,Y)
      GOTO2990
C
 2720 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2721)
 2721   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2722)
 2722   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE ',
     1         'GENERALIZED LOGISTIC (TYPE 2)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2724)
 2724   FORMAT('      DISTRIBUTION MUST BE POSITIVE;  SUCH WAS ',
     1         'NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2726)ALPHA
 2726   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL GL2RAN(NRAN,ALPHA,ISEED,Y)
      GOTO2990
C
 2730 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2731)
 2731   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2732)
 2732   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE ',
     1         'GENERALIZED LOGISTIC (TYPE 3)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2734)
 2734   FORMAT('      DISTRIBUTION MUST BE POSITIVE;  SUCH WAS ',
     1         'NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2736)ALPHA
 2736   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL GL3RAN(NRAN,ALPHA,ISEED,Y)
      GOTO2990
C
 2740 CONTINUE
C
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      P=VALUE(ILOCP)
C
      IHP='Q   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      Q=VALUE(ILOCP)
C
      IF(P.LE.0.0)THEN
        WRITE(ICOUT,2741)
 2741   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2742)
 2742   FORMAT('      THE SPECIFIED SHAPE PARAMETER P FOR THE ',
     1         'GENERALIZED LOGISTIC (TYPE 4)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2744)
 2744   FORMAT('      DISTRIBUTION MUST BE POSITIVE;  SUCH WAS ',
     1         'NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2746)ALPHA
 2746   FORMAT('      THE SPECIFIED VALUE OF P     = ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(Q.LE.0.0)THEN
        WRITE(ICOUT,2751)
 2751   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2752)
 2752   FORMAT('      THE SPECIFIED SHAPE PARAMETER Q FOR THE ',
     1         'GENERALIZED LOGISTIC (TYPE 4)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2754)
 2754   FORMAT('      DISTRIBUTION MUST BE POSITIVE;  SUCH WAS ',
     1         'NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2756)ALPHA
 2756   FORMAT('      THE SPECIFIED VALUE OF Q     = ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL GL4RAN(NRAN,P,Q,ISEED,Y)
      GOTO2990
C
 2770 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,2771)
 2771   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2772)
 2772   FORMAT('      THE SPECIFIED SHAPE PARAMETER ALPHA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2773)
 2773   FORMAT('      ASYMMETRIC LOG DOUBLE EXPONENTIAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2774)
 2774   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2775)
 2775   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2776)ALPHA
 2776   FORMAT('      THE SPECIFIED VALUE OF ALPHA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      IHP='BETA'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      BETA=VALUE(ILOCP)
C
      IF(BETA.LE.0.0)THEN
        WRITE(ICOUT,2781)
 2781   FORMAT('***** ERROR IN DPRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2782)
 2782   FORMAT('      THE SPECIFIED SHAPE PARAMETER BETA FOR THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2783)
 2783   FORMAT('      ASYMMETRIC LOG DOUBLE EXPONENTIAL DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2784)
 2784   FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2785)
 2785   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2786)BETA
 2786   FORMAT('      THE SPECIFIED VALUE OF BETA = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      CALL ALDRAN(NRAN,ALPHA,BETA,ISEED,Y)
      GOTO2990
C
 2990 CONTINUE
C
C               ******************************************************
C               **  STEP 8--                                        **
C               **  IF CALLED FOR (THAT IS, IF IBUGA3 IS ON),       **
C               **  PRINT OUT THE INTERMEDIATE VARIABLE Y(.).       **
C               **  THIS IS USEFUL FOR DIAGNOSTIC PURPOSES          **
C               **  IN REVIEWING THE OUTPUT FROM THIS SUBROUTINE.   **
C               ******************************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO3090
      WRITE(ICOUT,3051)
 3051 FORMAT('OUTPUT FROM MIDDLE OF DPRAND AFTER ALL XXXRAN ',
     1'HAVE BEEN CALLED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3052)NRAN
 3052 FORMAT('NRAN = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NRAN.LE.0)GOTO3090
      DO3054I=1,NRAN
      WRITE(ICOUT,3055)I,Y(I)
 3055 FORMAT('I,Y(I) = ',I8,F12.5)
      CALL DPWRST('XXX','BUG ')
 3054 CONTINUE
C
 3090 CONTINUE
C
C               ******************************************************
C               **  STEP 9--                                        **
C               **  COPY THE RANDOM NUMBERS                         **
C               **  FROM THE INTERMEDIATE VECTOR Y(.)               **
C               **  TO THE APPROPRIATE COLUMN                       **
C               **  (BASED ON THE QUALIFIER--FULL, SUBSET, OR FOR)  **
C               **  IN THE INTERNAL DATAPLOT DATA TABLE.            **
C               ******************************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS2=0
      DO3100I=1,NIISUB
      IJ=MAXN*(ICOLL-1)+I
      IF(ISUB(I).EQ.0)GOTO3100
      NS2=NS2+1
      IF(ICOLL.LE.MAXCOL)V(IJ)=Y(NS2)
      IF(ICOLL.EQ.MAXCP1)PRED(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP2)RES(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=Y(NS2)
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 3100 CONTINUE
C
C               *******************************************
C               **  STEP 10--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING.   **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO')NINEW=NLEFT
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'YES')NINEW=MAXN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
C
      IHNAME(ILISTL)=ILEFT
      IHNAM2(ILISTL)=ILEFT2
      IUSE(ILISTL)='V'
      IVALUE(ILISTL)=ICOLL
      VALUE(ILISTL)=ICOLL
      IN(ILISTL)=NINEW
C
CCCCC IUSE(ICOLL)='V'
CCCCC IVALUE(ICOLL)=ICOLL
CCCCC VALUE(ICOLL)=ICOLL
CCCCC IN(ICOLL)=NINEW
C
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM.EQ.'YES')NUMCOL=NUMCOL+1
C
      DO4100J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO4105
      GOTO4100
 4105 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
 4100 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO4059
      IF(IFEEDB.EQ.'OFF')GOTO4059
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4011)ILEFT,ILEFT2,NS2
 4011 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL-1)+IROW1
      IF(ICOLL.LE.MAXCOL)THEN
         WRITE(ICOUT,4021)ILEFT,ILEFT2,V(IJ),IROW1
 4021    FORMAT('THE FIRST           COMPUTED VALUE OF ',
     1   A4,A4,' = ',E15.7,'   (ROW ',I6,')')
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP1)THEN
         WRITE(ICOUT,4021)ILEFT,ILEFT2,PRED(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP2)THEN
         WRITE(ICOUT,4021)ILEFT,ILEFT2,RES(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP3)THEN
         WRITE(ICOUT,4021)ILEFT,ILEFT2,YPLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP4)THEN
         WRITE(ICOUT,4021)ILEFT,ILEFT2,XPLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP5)THEN
         WRITE(ICOUT,4021)ILEFT,ILEFT2,X2PLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP6)THEN
         WRITE(ICOUT,4021)ILEFT,ILEFT2,TAGPLO(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IJ=MAXN*(ICOLL-1)+IROWN
      IF(NS2.NE.1)THEN
         IF(ICOLL.LE.MAXCOL)THEN
            WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,V(IJ),IROWN
 4031       FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',
     1      A4,A4,' = ',E15.7,'   (ROW ',I6,')')
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP1)THEN
            WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,PRED(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP2)THEN
            WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,RES(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP3)THEN
            WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,YPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP4)THEN
            WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,XPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP5)THEN
            WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,X2PLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP6)THEN
            WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,TAGPLO(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ENDIF
      ENDIF
      IF(NS2.NE.1)GOTO4090
      WRITE(ICOUT,4041)
 4041 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4042)
 4042 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
 4090 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4112)ILEFT,ILEFT2,ICOLL
 4112 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4113)ILEFT,ILEFT2,NINEW
 4113 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 4059 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 DPRAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGA3,IBUGQ
 9013 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICASRA,ISEED,ILOCNU
 9014 FORMAT('ICASRA,ISEED,ILOCNU = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NS2
 9015 FORMAT('NS2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NS,NIISUB,NRAN
 9016 FORMAT('NS,NIISUB,NRAN = ',I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1993
      WRITE(ICOUT,9021)MINMAX
 9021 FORMAT('MINMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRAW(X,FREQ,NX,IWRITE,MAXNXT,Y,NY,IBUGA3,IERROR)
C
C     PURPOSE--SOMETIMES DATA IS MADE AVAILABLE AS A FREQUENCY
C              TABLE.  HOWEVER, FOR A PARTICULAR TYPE OF ANALSYSIS
C              YOU MAY NEED THE DATA IN RAW (I.E., IF YOU HAVE
C              A FREQUENCY OF 10 FOR THE VALUE 1, SIMPLY GENERATE
C              THE VALUE 1 TEN TIMES).  NEED TO CHECK FOR ARRAY
C              EXCEEDING MAXIMUM ALLOWABLE.
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           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--2004/4
C     ORIGINAL VERSION--APRIL     2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(*)
      DIMENSION FREQ(*)
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='DPRA'
      ISUBN2='W   '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPRAW--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)NX,MAXNXT
   53   FORMAT('NX,MAXNXT = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NX
          WRITE(ICOUT,56)I,X(I),FREQ(I)
   56     FORMAT('I,X(I), FREQ(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
C               **************************************
C               **  CONVERT FROM FREQUENCY TO RAW   **
C               **************************************
C
      IF(NX.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,101)
  101   FORMAT('***** ERROR--NUMBER OF CLASSES FOR FREQUENCY TO ',
     1         'RAW COMMAND IS LESS THAN 1.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      NY=0
      DO200I=1,NX
C
        NTEMP=INT(FREQ(I)+0.5)
        IF(NTEMP.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,201)I,FREQ(I)
  201     FORMAT('***** ERROR--CLASS ',I8,' HAS NON-POSITIVE ',
     1          'FREQUENCY (= ',F12.5,')')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        NTOT=NY+NTEMP
        IF(NTOT.GT.MAXNXT)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,203)MAXNXT
  203     FORMAT('***** ERROR--MAXIMUM NUMBER OF ROWS (',I8,') ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,205)
  205     FORMAT('      IN CONVERTING FREQUENCY DATA TO RAW DATA.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        DO210J=1,NTEMP
          NY=NY+1
          Y(NY)=X(I)
  210   CONTINUE
  200 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPRAW--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA3,IERROR
 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NX,NY
 9013   FORMAT('NX,NY = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO9015I=1,NY
          WRITE(ICOUT,9016)I,Y(I)
 9016     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','BUG ')
 9015   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPRBCO(IHARG,NUMARG,IDERBC,MAXREG,IREBCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE REGION BORDER COLORS = THE COLORS
C              OF THE BORDER LINE AROUND THE REGIONS.
C              THESE ARE LOCATED IN THE VECTOR IREBCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDERBC
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IREBCO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --MAY       1994. PRINT MESSAGE STATING THAT 
C                                       THIS IS AN OBSOLETE COMMAND
C                                       (USE LINE COLOR COMMAND).
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDERBC
      CHARACTER*4 IREBCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IREBCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPRB'
      ISUBN2='CO  '
C
      NUMREG=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRBCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDERBC
   55 FORMAT('IDERBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IREBCO(1)
   70 FORMAT('IREBCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IREBCO(I)
   76 FORMAT('I,IREBCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      IREBCO(1)=IDERBC
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-2
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDERBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDERBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERBC
      IREBCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,IREBCO(I)
 1276 FORMAT('THE COLOR OF REGION BORDER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDERBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDERBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERBC
      DO1315I=1,NUMREG
      IREBCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IREBCO(I)
 1316 FORMAT('THE COLOR OF ALL REGION BORDERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
CCCCC FOLLOWING SECTION ADDED MAY 1994.
      WRITE(ICOUT,2100)
 2100 FORMAT('****** WARNING.  THE REGION BORDER COLOR COMMAND IS')
      CALL DPWRST('XXX','BUG')
      WRITE(ICOUT,2101)
 2101 FORMAT('       NOT USED.  THE BORDER COLOR FOR REGIONS IS')
      CALL DPWRST('XXX','BUG')
      WRITE(ICOUT,2102)
 2102 FORMAT('       SET WITH THE LINE COLOR COMMAND.          ******')
      CALL DPWRST('XXX','BUG')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRBCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDERBC
 9015 FORMAT('IDERBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IREBCO(1)
 9030 FORMAT('IREBCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IREBCO(I)
 9036 FORMAT('I,IREBCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRBLI(IHARG,IHARG2,NUMARG,IDERBL,MAXREG,IREBLI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPRBLI(IHARG,NUMARG,IDERBL,MAXREG,IREBLI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BORDER LINES = THE LINES TYPES
C              OF THE BORDER AROUND THE REGIONS.
C              THESE ARE LOCATED IN THE VECTOR IREBLI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDERBL
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IREBLI (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --MAY       1994. PRINT MESSAGE SAYING TO USE THE
C                                       LINE COMMAND INSTEAD.
C     UPDATED         --AUGUST    1995. DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDERBL
      CHARACTER*4 IREBLI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IREBLI(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPRB'
      ISUBN2='LI  '
C
      NUMREG=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRBLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDERBL
   55 FORMAT('IDERBL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IREBLI(1)
   70 FORMAT('IREBLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IREBLI(I)
   76 FORMAT('I,IREBLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO9000
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      IF(NUMARG.EQ.5)GOTO1150
      GOTO1160
C
 1130 CONTINUE
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
      IF(IHARG(5).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1 BELOW
      IF(IHARG(5).EQ.'ALL')THEN
        IHOLD1=IHARG(6)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(6).EQ.'ALL')THEN
        IHOLD1=IHARG(5)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      GOTO1200
C
 1160 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      IREBLI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-3
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+3
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERBL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERBL
      IREBLI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,IREBLI(I)
 1276 FORMAT('THE LINE TYPE FOR REGION BORDER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERBL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERBL
      DO1315I=1,NUMREG
      IREBLI(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IREBLI(I)
 1316 FORMAT('THE LINE TYPE FOR ALL REGION BORDERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
CCCCC ADD FOLLOWING SECTION MAY 1994.
      WRITE(ICOUT,2100)
 2100 FORMAT('****** WARNING.  THE REGION BORDER LINE COMMAND IS')
      CALL DPWRST('XXX','BUG')
      WRITE(ICOUT,2101)
 2101 FORMAT('       NOT USED.  THE BORDER LINE STYLE FOR')
      CALL DPWRST('XXX','BUG')
      WRITE(ICOUT,2102)
 2102 FORMAT('       REGIONS IS SET WITH THE LINE COLOR COMMAND.*****')
      CALL DPWRST('XXX','BUG')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRBLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDERBL
 9015 FORMAT('IDERBL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IREBLI(1)
 9030 FORMAT('IREBLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IREBLI(I)
 9036 FORMAT('I,IREBLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRBTH(IHARG,IARGT,ARG,NUMARG,PDERBT,MAXREG,PREBTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE REGION (BORDER) LINE THICKNESSES = THE THICKNESSES
C              OF THE BORDER LINE AROUND THE REGIONS.
C              THESE ARE LOCATED IN THE VECTOR PREBTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDERBT
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PREBTH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --MAY       1994. PRINT MESSAGE TO USE LINE
C                                       THICKNESS COMMAND INSTEAD.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PREBTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPRB'
      ISUBN2='TH  '
C
      NUMREG=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRBTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDERBT
   55 FORMAT('PDERBT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PREBTH(1)
   70 FORMAT('PREBTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PREBTH(I)
   76 FORMAT('I,PREBTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDERBT
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      PREBTH(1)=PDERBT
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-2
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDERBT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDERBT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDERBT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDERBT
      PREBTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,PREBTH(I)
 1276 FORMAT('THE THICKNESS OF REGION BORDER ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDERBT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDERBT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDERBT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDERBT
      DO1315I=1,NUMREG
      PREBTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PREBTH(I)
 1316 FORMAT('THE THICKNESS OF ALL REGION BORDERS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
CCCCC ADD FOLLOWING SECTION MAY 1994.
      WRITE(ICOUT,2100)
 2100 FORMAT('****** WARNING.  THE REGION THICKNESS COMMAND IS')
      CALL DPWRST('XXX','BUG')
      WRITE(ICOUT,2101)
 2101 FORMAT('       NOT USED.  THE BORDER THICKNESS FOR REGIONS')
      CALL DPWRST('XXX','BUG')
      WRITE(ICOUT,2102)
 2102 FORMAT('       IS SET WITH THE LINE THICKNESS COMMAND.  ******')
      CALL DPWRST('XXX','BUG')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRBTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDERBT
 9015 FORMAT('PDERBT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PREBTH(1)
 9030 FORMAT('PREBTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PREBTH(I)
 9036 FORMAT('I,PREBTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRCIL(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX ITALIC LOWER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
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
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
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 DPRCIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.10)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRCIL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(11.LE.ICHARN.AND.ICHARN.LE.20)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRCIL2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(ICHARN.GE.21)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DRCIL3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IFOUND='NO'
      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 DPRCIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRCIN(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX ITALIC NUMERIC.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
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
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
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 DPRCIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHNU(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.8)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRCIN1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.9)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRCIN2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      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 DPRCIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRCIU(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX ITALIC UPPER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
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
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
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 DPRCIU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.14)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRCIU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.15)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRCIU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      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 DPRCIU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRCL(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX LOWER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
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
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
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 DPRCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.12)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRCL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.13)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRCL2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      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 DPRCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRCN(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX NUMERIC.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
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
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
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 DPRCN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHNU(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.9)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRCN1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.10)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRCN2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      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 DPRCN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRCS(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX SYMBOLS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C     UPDATED         --MAY       1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IOPERA
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
      DIMENSION IOPERA(300)
      DIMENSION IX(300)
      DIMENSION IY(300)
C
      DIMENSION IXMIND(30)
      DIMENSION IXMAXD(30)
      DIMENSION IXDELD(30)
      DIMENSION ISTARD(30)
      DIMENSION NUMCOO(30)
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
C     DEFINE CHARACTER   2210--. (PERIOD)
C
      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',   0,  -7/
      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',  -1,  -8/
      DATA IOPERA(   3),IX(   3),IY(   3)/'DRAW',   0,  -9/
      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',   1,  -8/
      DATA IOPERA(   5),IX(   5),IY(   5)/'DRAW',   0,  -7/
C
      DATA IXMIND(   1)/  -5/
      DATA IXMAXD(   1)/   5/
      DATA IXDELD(   1)/  10/
      DATA ISTARD(   1)/   1/
      DATA NUMCOO(   1)/   5/
C
C     DEFINE CHARACTER   2211--, (COMMA)
C
      DATA IOPERA(   6),IX(   6),IY(   6)/'MOVE',   0,  -9/
      DATA IOPERA(   7),IX(   7),IY(   7)/'DRAW',  -1,  -8/
      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',   0,  -7/
      DATA IOPERA(   9),IX(   9),IY(   9)/'DRAW',   1,  -8/
      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',   1, -10/
      DATA IOPERA(  11),IX(  11),IY(  11)/'DRAW',   0, -12/
      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',  -1, -13/
C
      DATA IXMIND(   2)/  -5/
      DATA IXMAXD(   2)/   5/
      DATA IXDELD(   2)/  10/
      DATA ISTARD(   2)/   6/
      DATA NUMCOO(   2)/   7/
C
C     DEFINE CHARACTER   2212--: (COLON)
C
      DATA IOPERA(  13),IX(  13),IY(  13)/'MOVE',   0,   5/
      DATA IOPERA(  14),IX(  14),IY(  14)/'DRAW',  -1,   4/
      DATA IOPERA(  15),IX(  15),IY(  15)/'DRAW',   0,   3/
      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',   1,   4/
      DATA IOPERA(  17),IX(  17),IY(  17)/'DRAW',   0,   5/
      DATA IOPERA(  18),IX(  18),IY(  18)/'MOVE',   0,  -7/
      DATA IOPERA(  19),IX(  19),IY(  19)/'DRAW',  -1,  -8/
      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',   0,  -9/
      DATA IOPERA(  21),IX(  21),IY(  21)/'DRAW',   1,  -8/
      DATA IOPERA(  22),IX(  22),IY(  22)/'DRAW',   0,  -7/
C
      DATA IXMIND(   3)/  -5/
      DATA IXMAXD(   3)/   5/
      DATA IXDELD(   3)/  10/
      DATA ISTARD(   3)/  13/
      DATA NUMCOO(   3)/  10/
C
C     DEFINE CHARACTER   2213--; (SEMICOLON)
C
      DATA IOPERA(  23),IX(  23),IY(  23)/'MOVE',   0,   5/
      DATA IOPERA(  24),IX(  24),IY(  24)/'DRAW',  -1,   4/
      DATA IOPERA(  25),IX(  25),IY(  25)/'DRAW',   0,   3/
      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',   1,   4/
      DATA IOPERA(  27),IX(  27),IY(  27)/'DRAW',   0,   5/
      DATA IOPERA(  28),IX(  28),IY(  28)/'MOVE',   0,  -9/
      DATA IOPERA(  29),IX(  29),IY(  29)/'DRAW',  -1,  -8/
      DATA IOPERA(  30),IX(  30),IY(  30)/'DRAW',   0,  -7/
      DATA IOPERA(  31),IX(  31),IY(  31)/'DRAW',   1,  -8/
      DATA IOPERA(  32),IX(  32),IY(  32)/'DRAW',   1, -10/
      DATA IOPERA(  33),IX(  33),IY(  33)/'DRAW',   0, -12/
      DATA IOPERA(  34),IX(  34),IY(  34)/'DRAW',  -1, -13/
C
      DATA IXMIND(   4)/  -5/
      DATA IXMAXD(   4)/   5/
      DATA IXDELD(   4)/  10/
      DATA ISTARD(   4)/  23/
      DATA NUMCOO(   4)/  12/
C
C     DEFINE CHARACTER   2214--! (EXCLAMATION POINT)
C
      DATA IOPERA(  35),IX(  35),IY(  35)/'MOVE',   0,  12/
      DATA IOPERA(  36),IX(  36),IY(  36)/'DRAW',  -1,  10/
      DATA IOPERA(  37),IX(  37),IY(  37)/'DRAW',   0,  -2/
      DATA IOPERA(  38),IX(  38),IY(  38)/'DRAW',   1,  10/
      DATA IOPERA(  39),IX(  39),IY(  39)/'DRAW',   0,  12/
      DATA IOPERA(  40),IX(  40),IY(  40)/'MOVE',   0,  10/
      DATA IOPERA(  41),IX(  41),IY(  41)/'DRAW',   0,   4/
      DATA IOPERA(  42),IX(  42),IY(  42)/'MOVE',   0,  -7/
      DATA IOPERA(  43),IX(  43),IY(  43)/'DRAW',  -1,  -8/
      DATA IOPERA(  44),IX(  44),IY(  44)/'DRAW',   0,  -9/
      DATA IOPERA(  45),IX(  45),IY(  45)/'DRAW',   1,  -8/
      DATA IOPERA(  46),IX(  46),IY(  46)/'DRAW',   0,  -7/
C
      DATA IXMIND(   5)/  -5/
      DATA IXMAXD(   5)/   5/
      DATA IXDELD(   5)/  10/
      DATA ISTARD(   5)/  35/
      DATA NUMCOO(   5)/  12/
C
C     DEFINE CHARACTER   2215--? (QUESTION MARK)
C
      DATA IOPERA(  47),IX(  47),IY(  47)/'MOVE',  -5,   8/
      DATA IOPERA(  48),IX(  48),IY(  48)/'DRAW',  -4,   7/
      DATA IOPERA(  49),IX(  49),IY(  49)/'DRAW',  -5,   6/
      DATA IOPERA(  50),IX(  50),IY(  50)/'DRAW',  -6,   7/
      DATA IOPERA(  51),IX(  51),IY(  51)/'DRAW',  -6,   8/
      DATA IOPERA(  52),IX(  52),IY(  52)/'DRAW',  -5,  10/
      DATA IOPERA(  53),IX(  53),IY(  53)/'DRAW',  -4,  11/
      DATA IOPERA(  54),IX(  54),IY(  54)/'DRAW',  -2,  12/
      DATA IOPERA(  55),IX(  55),IY(  55)/'DRAW',   1,  12/
      DATA IOPERA(  56),IX(  56),IY(  56)/'DRAW',   4,  11/
      DATA IOPERA(  57),IX(  57),IY(  57)/'DRAW',   5,  10/
      DATA IOPERA(  58),IX(  58),IY(  58)/'DRAW',   6,   8/
      DATA IOPERA(  59),IX(  59),IY(  59)/'DRAW',   6,   6/
      DATA IOPERA(  60),IX(  60),IY(  60)/'DRAW',   5,   4/
      DATA IOPERA(  61),IX(  61),IY(  61)/'DRAW',   4,   3/
      DATA IOPERA(  62),IX(  62),IY(  62)/'DRAW',   0,   1/
      DATA IOPERA(  63),IX(  63),IY(  63)/'DRAW',   0,  -2/
      DATA IOPERA(  64),IX(  64),IY(  64)/'MOVE',   1,  12/
      DATA IOPERA(  65),IX(  65),IY(  65)/'DRAW',   3,  11/
      DATA IOPERA(  66),IX(  66),IY(  66)/'DRAW',   4,  10/
      DATA IOPERA(  67),IX(  67),IY(  67)/'DRAW',   5,   8/
      DATA IOPERA(  68),IX(  68),IY(  68)/'DRAW',   5,   6/
      DATA IOPERA(  69),IX(  69),IY(  69)/'DRAW',   4,   4/
      DATA IOPERA(  70),IX(  70),IY(  70)/'DRAW',   2,   2/
      DATA IOPERA(  71),IX(  71),IY(  71)/'MOVE',   0,  -7/
      DATA IOPERA(  72),IX(  72),IY(  72)/'DRAW',  -1,  -8/
      DATA IOPERA(  73),IX(  73),IY(  73)/'DRAW',   0,  -9/
      DATA IOPERA(  74),IX(  74),IY(  74)/'DRAW',   1,  -8/
      DATA IOPERA(  75),IX(  75),IY(  75)/'DRAW',   0,  -7/
C
      DATA IXMIND(   6)/  -9/
      DATA IXMAXD(   6)/   9/
      DATA IXDELD(   6)/  18/
      DATA ISTARD(   6)/  47/
      DATA NUMCOO(   6)/  29/
C
C     DEFINE CHARACTER   2272--& (AMPERSAND)
C
      DATA IOPERA(  76),IX(  76),IY(  76)/'MOVE',   9,   4/
      DATA IOPERA(  77),IX(  77),IY(  77)/'DRAW',   8,   3/
      DATA IOPERA(  78),IX(  78),IY(  78)/'DRAW',   9,   2/
      DATA IOPERA(  79),IX(  79),IY(  79)/'DRAW',  10,   3/
      DATA IOPERA(  80),IX(  80),IY(  80)/'DRAW',  10,   4/
      DATA IOPERA(  81),IX(  81),IY(  81)/'DRAW',   9,   5/
      DATA IOPERA(  82),IX(  82),IY(  82)/'DRAW',   8,   5/
      DATA IOPERA(  83),IX(  83),IY(  83)/'DRAW',   7,   4/
      DATA IOPERA(  84),IX(  84),IY(  84)/'DRAW',   6,   2/
      DATA IOPERA(  85),IX(  85),IY(  85)/'DRAW',   4,  -3/
      DATA IOPERA(  86),IX(  86),IY(  86)/'DRAW',   2,  -6/
      DATA IOPERA(  87),IX(  87),IY(  87)/'DRAW',   0,  -8/
      DATA IOPERA(  88),IX(  88),IY(  88)/'DRAW',  -2,  -9/
      DATA IOPERA(  89),IX(  89),IY(  89)/'DRAW',  -5,  -9/
      DATA IOPERA(  90),IX(  90),IY(  90)/'DRAW',  -8,  -8/
      DATA IOPERA(  91),IX(  91),IY(  91)/'DRAW',  -9,  -6/
      DATA IOPERA(  92),IX(  92),IY(  92)/'DRAW',  -9,  -3/
      DATA IOPERA(  93),IX(  93),IY(  93)/'DRAW',  -8,  -1/
      DATA IOPERA(  94),IX(  94),IY(  94)/'DRAW',  -2,   3/
      DATA IOPERA(  95),IX(  95),IY(  95)/'DRAW',   0,   5/
      DATA IOPERA(  96),IX(  96),IY(  96)/'DRAW',   1,   7/
      DATA IOPERA(  97),IX(  97),IY(  97)/'DRAW',   1,   9/
      DATA IOPERA(  98),IX(  98),IY(  98)/'DRAW',   0,  11/
      DATA IOPERA(  99),IX(  99),IY(  99)/'DRAW',  -2,  12/
      DATA IOPERA( 100),IX( 100),IY( 100)/'DRAW',  -4,  11/
      DATA IOPERA( 101),IX( 101),IY( 101)/'DRAW',  -5,   9/
      DATA IOPERA( 102),IX( 102),IY( 102)/'DRAW',  -5,   7/
      DATA IOPERA( 103),IX( 103),IY( 103)/'DRAW',  -4,   4/
      DATA IOPERA( 104),IX( 104),IY( 104)/'DRAW',  -2,   1/
      DATA IOPERA( 105),IX( 105),IY( 105)/'DRAW',   3,  -6/
      DATA IOPERA( 106),IX( 106),IY( 106)/'DRAW',   5,  -8/
      DATA IOPERA( 107),IX( 107),IY( 107)/'DRAW',   8,  -9/
      DATA IOPERA( 108),IX( 108),IY( 108)/'DRAW',   9,  -9/
      DATA IOPERA( 109),IX( 109),IY( 109)/'DRAW',  10,  -8/
      DATA IOPERA( 110),IX( 110),IY( 110)/'DRAW',  10,  -7/
      DATA IOPERA( 111),IX( 111),IY( 111)/'MOVE',  -5,  -9/
      DATA IOPERA( 112),IX( 112),IY( 112)/'DRAW',  -7,  -8/
      DATA IOPERA( 113),IX( 113),IY( 113)/'DRAW',  -8,  -6/
      DATA IOPERA( 114),IX( 114),IY( 114)/'DRAW',  -8,  -3/
      DATA IOPERA( 115),IX( 115),IY( 115)/'DRAW',  -7,  -1/
      DATA IOPERA( 116),IX( 116),IY( 116)/'DRAW',  -5,   1/
      DATA IOPERA( 117),IX( 117),IY( 117)/'MOVE',  -5,   7/
      DATA IOPERA( 118),IX( 118),IY( 118)/'DRAW',  -4,   5/
      DATA IOPERA( 119),IX( 119),IY( 119)/'DRAW',   4,  -6/
      DATA IOPERA( 120),IX( 120),IY( 120)/'DRAW',   6,  -8/
      DATA IOPERA( 121),IX( 121),IY( 121)/'DRAW',   8,  -9/
C
      DATA IXMIND(   7)/ -12/
      DATA IXMAXD(   7)/  13/
      DATA IXDELD(   7)/  25/
      DATA ISTARD(   7)/  76/
      DATA NUMCOO(   7)/  46/
C
C     DEFINE CHARACTER   2274--$ (DOLLAR SIGN)
C
      DATA IOPERA( 122),IX( 122),IY( 122)/'MOVE',  -2,  16/
      DATA IOPERA( 123),IX( 123),IY( 123)/'DRAW',  -2, -13/
      DATA IOPERA( 124),IX( 124),IY( 124)/'MOVE',   2,  16/
      DATA IOPERA( 125),IX( 125),IY( 125)/'DRAW',   2, -13/
      DATA IOPERA( 126),IX( 126),IY( 126)/'MOVE',   6,   9/
      DATA IOPERA( 127),IX( 127),IY( 127)/'DRAW',   5,   8/
      DATA IOPERA( 128),IX( 128),IY( 128)/'DRAW',   6,   7/
      DATA IOPERA( 129),IX( 129),IY( 129)/'DRAW',   7,   8/
      DATA IOPERA( 130),IX( 130),IY( 130)/'DRAW',   7,   9/
      DATA IOPERA( 131),IX( 131),IY( 131)/'DRAW',   5,  11/
      DATA IOPERA( 132),IX( 132),IY( 132)/'DRAW',   2,  12/
      DATA IOPERA( 133),IX( 133),IY( 133)/'DRAW',  -2,  12/
      DATA IOPERA( 134),IX( 134),IY( 134)/'DRAW',  -5,  11/
      DATA IOPERA( 135),IX( 135),IY( 135)/'DRAW',  -7,   9/
      DATA IOPERA( 136),IX( 136),IY( 136)/'DRAW',  -7,   7/
      DATA IOPERA( 137),IX( 137),IY( 137)/'DRAW',  -6,   5/
      DATA IOPERA( 138),IX( 138),IY( 138)/'DRAW',  -5,   4/
      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',  -3,   3/
      DATA IOPERA( 140),IX( 140),IY( 140)/'DRAW',   3,   1/
      DATA IOPERA( 141),IX( 141),IY( 141)/'DRAW',   5,   0/
      DATA IOPERA( 142),IX( 142),IY( 142)/'DRAW',   7,  -2/
      DATA IOPERA( 143),IX( 143),IY( 143)/'MOVE',  -7,   7/
      DATA IOPERA( 144),IX( 144),IY( 144)/'DRAW',  -5,   5/
      DATA IOPERA( 145),IX( 145),IY( 145)/'DRAW',  -3,   4/
      DATA IOPERA( 146),IX( 146),IY( 146)/'DRAW',   3,   2/
      DATA IOPERA( 147),IX( 147),IY( 147)/'DRAW',   5,   1/
      DATA IOPERA( 148),IX( 148),IY( 148)/'DRAW',   6,   0/
      DATA IOPERA( 149),IX( 149),IY( 149)/'DRAW',   7,  -2/
      DATA IOPERA( 150),IX( 150),IY( 150)/'DRAW',   7,  -6/
      DATA IOPERA( 151),IX( 151),IY( 151)/'DRAW',   5,  -8/
      DATA IOPERA( 152),IX( 152),IY( 152)/'DRAW',   2,  -9/
      DATA IOPERA( 153),IX( 153),IY( 153)/'DRAW',  -2,  -9/
      DATA IOPERA( 154),IX( 154),IY( 154)/'DRAW',  -5,  -8/
      DATA IOPERA( 155),IX( 155),IY( 155)/'DRAW',  -7,  -6/
      DATA IOPERA( 156),IX( 156),IY( 156)/'DRAW',  -7,  -5/
      DATA IOPERA( 157),IX( 157),IY( 157)/'DRAW',  -6,  -4/
      DATA IOPERA( 158),IX( 158),IY( 158)/'DRAW',  -5,  -5/
      DATA IOPERA( 159),IX( 159),IY( 159)/'DRAW',  -6,  -6/
C
      DATA IXMIND(   8)/ -10/
      DATA IXMAXD(   8)/  10/
      DATA IXDELD(   8)/  20/
      DATA ISTARD(   8)/ 122/
      DATA NUMCOO(   8)/  38/
C
C     DEFINE CHARACTER   2220--/ (SLASH)
C
      DATA IOPERA( 160),IX( 160),IY( 160)/'MOVE',   9,  16/
      DATA IOPERA( 161),IX( 161),IY( 161)/'DRAW',  -9, -16/
C
      DATA IXMIND(   9)/ -11/
      DATA IXMAXD(   9)/  11/
      DATA IXDELD(   9)/  22/
      DATA ISTARD(   9)/ 160/
      DATA NUMCOO(   9)/   2/
C
C     DEFINE CHARACTER   2221--( (LEFT PARENTHESES)
C
      DATA IOPERA( 162),IX( 162),IY( 162)/'MOVE',   4,  16/
      DATA IOPERA( 163),IX( 163),IY( 163)/'DRAW',   2,  14/
      DATA IOPERA( 164),IX( 164),IY( 164)/'DRAW',   0,  11/
      DATA IOPERA( 165),IX( 165),IY( 165)/'DRAW',  -2,   7/
      DATA IOPERA( 166),IX( 166),IY( 166)/'DRAW',  -3,   2/
      DATA IOPERA( 167),IX( 167),IY( 167)/'DRAW',  -3,  -2/
      DATA IOPERA( 168),IX( 168),IY( 168)/'DRAW',  -2,  -7/
      DATA IOPERA( 169),IX( 169),IY( 169)/'DRAW',   0, -11/
      DATA IOPERA( 170),IX( 170),IY( 170)/'DRAW',   2, -14/
      DATA IOPERA( 171),IX( 171),IY( 171)/'DRAW',   4, -16/
      DATA IOPERA( 172),IX( 172),IY( 172)/'MOVE',   2,  14/
      DATA IOPERA( 173),IX( 173),IY( 173)/'DRAW',   0,  10/
      DATA IOPERA( 174),IX( 174),IY( 174)/'DRAW',  -1,   7/
      DATA IOPERA( 175),IX( 175),IY( 175)/'DRAW',  -2,   2/
      DATA IOPERA( 176),IX( 176),IY( 176)/'DRAW',  -2,  -2/
      DATA IOPERA( 177),IX( 177),IY( 177)/'DRAW',  -1,  -7/
      DATA IOPERA( 178),IX( 178),IY( 178)/'DRAW',   0, -10/
      DATA IOPERA( 179),IX( 179),IY( 179)/'DRAW',   2, -14/
C
      DATA IXMIND(  10)/  -7/
      DATA IXMAXD(  10)/   7/
      DATA IXDELD(  10)/  14/
      DATA ISTARD(  10)/ 162/
      DATA NUMCOO(  10)/  18/
C
C     DEFINE CHARACTER   2222--) (RIGHT PARENTHESES)
C
      DATA IOPERA( 180),IX( 180),IY( 180)/'MOVE',  -4,  16/
      DATA IOPERA( 181),IX( 181),IY( 181)/'DRAW',  -2,  14/
      DATA IOPERA( 182),IX( 182),IY( 182)/'DRAW',   0,  11/
      DATA IOPERA( 183),IX( 183),IY( 183)/'DRAW',   2,   7/
      DATA IOPERA( 184),IX( 184),IY( 184)/'DRAW',   3,   2/
      DATA IOPERA( 185),IX( 185),IY( 185)/'DRAW',   3,  -2/
      DATA IOPERA( 186),IX( 186),IY( 186)/'DRAW',   2,  -7/
      DATA IOPERA( 187),IX( 187),IY( 187)/'DRAW',   0, -11/
      DATA IOPERA( 188),IX( 188),IY( 188)/'DRAW',  -2, -14/
      DATA IOPERA( 189),IX( 189),IY( 189)/'DRAW',  -4, -16/
      DATA IOPERA( 190),IX( 190),IY( 190)/'MOVE',  -2,  14/
      DATA IOPERA( 191),IX( 191),IY( 191)/'DRAW',   0,  10/
      DATA IOPERA( 192),IX( 192),IY( 192)/'DRAW',   1,   7/
      DATA IOPERA( 193),IX( 193),IY( 193)/'DRAW',   2,   2/
      DATA IOPERA( 194),IX( 194),IY( 194)/'DRAW',   2,  -2/
      DATA IOPERA( 195),IX( 195),IY( 195)/'DRAW',   1,  -7/
      DATA IOPERA( 196),IX( 196),IY( 196)/'DRAW',   0, -10/
      DATA IOPERA( 197),IX( 197),IY( 197)/'DRAW',  -2, -14/
C
      DATA IXMIND(  11)/  -7/
      DATA IXMAXD(  11)/   7/
      DATA IXDELD(  11)/  14/
      DATA ISTARD(  11)/ 180/
      DATA NUMCOO(  11)/  18/
C
C     DEFINE CHARACTER   2219--* (ASTERISK)
C
      DATA IOPERA( 198),IX( 198),IY( 198)/'MOVE',   0,  12/
      DATA IOPERA( 199),IX( 199),IY( 199)/'DRAW',   0,   0/
      DATA IOPERA( 200),IX( 200),IY( 200)/'MOVE',  -5,   9/
      DATA IOPERA( 201),IX( 201),IY( 201)/'DRAW',   5,   3/
      DATA IOPERA( 202),IX( 202),IY( 202)/'MOVE',   5,   9/
      DATA IOPERA( 203),IX( 203),IY( 203)/'DRAW',  -5,   3/
C
      DATA IXMIND(  12)/  -8/
      DATA IXMAXD(  12)/   8/
      DATA IXDELD(  12)/  16/
      DATA ISTARD(  12)/ 198/
      DATA NUMCOO(  12)/   6/
C
C     DEFINE CHARACTER   2231--- (HYPHEN OR MINUS SIGN)
C
      DATA IOPERA( 204),IX( 204),IY( 204)/'MOVE',  -9,   0/
      DATA IOPERA( 205),IX( 205),IY( 205)/'DRAW',   9,   0/
C
      DATA IXMIND(  13)/ -13/
      DATA IXMAXD(  13)/  13/
      DATA IXDELD(  13)/  26/
      DATA ISTARD(  13)/ 204/
      DATA NUMCOO(  13)/   2/
C
C     DEFINE CHARACTER   2232--+ (PLUS SIGN)
C
      DATA IOPERA( 206),IX( 206),IY( 206)/'MOVE',   0,   9/
      DATA IOPERA( 207),IX( 207),IY( 207)/'DRAW',   0,  -9/
      DATA IOPERA( 208),IX( 208),IY( 208)/'MOVE',  -9,   0/
      DATA IOPERA( 209),IX( 209),IY( 209)/'DRAW',   9,   0/
C
      DATA IXMIND(  14)/ -13/
      DATA IXMAXD(  14)/  13/
      DATA IXDELD(  14)/  26/
      DATA ISTARD(  14)/ 206/
      DATA NUMCOO(  14)/   4/
C
C     DEFINE CHARACTER   2238--= (EQUAL SIGN)
C
      DATA IOPERA( 210),IX( 210),IY( 210)/'MOVE',  -9,   3/
      DATA IOPERA( 211),IX( 211),IY( 211)/'DRAW',   9,   3/
      DATA IOPERA( 212),IX( 212),IY( 212)/'MOVE',  -9,  -3/
      DATA IOPERA( 213),IX( 213),IY( 213)/'DRAW',   9,  -3/
C
      DATA IXMIND(  15)/ -13/
      DATA IXMAXD(  15)/  13/
      DATA IXDELD(  15)/  26/
      DATA ISTARD(  15)/ 210/
      DATA NUMCOO(  15)/   4/
C
C     DEFINE CHARACTER   2216--' (SINGLE QUOTE)
C
      DATA IOPERA( 214),IX( 214),IY( 214)/'MOVE',   0,  12/
      DATA IOPERA( 215),IX( 215),IY( 215)/'DRAW',  -1,   5/
      DATA IOPERA( 216),IX( 216),IY( 216)/'MOVE',   1,  12/
      DATA IOPERA( 217),IX( 217),IY( 217)/'DRAW',  -1,   5/
C
      DATA IXMIND(  16)/  -4/
      DATA IXMAXD(  16)/   4/
      DATA IXDELD(  16)/   8/
      DATA ISTARD(  16)/ 214/
      DATA NUMCOO(  16)/   4/
C
C     DEFINE CHARACTER   2217--  (DOUBLE QUOTE)
C
      DATA IOPERA( 218),IX( 218),IY( 218)/'MOVE',  -4,  12/
      DATA IOPERA( 219),IX( 219),IY( 219)/'DRAW',  -5,   5/
      DATA IOPERA( 220),IX( 220),IY( 220)/'MOVE',  -3,  12/
      DATA IOPERA( 221),IX( 221),IY( 221)/'DRAW',  -5,   5/
      DATA IOPERA( 222),IX( 222),IY( 222)/'MOVE',   4,  12/
      DATA IOPERA( 223),IX( 223),IY( 223)/'DRAW',   3,   5/
      DATA IOPERA( 224),IX( 224),IY( 224)/'MOVE',   5,  12/
      DATA IOPERA( 225),IX( 225),IY( 225)/'DRAW',   3,   5/
C
      DATA IXMIND(  17)/  -8/
      DATA IXMAXD(  17)/   8/
      DATA IXDELD(  17)/  16/
      DATA ISTARD(  17)/ 218/
      DATA NUMCOO(  17)/   8/
C
C     DEFINE CHARACTER   2218--  (DEGREES)
C
      DATA IOPERA( 226),IX( 226),IY( 226)/'MOVE',  -1,  12/
      DATA IOPERA( 227),IX( 227),IY( 227)/'DRAW',  -3,  11/
      DATA IOPERA( 228),IX( 228),IY( 228)/'DRAW',  -4,   9/
      DATA IOPERA( 229),IX( 229),IY( 229)/'DRAW',  -4,   7/
      DATA IOPERA( 230),IX( 230),IY( 230)/'DRAW',  -3,   5/
      DATA IOPERA( 231),IX( 231),IY( 231)/'DRAW',  -1,   4/
      DATA IOPERA( 232),IX( 232),IY( 232)/'DRAW',   1,   4/
      DATA IOPERA( 233),IX( 233),IY( 233)/'DRAW',   3,   5/
      DATA IOPERA( 234),IX( 234),IY( 234)/'DRAW',   4,   7/
      DATA IOPERA( 235),IX( 235),IY( 235)/'DRAW',   4,   9/
      DATA IOPERA( 236),IX( 236),IY( 236)/'DRAW',   3,  11/
      DATA IOPERA( 237),IX( 237),IY( 237)/'DRAW',   1,  12/
      DATA IOPERA( 238),IX( 238),IY( 238)/'DRAW',  -1,  12/
C
      DATA IXMIND(  18)/  -7/
      DATA IXMAXD(  18)/   7/
      DATA IXDELD(  18)/  14/
      DATA ISTARD(  18)/ 226/
      DATA NUMCOO(  18)/  13/
C
C     DEFINE CHARACTER   2747--  (NO   SPACE BLANK)
C
      DATA IOPERA( 239),IX( 239),IY( 239)/'MOVE',   0, -32/
      DATA IOPERA( 240),IX( 240),IY( 240)/'MOVE',   0, -32/
C
      DATA IXMIND(  19)/   0/
      DATA IXMAXD(  19)/   0/
      DATA IXDELD(  19)/   0/
      DATA ISTARD(  19)/ 239/
      DATA NUMCOO(  19)/   2/
C
C     DEFINE CHARACTER   2748--  (HALF SPACE BLANK)
C
      DATA IOPERA( 241),IX( 241),IY( 241)/'MOVE',  -4, -32/
      DATA IOPERA( 242),IX( 242),IY( 242)/'MOVE',   4, -32/
C
      DATA IXMIND(  20)/  -4/
      DATA IXMAXD(  20)/   4/
      DATA IXDELD(  20)/   8/
      DATA ISTARD(  20)/ 241/
      DATA NUMCOO(  20)/   2/
C
C     DEFINE CHARACTER   2749--  (FULL SPACE BLANK)
C
      DATA IOPERA( 243),IX( 243),IY( 243)/'MOVE',  -8, -32/
      DATA IOPERA( 244),IX( 244),IY( 244)/'MOVE',   8, -32/
C
      DATA IXMIND(  21)/  -8/
      DATA IXMAXD(  21)/   8/
      DATA IXDELD(  21)/  16/
      DATA ISTARD(  21)/ 243/
      DATA NUMCOO(  21)/   2/
C
C     DEFINE CHARACTER   2252--  (LEFT  APOSTRAPHE)
C
      DATA IOPERA( 245),IX( 245),IY( 245)/'MOVE',   1,  12/
      DATA IOPERA( 246),IX( 246),IY( 246)/'DRAW',   0,  11/
      DATA IOPERA( 247),IX( 247),IY( 247)/'DRAW',  -1,   9/
      DATA IOPERA( 248),IX( 248),IY( 248)/'DRAW',  -1,   7/
      DATA IOPERA( 249),IX( 249),IY( 249)/'DRAW',   0,   6/
      DATA IOPERA( 250),IX( 250),IY( 250)/'DRAW',   1,   7/
      DATA IOPERA( 251),IX( 251),IY( 251)/'DRAW',   0,   8/
C
      DATA IXMIND(  22)/  -5/
      DATA IXMAXD(  22)/   5/
      DATA IXDELD(  22)/  10/
      DATA ISTARD(  22)/ 245/
      DATA NUMCOO(  22)/   7/
C
C     DEFINE CHARACTER   2251--  (RIGHT APOSTRAPHE)
C
      DATA IOPERA( 252),IX( 252),IY( 252)/'MOVE',   0,  10/
      DATA IOPERA( 253),IX( 253),IY( 253)/'DRAW',  -1,  11/
      DATA IOPERA( 254),IX( 254),IY( 254)/'DRAW',   0,  12/
      DATA IOPERA( 255),IX( 255),IY( 255)/'DRAW',   1,  11/
      DATA IOPERA( 256),IX( 256),IY( 256)/'DRAW',   1,   9/
      DATA IOPERA( 257),IX( 257),IY( 257)/'DRAW',   0,   7/
      DATA IOPERA( 258),IX( 258),IY( 258)/'DRAW',  -1,   6/
C
      DATA IXMIND(  23)/  -5/
      DATA IXMAXD(  23)/   5/
      DATA IXDELD(  23)/  10/
      DATA ISTARD(  23)/ 252/
      DATA NUMCOO(  23)/   7/
C
C     DEFINE CHARACTER    XXX--| (KEYBOARD VERTICAL BAR)
C
      DATA IOPERA( 259),IX( 259),IY( 259)/'MOVE',   0,  12/
      DATA IOPERA( 260),IX( 260),IY( 260)/'DRAW',   0,  -9/
C
C
      DATA IXMIND(  24)/  -4/
      DATA IXMAXD(  24)/   4/
      DATA IXDELD(  24)/   8/
      DATA ISTARD(  24)/ 259/
      DATA NUMCOO(  24)/   2/
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C               ******************************************
C
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 DPRCS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C               **************************************************
C
      CALL DPCHSY(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
      GOTO1000
C
C               **************************************
C               **************************************
C               **  STEP 2--                        **
C               **  EXTRACT THE COORDINATES         **
C               **  FOR THIS PARTICULAR CHARACTER.  **
C               **************************************
C               **************************************
C
 1000 CONTINUE
      ISTART=ISTARD(ICHARN)
      NC=NUMCOO(ICHARN)
      ISTOP=ISTART+NC-1
      J=0
      DO1100I=ISTART,ISTOP
      J=J+1
      IOP(J)=IOPERA(I)
      X(J)=IX(I)
      Y(J)=IY(I)
 1100 CONTINUE
      NUMCO=J
      IXMINS=IXMIND(ICHARN)
      IXMAXS=IXMAXD(ICHARN)
      IXDELS=IXDELD(ICHARN)
C
      GOTO9000
C
C               *****************
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
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 DPRCS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRCSL(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX SCRIPT LOWER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
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
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
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 DPRCSL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.12)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRCSL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(13.LE.ICHARN.AND.ICHARN.LE.23)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRCSL2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(ICHARN.GE.24)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DRCSL3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IFOUND='NO'
      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 DPRCSL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
