      SUBROUTINE DPC4HI(IHVAL,IVAL,IBUGA3,IERROR)
C
C     PURPOSE--CONVERT A CHARACTER VARIABLE
C              INTO THE CORRESPONDING INTEGER VALUE.
C     NOTE--INASMUCH AS THE ASSUMED INPUT WORD HAS 4 CHARACTERS AT MOST,
C           THEN THE VALID RANGE OF THE OUTPUT INTEGER VARIABLE
C           IS -999 TO 9999   .
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHVAL
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHTEMP
      CHARACTER*4 ISIGN
C
C---------------------------------------------------------------------
C
      DIMENSION IHTEMP(4)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      NUMASC=4
      IVAL=0
C
      ITERM=0
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPC4HI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IHVAL,IBUGA3,IERROR
   52 FORMAT('IHVAL,IBUGA3,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************
C               **  STEP 1--                             **
C               **  DECOMPOSE THE 4-CHARACTERS IN IHVAL  **
C               **  INTO 4 1-CHARACTER WORDS.            **
C               *******************************************
C
      DO200J=1,NUMASC
      IHTEMP(J)='    '
      ISTAR1=NUMBPC*(J-1)
      CALL DPCHEX(ISTAR1,NUMBPC,IHVAL,0,NUMBPC,IHTEMP(J))
  200 CONTINUE
C
C               ******************************************************
C               **  STEP 2--                                        **
C               **  CARRY OUT THE HOLLERITH TO INTEGER CONVERSION.  **
C               ******************************************************
C
      ISIGN='+'
      NUMSIG=0
      IDIGI=0
      ISUM=0
      DO400I=1,NUMASC
      IREV=NUMASC-I+1
      IF(IHTEMP(IREV).EQ.' ')GOTO400
      IF(IHTEMP(IREV).EQ.'0')GOTO410
      IF(IHTEMP(IREV).EQ.'1')GOTO411
      IF(IHTEMP(IREV).EQ.'2')GOTO412
      IF(IHTEMP(IREV).EQ.'3')GOTO413
      IF(IHTEMP(IREV).EQ.'4')GOTO414
      IF(IHTEMP(IREV).EQ.'5')GOTO415
      IF(IHTEMP(IREV).EQ.'6')GOTO416
      IF(IHTEMP(IREV).EQ.'7')GOTO417
      IF(IHTEMP(IREV).EQ.'8')GOTO418
      IF(IHTEMP(IREV).EQ.'9')GOTO419
      IF(IHTEMP(IREV).EQ.'+')GOTO420
      IF(IHTEMP(IREV).EQ.'-')GOTO421
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,431)
  431 FORMAT('***** ERROR IN DPC4HI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,432)
  432 FORMAT('      CHARACTER ENCOUNTERED IN THE CONVERSION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,433)
  433 FORMAT('      WHICH WAS NOT 0 THROUGH 9, +, - OR SPACE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,434)IHTEMP(IREV)
  434 FORMAT('      CHARACTER IN QUESTION IHTEMP(IREV) = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,435)IHVAL
  435 FORMAT('      IHVAL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  410 ITERM=0
      GOTO425
  411 ITERM=1
      GOTO425
  412 ITERM=2
      GOTO425
  413 ITERM=3
      GOTO425
  414 ITERM=4
      GOTO425
  415 ITERM=5
      GOTO425
  416 ITERM=6
      GOTO425
  417 ITERM=7
      GOTO425
  418 ITERM=8
      GOTO425
  419 ITERM=9
      GOTO425
  420 NUMSIG=NUMSIG+1
      GOTO400
  421 NUMSIG=NUMSIG+1
      ISIGN='-'
      GOTO400
  425 IDIGI=IDIGI+1
      IEXP=IDIGI-1
CCCCC ISUM=ISUM+ITERM*(10**IEXP)
      IJUNK=INT(10.0**IEXP + 0.01)
      ISUM=ISUM+ITERM*IJUNK
  400 CONTINUE
C
      IF(NUMSIG.LE.1)GOTO459
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,451)
  451 FORMAT('***** ERROR IN DPC4HI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,452)
  452 FORMAT('      MULTIPLE SIGNS (+/-) ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,453)
  453 FORMAT('      IN THE CONVERSION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,454)NUMSIG
  454 FORMAT('      NUMBER OF SIGNS NUMSIG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,456)(IHTEMP(J),J=1,NUMASC)
  456 FORMAT('      (IHTEMP(J),J=1,NUMASC) = ',4A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,457)IHVAL
  457 FORMAT('      IHVAL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  459 CONTINUE
      IF(ISIGN.EQ.'-')ISUM=-ISUM
      IVAL=ISUM
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF DPC4HI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IHVAL
 9012 FORMAT('IHVAL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(IHTEMP(J),J=1,NUMASC)
 9014 FORMAT('(IHTEMP(J),J=1,NUMASC) = ',4A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMASC,ISIGN,NUMSIG,ISUM,ITERM
 9015 FORMAT('NUMASC,ISIGN,NUMSIG,ISUM,ITERM = ',I8,2X,A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IBUGA3,IERROR
 9016 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IVAL
 9017 FORMAT('IVAL = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPC4IH(IVAL,IHVAL,IBUGA3,IERROR)
C
C     PURPOSE--CONVERT AN INTEGER VARIABLE
C              TO A 4-CHARACTER-PER-WORD HOLLERITH STRING.
C     NOTE--CONVERT ONLY THE FIRST 4 CHARACTERS OF THE
C           INTEGER VARIABLE (INCLUDING THE NEGATIVE
C           SIGN, IF EXISTENT).
C     NOTE--INCORRECT VALUERS WILL RESULT IF THE INPUT INTEGER
C           IS LARGER THAN 9999 OR SMALLER THAN -999   .
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHVAL
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHTEMP
      CHARACTER*4 ISIGN
      CHARACTER*4 IHDIG
C
C---------------------------------------------------------------------
C
      DIMENSION IHTEMP(4)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      NUMASC=4
      IVAL2=IVAL
      IHVAL='    '
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPC4IH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IVAL,IBUGA3,IERROR
   52 FORMAT('IVAL,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***********************
C               **  STEP 2--         **
C               **  DETERMINE SIGN.  **
C               ***********************
C
      ISIGN='+'
      IF(IVAL2.LT.0)ISIGN='-'
      IVAL2=IABS(IVAL2)
C
C               ***********************************
C               **  STEP 3--                     **
C               **  DETERMINE NUMBER OF DIGITS.  **
C               ***********************************
C
      IMIN=1
      IMAX=NUMASC
      DO300I=IMIN,IMAX
      IREV=IMAX-I+IMIN
      IDIV=INT(10.0**(IREV-1) + 0.01)
      IDIG=IVAL2/IDIV
      IF(IDIG.NE.0)GOTO350
  300 CONTINUE
      NUMDIG=1
      GOTO390
  350 CONTINUE
      NUMDIG=IREV
  390 CONTINUE
C
C               ***************************************
C               **  STEP 4--                         **
C               **  IF NEGATIVE,                     **
C               **  INSERT SIGN INTO OUTPUT VECTOR.  **
C               ***************************************
C
      J=0
      IF(ISIGN.EQ.'-')J=J+1
      IF(ISIGN.EQ.'-')IHTEMP(J)='-'
C
C               **************************
C               **  STEP 5--            **
C               **  INSERT DIGITS INTO  **
C               **  OUTPUT VECTOR.      **
C               **************************
C
      IMIN=1
      IMAX=NUMDIG
      IF(IMAX.GE.NUMASC.AND.ISIGN.EQ.'-')IMAX=NUMASC-1
      IF(IMAX.GE.NUMASC.AND.ISIGN.EQ.'+')IMAX=NUMASC
      DO500I=IMIN,IMAX
      IREV=IMAX-I+IMIN
      IDIV=INT(10.0**(IREV-1) + 0.01)
      IDIG=IVAL2/IDIV
C
      IF(IDIG.EQ.0)GOTO510
      IF(IDIG.EQ.1)GOTO511
      IF(IDIG.EQ.2)GOTO512
      IF(IDIG.EQ.3)GOTO513
      IF(IDIG.EQ.4)GOTO514
      IF(IDIG.EQ.5)GOTO515
      IF(IDIG.EQ.6)GOTO516
      IF(IDIG.EQ.7)GOTO517
      IF(IDIG.EQ.8)GOTO518
      IF(IDIG.EQ.9)GOTO519
  510 CONTINUE
      IHDIG='0'
      GOTO529
  511 CONTINUE
      IHDIG='1'
      GOTO529
  512 CONTINUE
      IHDIG='2'
      GOTO529
  513 CONTINUE
      IHDIG='3'
      GOTO529
  514 CONTINUE
      IHDIG='4'
      GOTO529
  515 CONTINUE
      IHDIG='5'
      GOTO529
  516 CONTINUE
      IHDIG='6'
      GOTO529
  517 CONTINUE
      IHDIG='7'
      GOTO529
  518 CONTINUE
      IHDIG='8'
      GOTO529
  519 CONTINUE
      IHDIG='9'
      GOTO529
  529 CONTINUE
C
      J=J+1
      IF(J.GT.NUMASC)GOTO550
      IHTEMP(J)=IHDIG
      IVAL2=IVAL2-IDIG*IDIV
  500 CONTINUE
C
      NTEMP=J
      GOTO590
C
  550 CONTINUE
      NTEMP=J-1
      GOTO590
C
  590 CONTINUE
C
C               ***************************************
C               **  STEP 6--                         **
C               **  PACK THE CHARACTERS INTO 1 WORD  **
C               ***************************************
C
      IHVAL='    '
      IMAX=NUMASC
      IF(NTEMP.LE.IMAX)IMAX=NTEMP
      IF(IMAX.LE.0)GOTO690
      DO600J=1,IMAX
      ISTAR2=NUMBPC*(J-1)
      CALL DPCHEX(0,NUMBPC,IHTEMP(J),ISTAR2,NUMBPC,IHVAL)
  600 CONTINUE
  690 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF DPC4IH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IVAL
 9012 FORMAT('IVAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ISIGN,NUMDIG,NUMASC,IMAX
 9013 FORMAT('ISIGN,NUMDIG,NUMASC,IMAX = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NTEMP
 9014 FORMAT('NTEMP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(IHTEMP(I),I=1,NTEMP)
 9015 FORMAT('IHTEMP(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ISTAR2,IHVAL
 9016 FORMAT('ISTAR2,IHVAL = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IBUGA3,IERROR
 9017 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCAAN(XTEMP1,XTEMP2,MAXNXT,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A TABLE OF CAPABILITY ANALYSIS STATISTICS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--90/9
C     ORIGINAL VERSION--SEPTEMBER 1990.
C     UPDATED         --APRIL     2001.  1) ARGUMENT LIST TO DPCAA2
C                                        2) SAVE RESULTS FROM DPCAA2
C                                           AS INTERNAL PARAMETERS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO2
C
      CHARACTER*4 ISUBN0
      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 'DPCOHO.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='DPCA'
      ISUBN2='AN  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXV2=1
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************************
C               **  TREAT THE CAPABILITY ANALYSIS   CASE  **
C               ********************************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCAAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.              **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPCAAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A CAPABILITY ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,NLEFT
      ISUB(I)=1
  515 CONTINUE
      NQ=NLEFT
      GOTO550
C
  520 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPCAAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FOR WHICH A CAPABILITY ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      IS TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
  570 CONTINUE
      NS=J
C
C               ****************************************************************
C               **  STEP 7--                                                  **
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               ****************************************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON')CALL 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
      CCUSLC=CPUMIN
      IH='USLC'
      IH2='OST '
      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')CCUSLC=VALUE(ILOCP)
C
C               ******************************************************
C               **  STEP 8--                                        **
C               **  PREPARE FOR ENTRANCE INTO DPCAA2--              **
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.      **
C               ******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,NS
      W(I)=1.0
 1110 CONTINUE
C
C               ******************************************
C               **  STEP 9--                            **
C               **  FORM THE CAPABILITY ANALYSIS TABLE. **
C               ******************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPCAAN, AS WE ARE ABOUT TO CALL DPCAA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,MAXN,NS
 1212 FORMAT('NLEFT,MAXN,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I),W(I)
 1216 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 1290 CONTINUE
C
      CALL DPCAA2(Y,W,NS,XTEMP1,XTEMP2,MAXNXT,
     1CCLSL,CCUSL,CCTARG,CCUSLC,
     1YCP,YCPLL,YCPUL,YCPK,YCPKLL,YCPKUL,
     1YCPL,YCPLLL,YCPLUL,YCPU,YCPULL,YCPUUL,
     1YCNPK,YCPM,YCPMLL,YCPMUL,YCC,
     1YACTPD,YTHEPD,YACTL,YTHEL,YACTU,YTHEU,YEXPLO,
     1IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 10--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH='CPST'
      IH2='AT  '
      VALUE0=YCP
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPLL'
      IH2='    '
      VALUE0=YCPLL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPUL'
      IH2='    '
      VALUE0=YCPUL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPKS'
      IH2='TAT '
      VALUE0=YCPK
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPKL'
      IH2='L   '
      VALUE0=YCPKLL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPKU'
      IH2='L   '
      VALUE0=YCPKUL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPLS'
      IH2='TAT '
      VALUE0=YCPL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPLL'
      IH2='L   '
      VALUE0=YCPLLL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPLU'
      IH2='L   '
      VALUE0=YCPLUL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPUS'
      IH2='TAT '
      VALUE0=YCPU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPUL'
      IH2='L   '
      VALUE0=YCPULL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPUU'
      IH2='L   '
      VALUE0=YCPUUL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CNPK'
      IH2='STAT'
      VALUE0=YCNPK
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPMS'
      IH2='TAT '
      VALUE0=YCPM
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPML'
      IH2='L   '
      VALUE0=YCPMLL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CPMU'
      IH2='L   '
      VALUE0=YCPMUL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CCST'
      IH2='AT  '
      VALUE0=YCC
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='ACTU'
      IH2='ALPD'
      VALUE0=YACTPD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='THEO'
      IH2='RPD '
      VALUE0=YTHEPD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='ACTU'
      IH2='ALLL'
      VALUE0=YACTL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='THEO'
      IH2='RLL '
      VALUE0=YTHEL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='ACTU'
      IH2='ALUL'
      VALUE0=YACTU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='THEO'
      IH2='RUL '
      VALUE0=YTHEU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='EXPL'
      IH2='OSS '
      VALUE0=YEXPLO
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCAAN--')
      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 ')
      WRITE(ICOUT,9021)CCLSL,CCUSL,CCTARG,CCUSLC
 9021 FORMAT('CCLSL,CCUSL,CCTARG,CCUSLC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCAA2(Y,W,N,XTEMP1,XTEMP2,MAXNXT,
     1CCLSL,CCUSL,CCTARG,CCUSLC,
     1YCP,YCPLL,YCPUL,YCPK,YCPKLL,YCPKUL,
     1YCPL,YCPLLL,YCPLUL,YCPU,YCPULL,YCPUUL,
     1YCNPK,YCPM,YCPMLL,YCPMUL,YCC,
     1YACTPD,YTHEPD,YACTL,YTHEL,YACTU,YTHEU,YEXPLO,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE GENERATES A CAPABILITY ANALYSIS
C              TABULATION THE DATA IN THE INPUT VECTOR Y.
C     NOTE--NORMALITY IS ASSUMED
C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                OF EQUALLY-SPACED OBSERVATIONS
C                                TO BE SMOOTHED.
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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--90/9
C     ORIGINAL VERSION--SEPTEMBER 1990.
C     UPDATED         --APRIL     2001.  EXPAND TABLE:
C                                        1) ADD CC, CPM, CPL, CPU,
C                                               CNPK
C                                        2) 95% CONFIDENCE INTERVAL
C                                           FOR CP, CPK, CPL, CPU, CPM
C                                        3) ADD COMPUTED STATS TO
C                                           CALL LIST SO THEY CAN BE
C                                           SAVED AS INTERNAL
C                                           PARAMETERS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IFLAG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION W(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
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='DPCA'
      ISUBN2='A2  '
C
      IERROR='NO'
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 DPCAA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,IBUGA3
   52 FORMAT('N,IBUGA3 = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)CCLSL,CCUSL,CCTARG,CCUSLC
   54 FORMAT('CCLSL,CCUSL,CCTARG,CCUSLC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I),W(I)
   57 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.1)GOTO110
      GOTO119
  110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPCAA2--THE NUMBER OF OBSERVATIONS ',
     1'IN THE RESPONSE VARIABLE IS NON-POSITIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)N
  112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      IF(N.EQ.1)GOTO120
      GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** NOTE FROM DPCAA2--THE RESPONSE VARIABLE ',
     1'ONLY HAS 1 ELEMENT')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  129 CONTINUE
C
      HOLD=Y(1)
      DO135I=2,N
      IF(Y(I).NE.HOLD)GOTO139
  135 CONTINUE
  130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)HOLD
  131 FORMAT('***** NOTE FROM DPCAA2--THE RESPONSE VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  139 CONTINUE
C
C               **********************************************
C               **  STEP 3--                                **
C               **  COMPUTE VARIOUS CAPABILITY STATISTICS-- **
C               **     1) CP                                **
C               **     2) CPK                               **
C               **     3) PERCENT DEFECTIVE                 **
C               **     4) EXPECTED LOSS                     **
C               **********************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      IFLAG='BOTH'
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
C
      YCP=CPUMIN
      YCPLL=CPUMIN
      YCPUL=CPUMIN
      YCPK=CPUMIN
      YCPKLL=CPUMIN
      YCPKUL=CPUMIN
      YCNPK=CPUMIN
      YCPL=CPUMIN
      YCPLLL=CPUMIN
      YCPLUL=CPUMIN
      YCPU=CPUMIN
      YCPULL=CPUMIN
      YCPUUL=CPUMIN
      YCC=CPUMIN
      YCPM=CPUMIN
      YCPMLL=CPUMIN
      YCPMUL=CPUMIN
      YTHEPD=CPUMIN
      YTHEL=CPUMIN
      YTHEU=CPUMIN
      YACTPD=CPUMIN
      YACTL=CPUMIN
      YACTU=CPUMIN
      YEXPLO=CPUMIN
C
      IF(CCLSL.NE.CPUMIN.AND.CCUSL.NE.CPUMIN)
     1CALL CP(Y,N,CCLSL,CCUSL,IWRITE,YCP,YCPLL,YCPUL,
     1IBUGA3,IERROR)
      IF(CCLSL.NE.CPUMIN.AND.CCUSL.NE.CPUMIN)
     1CALL CPL(Y,N,CCLSL,CCUSL,IWRITE,YCPL,YCPLLL,YCPLUL,
     1IBUGA3,IERROR)
      IF(CCLSL.NE.CPUMIN.AND.CCUSL.NE.CPUMIN)
     1CALL CPU(Y,N,CCLSL,CCUSL,IWRITE,YCPU,YCPULL,YCPUUL,
     1IBUGA3,IERROR)
      IF(CCLSL.NE.CPUMIN.AND.CCUSL.NE.CPUMIN)
     1CALL CPK(Y,N,CCLSL,CCUSL,IWRITE,YCPK,YCPKLL,YCPKUL,
     1IBUGA3,IERROR)
      IF(CCLSL.NE.CPUMIN.AND.CCUSL.NE.CPUMIN)
     1CALL CNPK(Y,N,XTEMP1,MAXNXT,CCLSL,CCUSL,IWRITE,YCNPK,
     1IBUGA3,IERROR)
      IF(CCLSL.NE.CPUMIN.AND.CCUSL.NE.CPUMIN)
     1CALL CPM(Y,N,CCLSL,CCUSL,CCTARG,IWRITE,YCPM,YCPMLL,YCPMUL,
     1IBUGA3,IERROR)
      IF(CCLSL.NE.CPUMIN.AND.CCUSL.NE.CPUMIN)
     1CALL CC(Y,N,CCLSL,CCUSL,CCTARG,IWRITE,YCC,
     1IBUGA3,IERROR)
      IF(CCLSL.NE.CPUMIN.AND.CCUSL.NE.CPUMIN)
     1CALL PERDEF(Y,N,CCLSL,CCUSL,IWRITE,YACTPD,YTHEPD,
     1YACTL,YTHEL,YACTU,YTHEU,
     1IFLAG,IBUGA3,IERROR)
      IF(CCUSLC.NE.CPUMIN)
     1CALL EXPLOS(Y,N,CCLSL,CCUSL,CCUSLC,IWRITE,YEXPLO,
     1IBUGA3,IERROR)
C
C               ****************************
C               **  STEP 7--              **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO890
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,801)
  801 FORMAT(10X,'****************************************************')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,805)
      CALL DPWRST('XXX','BUG ')
  805 FORMAT(10X,'*            CAPABILITY ANALYSIS                   *')
      WRITE(ICOUT,806)N
      CALL DPWRST('XXX','BUG ')
  806 FORMAT(10X,'*     NUMBER OF OBSERVATIONS       = ',I8,'      *')
      WRITE(ICOUT,808)XMEAN
      CALL DPWRST('XXX','BUG ')
  808 FORMAT(10X,'*     MEAN                         = ',F12.5,'  *')
      WRITE(ICOUT,809)XSD
      CALL DPWRST('XXX','BUG ')
  809 FORMAT(10X,'*     STANDARD DEVIATION           = ',F12.5,'  *')
      WRITE(ICOUT,801)
      CALL DPWRST('XXX','BUG ')
      IF(CCLSL.EQ.CPUMIN)THEN
        WRITE(ICOUT,821)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,822)CCLSL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(CCUSL.EQ.CPUMIN)THEN
        WRITE(ICOUT,823)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,824)CCUSL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(CCTARG.EQ.CPUMIN)THEN
        WRITE(ICOUT,825)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,826)CCTARG
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(CCUSLC.EQ.CPUMIN)THEN
        WRITE(ICOUT,827)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,828)CCUSLC
        CALL DPWRST('XXX','BUG ')
      ENDIF
  821 FORMAT(10X,'*  LOWER SPEC LIMIT  (LSL)         =   UNDEFINED   *')
  822 FORMAT(10X,'*  LOWER SPEC LIMIT  (LSL)         = ',F12.5,'  *')
  823 FORMAT(10X,'*  UPPER SPEC LIMIT  (USL)         =   UNDEFINED   *')
  824 FORMAT(10X,'*  UPPER SPEC LIMIT  (USL)         = ',F12.5,'  *')
  825 FORMAT(10X,'*  TARGET         (TARGET)         =   UNDEFINED   *')
  826 FORMAT(10X,'*  TARGET         (TARGET)         = ',F12.5,'  *')
  827 FORMAT(10X,'*  USL COST      (USLCOST)         =   UNDEFINED   *')
  828 FORMAT(10X,'*  USL COST      (USLCOST)         = ',F12.5,'  *')
      WRITE(ICOUT,801)
      CALL DPWRST('XXX','BUG ')
      IF(YCP.EQ.CPUMIN)THEN
        WRITE(ICOUT,831)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,832)YCP
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPLL.EQ.CPUMIN)THEN
        WRITE(ICOUT,861)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,862)YCPLL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPUL.EQ.CPUMIN)THEN
        WRITE(ICOUT,863)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,864)YCPUL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPL.EQ.CPUMIN)THEN
        WRITE(ICOUT,841)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,842)YCPL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPLLL.EQ.CPUMIN)THEN
        WRITE(ICOUT,881)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,882)YCPLLL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPLUL.EQ.CPUMIN)THEN
        WRITE(ICOUT,883)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,884)YCPLUL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPU.EQ.CPUMIN)THEN
        WRITE(ICOUT,843)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,844)YCPU
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPULL.EQ.CPUMIN)THEN
        WRITE(ICOUT,891)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,892)YCPULL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPUUL.EQ.CPUMIN)THEN
        WRITE(ICOUT,893)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,894)YCPUUL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPK.EQ.CPUMIN)THEN
        WRITE(ICOUT,833)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,834)YCPK
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPKLL.EQ.CPUMIN)THEN
        WRITE(ICOUT,871)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,872)YCPKLL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPKUL.EQ.CPUMIN)THEN
        WRITE(ICOUT,873)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,874)YCPKUL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCNPK.EQ.CPUMIN)THEN
        WRITE(ICOUT,845)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,846)YCNPK
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPM.EQ.CPUMIN)THEN
        WRITE(ICOUT,847)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,848)YCPM
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPMLL.EQ.CPUMIN)THEN
        WRITE(ICOUT,849)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,850)YCPMLL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCPMUL.EQ.CPUMIN)THEN
        WRITE(ICOUT,851)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,852)YCPMUL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YCC.EQ.CPUMIN)THEN
        WRITE(ICOUT,853)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,854)YCC
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YACTPD.EQ.CPUMIN)THEN
        WRITE(ICOUT,835)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,836)YACTPD
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YTHEPD.EQ.CPUMIN)THEN
        WRITE(ICOUT,837)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,838)YTHEPD
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YACTL.EQ.CPUMIN)THEN
        WRITE(ICOUT,895)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,896)YACTL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YTHEL.EQ.CPUMIN)THEN
        WRITE(ICOUT,897)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,898)YTHEL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YACTU.EQ.CPUMIN)THEN
        WRITE(ICOUT,905)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,906)YACTL
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YTHEU.EQ.CPUMIN)THEN
        WRITE(ICOUT,907)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,908)YTHEU
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(YEXPLO.EQ.CPUMIN)THEN
        WRITE(ICOUT,839)
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,840)YEXPLO
        CALL DPWRST('XXX','BUG ')
      ENDIF
  831 FORMAT(10X,'*  CP                              =    UNDEFINED  *')
  832 FORMAT(10X,'*  CP                              = ',F12.5,'  *')
  861 FORMAT(10X,'*  CP LOWER 95% CI                 =    UNDEFINED  *')
  862 FORMAT(10X,'*  CP LOWER 95% CI                 = ',F12.5,'  *')
  863 FORMAT(10X,'*  CP UPPER 95% CI                 =    UNDEFINED  *')
  864 FORMAT(10X,'*  CP UPPER 95% CI                 = ',F12.5,'  *')
  833 FORMAT(10X,'*  CPK                             =    UNDEFINED  *')
  834 FORMAT(10X,'*  CPK                             = ',F12.5,'  *')
  871 FORMAT(10X,'*  CPK LOWER 95% CI                =    UNDEFINED  *')
  872 FORMAT(10X,'*  CPK LOWER 95% CI                = ',F12.5,'  *')
  873 FORMAT(10X,'*  CPK UPPER 95% CI                =    UNDEFINED  *')
  874 FORMAT(10X,'*  CPK UPPER 95% CI                = ',F12.5,'  *')
  835 FORMAT(10X,'*  ACTUAL      % DEFECTIVE         =    UNDEFINED  *')
  836 FORMAT(10X,'*  ACTUAL      % DEFECTIVE         = ',F12.5,'  *')
  837 FORMAT(10X,'*  THEORETICAL % DEFECTIVE         =    UNDEFINED  *')
  838 FORMAT(10X,'*  THEORETICAL % DEFECTIVE         = ',F12.5,'  *')
  895 FORMAT(10X,'*  ACTUAL (BELOW) % DEFECTIVE      =    UNDEFINED  *')
  896 FORMAT(10X,'*  ACTUAL (BELOW) % DEFECTIVE      = ',F12.5,'  *')
  897 FORMAT(10X,'*  THEORETICAL (BELOW) % DEFECTIVE =    UNDEFINED  *')
  898 FORMAT(10X,'*  THEORETICAL(BELOW)  % DEFECTIVE = ',F12.5,'  *')
  905 FORMAT(10X,'*  ACTUAL (ABOVE) % DEFECTIVE      =    UNDEFINED  *')
  906 FORMAT(10X,'*  ACTUAL (ABOVE) % DEFECTIVE      = ',F12.5,'  *')
  907 FORMAT(10X,'*  THEORETICAL (ABOVE) % DEFECTIVE =    UNDEFINED  *')
  908 FORMAT(10X,'*  THEORETICAL(ABOVE)  % DEFECTIVE = ',F12.5,'  *')
  839 FORMAT(10X,'*  EXPECTED LOSS                   =    UNDEFINED  *')
  840 FORMAT(10X,'*  EXPECTED LOSS                   = ',F12.5,'  *')
  841 FORMAT(10X,'*  CPL                             =    UNDEFINED  *')
  842 FORMAT(10X,'*  CPL                             = ',F12.5,'  *')
  881 FORMAT(10X,'*  CPL LOWER 95% CI                =    UNDEFINED  *')
  882 FORMAT(10X,'*  CPL LOWER 95% CI                = ',F12.5,'  *')
  883 FORMAT(10X,'*  CPL UPPER 95% CI                =    UNDEFINED  *')
  884 FORMAT(10X,'*  CPL UPPER 95% CI                = ',F12.5,'  *')
  843 FORMAT(10X,'*  CPU                             =    UNDEFINED  *')
  844 FORMAT(10X,'*  CPU                             = ',F12.5,'  *')
  891 FORMAT(10X,'*  CPU LOWER 95% CI                =    UNDEFINED  *')
  892 FORMAT(10X,'*  CPU LOWER 95% CI                = ',F12.5,'  *')
  893 FORMAT(10X,'*  CPU UPPER 95% CI                =    UNDEFINED  *')
  894 FORMAT(10X,'*  CPU UPPER 95% CI                = ',F12.5,'  *')
  845 FORMAT(10X,'*  CNPK                            =    UNDEFINED  *')
  846 FORMAT(10X,'*  CNPK                            = ',F12.5,'  *')
  847 FORMAT(10X,'*  CPM                             =    UNDEFINED  *')
  848 FORMAT(10X,'*  CPM                             = ',F12.5,'  *')
  849 FORMAT(10X,'*  CPM LOWER 95% CI                =    UNDEFINED  *')
  850 FORMAT(10X,'*  CPM LOWER 95% CI                = ',F12.5,'  *')
  851 FORMAT(10X,'*  CPM UPPER 95% CI                =    UNDEFINED  *')
  852 FORMAT(10X,'*  CPM UPPER 95% CI                = ',F12.5,'  *')
  853 FORMAT(10X,'*  CC                              =    UNDEFINED  *')
  854 FORMAT(10X,'*  CC                              = ',F12.5,'  *')
      WRITE(ICOUT,801)
      CALL DPWRST('XXX','BUG ')
C
  890 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 DPCAA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)CCLSL,CCUSL,CCTARG,CCUSLC
 9013 FORMAT('CCLSL,CCUSL,CCTARG,CCUSLC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IFLAG
 9014 FORMAT('IFLAG = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),W(I)
 9017 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCAPA(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 CAPACITORS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE BACK CENTER AND THE FRONT CENTER
C           OF THE CAPACITOR.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN CAPACITOR WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN CAPACITOR WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN CAPACITOR WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      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.'CAPA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCAPA--')
      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='CAPA'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPCAPA--')
      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 CAPACITOR ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH BACK CENTER AT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND FRONT CENTER AT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      CAPACITOR 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      CAPACITOR ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPCAP2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CAPA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCAPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCAP2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW AN CAPACITOR
C              WITH THE BACK CENTER AT (X1,Y1)
C              AND THE FRONT CENTER AT (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
CCCCC CHARACTER*4 ICOLF
CCCCC CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(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.'CAP2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCAP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE CAPACITOR          **
C               *********************************
C
      DELX=X2-X1
      DELY=Y2-Y1
      LEN=SQRT((X2-X1)**2+(Y2-Y1)**2)
      ALEN=LEN
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      AJXMIN=PTEXWI
      AJXDEL=PTEXWI
      AJYDEL=PTEXHE
      AJXMAX=ALEN-AJXDEL
C
      XMIN=AJXMIN
      XDEL=AJXDEL
      YDEL=AJYDEL
      XMAX=AJXMAX
C
      K=0
C
      X=0
CCCCC Y=-ALEN/2.0
      Y=(-YDEL/2.0)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=0
CCCCC Y=ALEN/2.0
      Y=YDEL/2.0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
      K=0
C
      X=ALEN
CCCCC Y=-ALEN/2.0
      Y=(-YDEL/2.0)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=ALEN
CCCCC Y=ALEN/2.0
      Y=YDEL/2.0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
      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.'CAP2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCAP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCAPT(ICOM,ICOM2,
CCCCC JUNE 2002.  ADD ICAPTY SWITCH.
     1ICAPSW,ICAPTY,ICAPSC,IPRDEF,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM,IANSLC,IANS,IWIDTH,
     1IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IOFILE,
CCCCC JUNE 2002.  ADD FOLLOWING ARGUMENTS TO ALLOW "CALL DPERAS".
     1IBACCO,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1IDFONT,
CCCCC END OF NEW ARGUMENTS
     1IREPCH,IMPSW,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--INITIATE/TERMINATE A CAPTURE FILE
C              FOR CAPTURING/REDIRECTIUNG ALPHANUMERIC
C              OUTPUT (ONLY)--NOT EFFECT GRAPHICS OUTPUT.
C              THERE ARE 2 CAPABILITITES IN THIS REGARD--
C                 1) TURN THE CAPTURE SWITCH 'ON' WHICH WILL
C                    ALLOW A CAPTURE FILE TO BE OPENED.
C                 2) TURN THE CAPTURE SWITCH 'OFF' WHICH WILL
C                    TERMINATE THE ENTRY OF TEXT OUTPUT
C                    INTO THE CAPTURE FILE.
C     NOTE--THESE CAPABILITITIES
C           WILL ALLOW THE ALPHANUMERIC OUTPUT
C           (NOT GRAPHICS OUTPUT)
C           FROM ANY DATAPLOT COMMAND TO
C           BE CAPTURED (OR REDIRECTED)
C           TO ANY FILE.
C           ALL SUBSEQUENT DATAPLOT ALPHANUMERIC OUTPUT
C           ARE AUTOMATICALLY DIVERTED FROM THE SCREEN
C           TO THE SPECIFIED SYSTEM FILE OR SUBFILE.
C           WHEN THE CAPTURE SWITCH IS OFF,
C           NO SUCH DIVERSION IS DONE.
C           THE SPECIFIED STATUS (ON/OFF) OF THE CAPTURE
C           WILL BE PLACED
C           IN THE HOLLERITH VARIABLE ICAPSW.
C     INPUT  ARGUMENTS--ICOM
C                     --ICOM2
C                     --ICAPSW
C                     --ICAPTY
C                     --IANSLC (A  HOLLERITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              ORIGINAL INPUT COMMAND LINE.
C                     --IWIDTH (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE ORIGINAL COMMAND LINE.
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IBUG   (A HOLLERITH VARIABLE
C                               FOR DEBUGGING
C     PRIMARY CHANGED VARIABLE--IPR (IN COMMON)
C     OUTPUT ARGUMENTS--ICAPSW (AN INTEGER VARIABLE
C                              WHICH IF 'ON' INDICATES THAT
C                              CURRENT COMMANDS ARE
C                              BEING DIVERTED
C                              TO A CAPTURE TEXT; AND
C                              IF OFF INDICATES THAT
C                              A CAPTURE FILE IS NOT BEING CONSTRUCTED.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/6
C     ORIGINAL VERSION--JUNE      1989.
C     UPDATED         --JUNE      2002.  ADD SUPPORT FOR:
C                                        CAPTURE FLUSH
C                                        CAPTURE HTML FILE.
C                                        CAPTURE LATEX FILE.
C     UPDATED         --JANUARY   2003.  FOR CAPTURE HTML, OPTIONALLY
C                                        READ HEADER AND FOOTER FILES
C     UPDATED         --JULY      2003.  BUG: FILE NAME < 80
C                                        CHARACTERS, BUT COMMAND LINE
C                                        > 80 CHARACTERS
C     UPDATED         --SEPTEMBER 2003.  START IMPLEMENTING THE LATEX
C                                        CODE
C     UPDATED         --FEBRUARY  2005.  START IMPLEMENTING THE RTF
C                                        CODE
C     UPDATED         --DECEMBER  2005.  SUSPEND/RESUME CASES
C     UPDATED         --JANUARY   2006.  CAPTURE SCREEN <ON/OFF>
C     UPDATED         --FEBRUARY  2006.  ADD EPIC, EEPIC, GRAPHICS
C                                        PACKAGES TO LATEX PRE-AMBLE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 ICOM2
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ICAPSC
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANSLC
      CHARACTER*4 IANS
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IOFILE
C
      CHARACTER*240 IATEMP
      CHARACTER*4   IATMP2
      CHARACTER*1   ITEMP
C
      CHARACTER*4 IREPCH
      CHARACTER*4 IMPSW
C
      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*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*4 IANSI
CCCCC CHARACTER*80 ICANS
      CHARACTER*200 ICANS
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IFILQ2
C
      CHARACTER*1 IBASLC
C
C ---------------------------------------------------------------------
C
      DIMENSION IANSLC(*)
      DIMENSION IANS(*)
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      CHARACTER*4 IBACCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
C
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
      CHARACTER*4 IDFONT
C
      CHARACTER*4 IFLAG
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
C
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPCA'
      ISUBN2='PT  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IFILQ2=IFILQU
      IFILQU='ON'
C
      KMIN=0
      KDEL=0
      KMAX=0
      JP3=0
      JP4=0
      JP5=0
      IH='UNKN'
      IH2='UNKN'
      J12=0
      J22=0
      J32=0
      J42=0
      J52=0
      J62=0
      J72=0
      J82=0
      J92=0
      J102=0
      IPAR2=0
      IPAR3=0
      IPAR4=0
      IPAR5=0
      IPAR6=0
      IPAR7=0
      IPAR8=0
      IPAR9=0
      IPAR10=0
C
      P2=0.0
C
      CALL DPCONA(92,IBASLC)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'CAPT')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCAPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICAPSW,ICAPTY,ICAPNU,ICAPCS,IPR,IPRDEF
   52 FORMAT('ICAPSW,ICAPTY,ICAPNU,ICAPCS,IPR,IPRDEF = ',
     1       2A4,I8,2X,A12,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,IERROR
   53 FORMAT('IBUGS2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ICOM,ICOM2,IWIDTH
   54 FORMAT('ICOM,ICOM2,IWIDTH = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(IANSLC(I),I=1,MIN(120,IWIDTH))
   55 FORMAT('IANSLC(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMARG
   56 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO59
      DO57I=1,NUMARG
      WRITE(ICOUT,58)I,IHARG(I),IHARG2(I)
   58 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   57 CONTINUE
   59 CONTINUE
      WRITE(ICOUT,62)NUMNAM,MAXNAM
   62 FORMAT('NUMNAM,MAXNAM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMNAM
      WRITE(ICOUT,66)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
   66 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,72)NUMCHA
   72 FORMAT('NUMCHA = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)(IA(I),I=1,MIN(100,NUMCHA))
   73 FORMAT('(IA(I),I=1,NUMCHA) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)ICAPNU
   81 FORMAT('ICAPNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)ICAPNA
   82 FORMAT('ICAPNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)ICAPST
   83 FORMAT('ICAPST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)ICAPFO
   84 FORMAT('ICAPFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)ICAPAC
   85 FORMAT('ICAPAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)ICAPFO
   86 FORMAT('ICAPFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)ICAPCS
   87 FORMAT('ICAPCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ****************************************************
C               **  STEP 11--                                     **
C               **  FOR THE SPECIAL CASE WHEN THE                 **
C               **  CAPTURING OF ALPHA TEXT HAS JUST BEEN FINISHED,  **
C               **  JUMP TO CLOSING THE FILE                      **
C               ****************************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICAPCS.EQ.'CLO2        ')GOTO5000
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  FOR THE SPECIAL CASE WHEN HAVE THE       **
C               **  END CAPTURE     COMMAND, OR THE           **
C               **  END REDIRECT      COMMAND, OR THE           **
C               **  END OF CAPTURE      COMMAND,              **
C               **  END OF REDIRECT       COMMAND,              **
C               **  JUMP IMMEDIATELY TO THE SECTION OF CODE  **
C               **  WHICH PUTS ON AN END OF FILE AND         **
C               **  CLOSES THE FILE/SUBFILE.                 **
C               ***********************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'END ')THEN
        IF(NUMARG.LE.0)GOTO1290
        IF(IHARG(1).EQ.'CAPT')GOTO4000
        IF(IHARG(1).EQ.'REDI')GOTO4000
        IF(IHARG(1).EQ.'DIVE')GOTO4000
        IF(IHARG(1).EQ.'PIPE')GOTO4000
        IF(NUMARG.LE.1)GOTO1290
        IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'CAPT')GOTO4000
        IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'REDI')GOTO4000
        IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'DIVE')GOTO4000
        IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'PIPE')GOTO4000
      ELSEIF(ICOM.EQ.'FLUS')THEN
        IF(NUMARG.LT.1)GOTO1290
        IF(IHARG(1).EQ.'CAPT')GOTO6000
      ELSEIF(ICOM.EQ.'CAPT')THEN
        IF(NUMARG.LT.1)GOTO1290
        IF(IHARG(1).EQ.'FLUS')GOTO6000
      ENDIF
C
 1290 CONTINUE
C
C               ****************************************************************
C               **  STEP 13--
C               **  DETERMINE THE TYPE CASE--
C               **       1) CREATE AN EXPLICIT CAPTURE FILE;
C               **       2) OMIT THE FILE NAME;
C               **  NOTE--IOFILE  WILL EQUAL 'YES' ONLY IN FILE CASE.
C               **  IN OTHER WORDS, THIS STEP MAKES SURE
C               **  THAT A FILE NAME IS EXISTENT AFTER THE
C               **  CAPTURE   AND   REDIRECT   COMMANDS.
C               ****************************************************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'SUSP')GOTO2000
      IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'OFF ')GOTO2000
      IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'RESU')GOTO2000
      IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'ON  ')GOTO2000
      IF(NUMARG.GE.1 .AND. IHARG(1).EQ.'SCRE')GOTO2000
C
      IWORD=2
      IF(IHARG(1).EQ.'HTML'.OR.IHARG(1).EQ.'LATE'.OR.
     1   IHARG(1).EQ.'RTF ')IWORD=3
      CALL DPFILE(IANSLC,IWIDTH,IWORD,
     1IOFILE,IBUGS2,ISUBRO,IERROR)
C
C               **********************************************
C               **  STEP 14--                               **
C               **  IF NO FILE NAME GIVEN,                  **
C               **  THEN GENERATE AN ERROR MESSAGE.         **
C               **********************************************
C
 1401 CONTINUE
      ISTEPN='14'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES')GOTO1490
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPCAPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      THE DESIRED CAPTURE OPERATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
 1414 FORMAT('      NO USER FILE NAME WAS GIVEN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      ILLUSTRATIVE EXAMPLE TO DEMONSTRATE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)
 1416 FORMAT('      THE PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1417)
 1417 FORMAT('      SUPPOSE THE ANALYST WISHES TO CAPTURE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      TEXT OUTPUT TO THE FILE    TEMP1.  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      THEN THE FOLLOWING COMMAND LINE IS ENTERED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('         CAPTURE TEMP1.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1490 CONTINUE
C
C               *************************************
C               **  STEP 15--                      **
C               **  IF HAVE THE FILE INPUT CASE    **
C               **  (WHICH WE MUST HAVE)--         **
C               **  COPY OVER VARIABLES            **
C               *************************************
C
      ISTEPN='15'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ICAPNU
      IFILE=ICAPNA
      ISTAT=ICAPST
      IF(IFILE.EQ.ISYSNA)ISTAT=ISYSST
      IF(IFILE.EQ.ILOGNA)ISTAT=ILOGST
      IFORM=ICAPFO
      IACCES=ICAPAC
      IPROT=ICAPPR
C     (SEE ADDITIONAL RESETTING OF   IPROT   BELOW
C     IF HAVE THE SYSTEM LOGIN AND/OR THE LOCAL LOGIN CAPTURE FILES)
      ICURST=ICAPCS
C
      ISUBN0='CAPT'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'CAPT')GOTO1519
      WRITE(ICOUT,1513)IOUNIT
 1513 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1514)IFILE
 1514 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)ISTAT,IFORM,IACCES,IPROT,ICURST
 1515 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1516)ISUBN0,IERRFI
 1516 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
C
C               ***********************************************
C               **  STEP 16--                                **
C               **  IF HAVE THE FILE CASE--                  **
C               **  (WHICH WE MUST HAVE)--                   **
C               **  CHECK TO SEE IF THE CAPTURE FILE MAY EXIST **
C               ***********************************************
C
      ISTEPN='16'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1610
      GOTO1690
C
 1610 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1611)
 1611 FORMAT('***** IMPLEMENTATION ERROR IN DPCAPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1612)
 1612 FORMAT('      THE DESIRED CAPTURE OPERATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1613)
 1613 FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1614)
 1614 FORMAT('      THE INTERNAL VARIABLE    ICAPST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('      WHICH ALLOWS SUCH CAPTURE OPERATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1616)
 1616 FORMAT('      HAS BEEN SET TO    NONE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1617)ISTAT,ICAPST
 1617 FORMAT('ISTAT,ICAPST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1618)
 1618 FORMAT('      PLEASE CONTACT YOUR DATAPLOT IMPLEMENTOR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1619)
 1619 FORMAT('      TO CORRECT THE SETTING IN SUBROUTINE INITFO.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1690 CONTINUE
C
C               ********************************
C               **  STEP 17--                 **
C               **  EXTRACT THE FILE NAME.    **
C               **  THIS IS NEEDED FOR MOST   **
C               **  (BUT NOT ALL) VARIATIONS  **
C               **  OF THE CAPTURE COMMAND.   **
C               ********************************
C
      ISTEPN='17'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC JUNE 2002.  CHECK TO SEE IF FIRST ARGUMENT IS:
CCCCC             HTML
CCCCC             LATEX
CCCCC             RTF            (FEBRUARY 2005)
C
      NSTRT=1
C
      IF(IHARG(1).EQ.'HTML')THEN
        ICAPTY='HTML'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1771)
 1771   FORMAT('THE CAPTURE OUTPUT WILL BE WRITTEN IN HTML FORMAT.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IHARG(1).EQ.'LATE')THEN
        ICAPTY='LATE'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1791)
 1791   FORMAT('THE CAPTURE OUTPUT WILL BE WRITTEN IN LATEX FORMAT.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IHARG(1).EQ.'RTF ')THEN
        ICAPTY='RTF '
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1793)
 1793   FORMAT('THE CAPTURE OUTPUT WILL BE WRITTEN IN ',
     1         'RTF (RICH TEXT FORMAT) FORMAT.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      DO1710I=1,200
      IANSI=IANSLC(I)
      ICANS(I:I)=IANSI(1:1)
 1710 CONTINUE
C
      ISTART=1
      ISTOP=IWIDTH
      IWORD=2
      IF(ICAPTY.EQ.'HTML')IWORD=3
      IF(ICAPTY.EQ.'LATE')IWORD=3
      IF(ICAPTY.EQ.'RTF ')IWORD=3
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,IFILE,NCFILE,
     1IBUGS2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(NCFILE.GE.1)GOTO1749
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1741)
 1741 FORMAT('***** ERROR IN DPCAPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1742)
 1742 FORMAT('      A USER FILE NAME IS REQUIRED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1743)
 1743 FORMAT('      IN THE CAPTURE/REDIRECT COMMANDS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1744)
 1744 FORMAT('      (FOR EXAMPLE,    CAPTURE TEMP1.)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1745)
 1745 FORMAT('      BUT NONE WAS GIVEN HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1746)
 1746 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1747)(IANSLC(I),I=1,IWIDTH)
 1747 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
 1749 CONTINUE
C
 1790 CONTINUE
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFILE.EQ.ISYSNA)IPROT=ISYSPR
      IF(IFILE.EQ.ILOGNA)IPROT=ILOGPR
C
C               *****************************************
C               **  STEP 20--                          **
C               **  CHECK THE DESIRED CAPTURE OPERATION  **
C               **  (ON, OFF, OR EXECUTE).             **
C               *****************************************
C
 2000 CONTINUE
C
      ISTEPN='20'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'CAPT')GOTO2100
      IF(ICOM.EQ.'REDI')GOTO2100
      IF(ICOM.EQ.'DIVE')GOTO2100
      IF(ICOM.EQ.'PIPE')GOTO2100
      IF(ICOM.EQ.'END '.AND.ICOM2.EQ.'    ')GOTO2200
      GOTO2900
C
 2100 CONTINUE
CCCCC IF(NUMARG.LE.0)GOTO2900
      IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'SUSP')GOTO3800
      IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'OFF ')GOTO3800
      IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'RESU')GOTO3900
      IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'ON  ')GOTO3900
      IF(NUMARG.GE.1 .AND. IHARG(1).EQ.'SCRE')THEN
        ICAPSC='ON'
        IF(NUMARG.GE.2 .AND. IHARG(2).EQ.'OFF ')ICAPSC='OFF '
        IF(NUMARG.GE.2 .AND. IHARG(2).EQ.'END ')ICAPSC='OFF '
        IF(NUMARG.GE.2 .AND. IHARG(2).EQ.'NO  ')ICAPSC='OFF '
        IF(NUMARG.GE.2 .AND. IHARG(2).EQ.'NONE')ICAPSC='OFF '
        IF(NUMARG.GE.2 .AND. IHARG(2).EQ.'CLOS')ICAPSC='OFF '
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'OFF')GOTO9000
        IF(ICAPSC.EQ.'ON')THEN
          WRITE(ICOUT,2111)
 2111     FORMAT('CAPTURE OUTPUT WILL BE WRITTEN TO BOTH THE ',
     1           'CAPTURE FILE AND THE SCREEN.')
        ELSE
          WRITE(ICOUT,2113)
 2113     FORMAT('CAPTURE OUTPUT WILL BE WRITTEN TO THE ',
     1           'CAPTURE FILE ONLY.')
        ENDIF
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      GOTO3000
C
 2200 CONTINUE
      IF(NUMARG.LE.0)GOTO2900
      IF(IHARG(1).EQ.'CAPT')GOTO4000
      IF(IHARG(1).EQ.'REDI')GOTO4000
      IF(IHARG(1).EQ.'DIVE')GOTO4000
      IF(IHARG(1).EQ.'PIPE')GOTO4000
      IF(NUMARG.LE.1)GOTO2900
      IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'CAPT')GOTO4000
      IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'REDI')GOTO4000
      IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'DIVE')GOTO4000
      IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'PIPE')GOTO4000
      GOTO2900
C
 2900 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2911)
 2911 FORMAT('***** ERROR IN DPCAPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2912)
 2912 FORMAT('      THE DESIRED CAPTURE OPERATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2913)
 2913 FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2914)
 2914 FORMAT('      SPECIFIED OPERATION WAS ILLEGAL.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2915)
 2915 FORMAT('      ILLUSTRATIVE EXAMPLE TO DEMONSTRATE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2916)
 2916 FORMAT('      THE PROPER FORMS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2917)
 2917 FORMAT('         CAPTURE TEMP1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2918)
 2918 FORMAT('         END OF CAPTURE')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               ****************************************************************
C               **  STEP 30--
C               **  TREAT THE CAPTURE CASE.
C               **  CARRY OUT WHATEVER SYSTEM OPERATIONS ARE NEEDED
C               **  IN ORDER TO OPERATE ON THE FILE OR SUBFILE.
C               **  FOR MOST INSTALLATIONS, THIS REQUIRES
C               **      1) AN OPENING OF THE FILE OR SUBFILE;
C               **      2) AN EQUIVALENCING OF THE FILE OR SUBFILE;
C               **      3) A  REWINDING OF THE FILE OR SUBFILE.
C               **  THE CODE BELOW
C               **  OPENS THE FILE OR SUBFILE (VIA @ASG,AX ON THE UNIVAC 1108).
C               **  THE CODE ALSO EQUIVALENCES THE FILES OR SUBFILES (VIA @USE O
C               **  UNIVAC 1108) TO THE FORTRAN LOGICAL UNIT NUMBER DESIGNATED
C               **  IN THE VARIABLE ICAPNU (IN THE SUBROUTINE
C               **  INITFO);
C               **  THE CODE ALSO REWINDS THE FILE OR SUBFILE. (VIA @REWIND ON T
C               **  UNIVAC 1108).
C               ****************************************************************
C
 3000 CONTINUE
      ISTEPN='30'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICAPSW='ON'
      IOUNIT=ICAPNU
C
      ICAPNA=IFILE
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
      ICAPCS=ICURST
C
      IF(IFEEDB.EQ.'OFF')GOTO3029
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3011)
 3011 FORMAT('THE CAPTURE SWITCH HAS JUST BEEN TURNED ON.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3012)ICAPNA
 3012 FORMAT('NAME OF CAPTURE FILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3013)
 3013 FORMAT('ALL SUBSEQUENT TEXT OUTPUT FROM ANY DATAPLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3014)
 3014 FORMAT('COMMAND WILL BE CAPTURED/REDIRECTED INTO THIS FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3015)
 3015 FORMAT('ONLY TEXT OUTPUT IS CAPTURED--NOT GRAPHICS OUTPUT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3016)
 3016 FORMAT('THE CAPTURED INFO WILL OVERWRITE THE PREVIOUS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3017)
 3017 FORMAT('CONTENTS OF THE SPECIFIED FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3018)
 3018 FORMAT('THE TEXT CAPTURING WILL CONTINUE UNTIL YOU ENTER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3019)
 3019 FORMAT('THE COMMAND        END OF CAPTURE')
      CALL DPWRST('XXX','BUG ')
 3029 CONTINUE
C
      IPR=ICAPNU
C
CCCCC JUNE 2002.  SPECIAL CASE OF GRAPHICS, LATEK, OR HTML.  ADD
CCCCC ANY SPECIAL NEEDED INITIALIZATION CODE HERE.
C
CCCCC JANUARY 2003.  SET HTML HEADER FILE CAN BE USED TO SPECIFY A
CCCCC A FILE TO INCORPORATE THE HEADER FILE.
C
CCCCC IF(ICAPTY.EQ.'GRAP')THEN
CCCCC   CONTINUE
      IF(ICAPTY.EQ.'HTML')THEN
        IF(IHTMHE.EQ.'NULL')THEN
          WRITE(ICOUT,3071)
 3071     FORMAT('<HTML>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3073)
 3073     FORMAT('<HEAD>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3075)
 3075     FORMAT('<TITLE>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3077)
 3077     FORMAT('Dataplot Output')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3079)
 3079     FORMAT('</TITLE>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3081)
 3081     FORMAT('<META HTTP-EQUIV="Content-Type" CONTENT="text/html;',
     1           ' charset=iso-8859-1">')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3083)
 3083     FORMAT('</HEAD>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3085)
 3085     FORMAT('<BODY BGCOLOR=#FFFFFF>')
          CALL DPWRST('XXX','WRIT')
        ELSE
          IOUNI2=IST1NU
          IFILE2=IHTMHE
          ISTAT2='OLD'
          IFORM2='FORMATTED'
          IACCE2='SEQUENTIAL'
          IPROT2='READONLY'
          ICURS2='CLOSED'
          ISUBN0='CAPT'
          IERRF2='NO'
C
          IREWI2='ON'
          CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
C
C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
C
          DO3091I=1,1000
            IATEMP=' '
            READ(IOUNI2,3092,END=3099,ERR=3099)IATEMP
 3092       FORMAT(A240)
            ILAST=1
            DO3096J=240,1,-1
              IF(IATEMP(J:J).NE.' ')THEN
                ILAST=J
                GOTO3098
              ENDIF
 3096       CONTINUE
 3098       CONTINUE
            WRITE(ICOUT,3094)(IATEMP(J:J),J=1,ILAST)
            NCOUT=ILAST
 3094       FORMAT(240A1)
            CALL DPWRST('XXX','WRIT')
 3091     CONTINUE
 3099     CONTINUE
          IENDF2='OFF'
          IREWI2='ON'
          CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IENDF2,IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
        ENDIF
        WRITE(ICOUT,3087)
 3087   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPTY.EQ.'LATE')THEN
        IF(ILATHE.EQ.'NULL')THEN
          WRITE(ICOUT,3171)IBASLC
 3171     FORMAT(A1,'documentclass[12pt]{article}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3173)IBASLC
 3173     FORMAT(A1,'usepackage{epsfig}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3174)IBASLC
 3174     FORMAT(A1,'usepackage{epic,eepic}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3175)IBASLC
 3175     FORMAT(A1,'usepackage{graphics,color}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13171)IBASLC,IBASLC
13171     FORMAT(A1,'setlength{',A1,'textwidth}{6.25in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13172)IBASLC,IBASLC
13172     FORMAT(A1,'setlength{',A1,'textheight}{9in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13173)IBASLC,IBASLC
13173     FORMAT(A1,'setlength{',A1,'oddsidemargin}{0.25in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13174)IBASLC,IBASLC
13174     FORMAT(A1,'setlength{',A1,'evensidemargin}{0in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13175)IBASLC,IBASLC
13175     FORMAT(A1,'setlength{',A1,'headheight}{0.5in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13176)IBASLC,IBASLC
13176     FORMAT(A1,'setlength{',A1,'headsep}{0.5in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13177)IBASLC,IBASLC
13177     FORMAT(A1,'setlength{',A1,'topmargin}{-1in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13178)IBASLC,IBASLC
13178     FORMAT(A1,'setlength{',A1,'parindent}{0in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13179)IBASLC,IBASLC
13179     FORMAT(A1,'setlength{',A1,'parskip}{10pt}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13180)IBASLC,IBASLC
13180     FORMAT(A1,'setlength{',A1,'textfloatsep}{4ex}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13181)IBASLC,IBASLC
13181     FORMAT(A1,'addtolength{',A1,'footskip}{0.25in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13182)IBASLC
13182     FORMAT(A1,'overfullrule=0pt')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,13183)IBASLC
13183     FORMAT(A1,'baselineskip=12pt')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3181)IBASLC,IBASLC,IBASLC
 3181     FORMAT(A1,'newcommand{',A1,'PGRAPHIC}[1]{',A1,'begin{figure}',
     1           '[h]')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3182)IBASLC
 3182     FORMAT(23X,A1,'epsfig{file=#1,width=6.0in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3183)IBASLC
 3183     FORMAT(23X,A1,'end{figure}}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3186)IBASLC,IBASLC,IBASLC
 3186     FORMAT(A1,'newcommand{',A1,'LGRAPHIC}[1]{',A1,'begin{figure}',
     1           '[h]')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3187)IBASLC
 3187     FORMAT(23X,A1,'epsfig{file=#1,angle=-90,width=6.0in}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3188)IBASLC
 3188     FORMAT(23X,A1,'end{figure}}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3191)IBASLC
 3191     FORMAT(A1,'begin{document}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3197)IBASLC
 3197     FORMAT(A1,'begin{verbatim}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ELSE
          IOUNI2=IST1NU
          IFILE2=ILATHE
          ISTAT2='OLD'
          IFORM2='FORMATTED'
          IACCE2='SEQUENTIAL'
          IPROT2='READONLY'
          ICURS2='CLOSED'
          ISUBN0='CAPT'
          IERRF2='NO'
C
          IREWI2='ON'
          CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
C
C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
C
          DO3291I=1,1000
            IATEMP=' '
            READ(IOUNI2,3292,END=3299,ERR=3299)IATEMP
 3292       FORMAT(A240)
            ILAST=1
            DO3296J=240,1,-1
              IF(IATEMP(J:J).NE.' ')THEN
                ILAST=J
                GOTO3298
              ENDIF
 3296       CONTINUE
 3298       CONTINUE
            WRITE(ICOUT,3294)(IATEMP(J:J),J=1,ILAST)
            NCOUT=ILAST
 3294       FORMAT(240A1)
            CALL DPWRST('WRIT','BUG ')
 3291     CONTINUE
 3299     CONTINUE
          IENDF2='OFF'
          IREWI2='ON'
          CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IENDF2,IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
          WRITE(ICOUT,3197)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
      ELSEIF(ICAPTY.EQ.'RTF ')THEN
CCCCC   IF(IRTFHE.EQ.'NULL')THEN
          WRITE(ICOUT,3351)IBASLC,IBASLC,IBASLC
 3351     FORMAT('{',A1,'rtf1',A1,'ansi',A1,'deff0')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3361)IBASLC
 3361     FORMAT('{',A1,'fonttbl')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3363)IBASLC,IBASLC
 3363     FORMAT('{',A1,'f0',A1,'froman Times New Roman;}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3367)IBASLC,IBASLC
 3367     FORMAT('{',A1,'f1',A1,'fmodern Courier New;}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3369)IBASLC,IBASLC
 3369     FORMAT('{',A1,'f2',A1,'froman Arial;}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3371)IBASLC,IBASLC
 3371     FORMAT('{',A1,'f3',A1,'froman Bookman;}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3373)IBASLC,IBASLC
 3373     FORMAT('{',A1,'f4',A1,'froman Georgia;}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3375)IBASLC,IBASLC
 3375     FORMAT('{',A1,'f5',A1,'fswiss Tahoma;}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3376)IBASLC,IBASLC
 3376     FORMAT('{',A1,'f6',A1,'fswiss Lucida Sans;}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3377)IBASLC,IBASLC
 3377     FORMAT('{',A1,'f7',A1,'fswiss Verdana;}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3378)IBASLC,IBASLC
 3378     FORMAT('{',A1,'f8',A1,'fmodern Lucida Console;}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3379)
 3379     FORMAT('}')
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,3384)IBASLC
 3384     FORMAT('{',A1,'info')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3385)IBASLC
 3385     FORMAT('{',A1,'title Dataplot RTF Document}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3386)IBASLC
 3386     FORMAT('{',A1,'author Alan Heckert}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3387)IBASLC
 3387     FORMAT('{',A1,'company Statistical Engineering Division, ',
     1           'NIST}')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3379)
          CALL DPWRST('XXX','WRIT')
C
          IPTSZ=2*IRTFPS
          IF(IPTSZ.LT.0 .OR. IPTSZ.GT.99)IPTSZ=20
          ITEMP='0'
          IF(IRTFFP.EQ.'Arial')ITEMP='2'
          IF(IRTFFP.EQ.'Bookman')ITEMP='3'
          IF(IRTFFP.EQ.'Georgia')ITEMP='4'
          IF(IRTFFP.EQ.'Tahoma')ITEMP='5'
          IF(IRTFFP.EQ.'Lucida Sans')ITEMP='6'
          IF(IRTFFP.EQ.'Verdana')ITEMP='7'
          IF(IPTSZ.LE.9)THEN
            WRITE(ICOUT,3381)IBASLC,IBASLC,IBASLC,IBASLC,ITEMP,
     1                       IBASLC,IPTSZ
 3381       FORMAT(A1,'delang1033',A1,'widowctrl',A1,'plain',
     1             A1,'f',A1,A1,'fs',I1)
          ELSE
            WRITE(ICOUT,3382)IBASLC,IBASLC,IBASLC,IBASLC,ITEMP,
     1                       IBASLC,IPTSZ
 3382       FORMAT(A1,'delang1033',A1,'widowctrl',A1,'plain',
     1             A1,'f',A1,A1,'fs',I2)
          ENDIF
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,3389)IBASLC
 3389     FORMAT('{',A1,'pard')
          CALL DPWRST('XXX','WRIT')
          IRTFMD='VERB'
        ELSE
CCCCC     IOUNI2=IST1NU
CCCCC     IFILE2=ILATHE
CCCCC     ISTAT2='OLD'
CCCCC     IFORM2='FORMATTED'
CCCCC     IACCE2='SEQUENTIAL'
CCCCC     IPROT2='READONLY'
CCCCC     ICURS2='CLOSED'
CCCCC     ISUBN0='CAPT'
CCCCC     IERRF2='NO'
C
CCCCC     IREWI2='ON'
CCCCC     CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
CCCCC1                IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
CCCCC     IF(IERRF2.EQ.'YES')GOTO9000
C
C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
C
CCCCC     DO3491I=1,1000
CCCCC       IATEMP=' '
CCCCC       READ(IOUNI2,3492,END=3299,ERR=3299)IATEMP
C3492       FORMAT(A240)
CCCCC       ILAST=1
CCCCC       DO3496J=240,1,-1
CCCCC         IF(IATEMP(J:J).NE.' ')THEN
CCCCC           ILAST=J
CCCCC           GOTO3498
CCCCC         ENDIF
C3496       CONTINUE
C3498       CONTINUE
CCCCC       WRITE(ICOUT,3494)(IATEMP(J:J),J=1,ILAST)
CCCCC       NCOUT=ILAST
C3494       FORMAT(240A1)
CCCCC       CALL DPWRST('WRIT','BUG ')
C3491     CONTINUE
C3499     CONTINUE
CCCCC     IENDF2='OFF'
CCCCC     IREWI2='ON'
CCCCC     CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
CCCCC1                IENDF2,IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
CCCCC     IF(IERRF2.EQ.'YES')GOTO9000
CCCCC     WRITE(ICOUT,3197)IBASLC
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC   ENDIF
      ENDIF
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 38--                                       **
C               **  TREAT THE CAPTURE SUSPEND CASE.                 **
C               **  RESET OUTPUT UNIT TO IPR, BUT DO NOT CLOSE      **
C               **  THE CAPTURE FILE.                               **
C               ******************************************************
C
 3800 CONTINUE
      ISTEPN='38'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICAPSW.EQ.'OFF')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3811)
 3811   FORMAT('****** WARNING: THE CAPTURE SWITCH IS CURRENTLY OFF.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3813)
 3813   FORMAT('       CAPTURE SUSPEND COMMAND IGNORED.')
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      ICAPSW='OFF'
      IOUNIT=ICAPNU
      IPR=IPRDEF
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 39--                                       **
C               **  TREAT THE CAPTURE RESUME  CASE.                 **
C               **  RESET OUTPUT UNIT TO CAPTURE UNIT, BUT DO NOT   **
C               **  REOPEN THE CAPTURE FILE.                        **
C               ******************************************************
C
 3900 CONTINUE
      ISTEPN='39'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICAPSW.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3911)
 3911   FORMAT('****** WARNING: THE CAPTURE SWITCH IS CURRENTLY ON.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3913)
 3913   FORMAT('       CAPTURE RESUME COMMAND IGNORED.')
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
      ICAPSW='ON'
      IPR=ICAPNU
C
      GOTO9000
C
C               ****************************************************************
C               **  STEP 40--
C               **  TREAT THE END OF CAPTURE CASE.
C               **  CARRY OUT WHATEVER SYSTEM OPERATIONS ARE NEEDED
C               **  IN ORDER TO OPERATE ON THE FILE OR SUBFILE.
C               **  FOR MOST INSTALLATIONS, THIS REQUIRES
C               **      1) A PLACING OF AN END MARK OF THE FILE OR SUBFILE;
C               **      2) A FREEING (DEASSIGNING) OF THE FILE OR SUBFILE;
C               ****************************************************************
C
 4000 CONTINUE
      ISTEPN='40'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICAPSW='OFF'
CCCCC JUNE 2002.  SPECIAL CASE OF GRAPHICS, LATEK, OR HTML.  ADD
CCCCC ANY SPECIAL NEED TERMINATION CODE HERE.
C
CCCCC JANUARY 2003.  SET HTML FOOTER FILE CAN BE USED TO SPECIFY A
CCCCC A FILE TO INCORPORATE THE FOOTER FILE.
C
CCCCC IF(ICAPTY.EQ.'GRAP')THEN
CCCCC   IPR=IPRDEF
CCCCC   IF(IFEEDB.EQ.'ON')THEN
CCCCC     WRITE(ICOUT,999)
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     WRITE(ICOUT,4111)
C4111     FORMAT('THE CAPTURE GRAPHICS SWITCH HAS JUST BEEN TURNED ',
CCCCC1           'OFF.')
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     WRITE(ICOUT,4113)
C4113     FORMAT('ALL FUTURE TEXT OUTPUT WILL NOW REVERT TO ',
CCCCC1           'THE SCREEN.')
CCCCC     CALL DPWRST('XXX','BUG ')
C4119     CONTINUE
CCCCC     GOTO9000
CCCCC   ENDIF
      IF(ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,4110)
 4110   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        IF(IHTMFO.EQ.'NULL')THEN
          WRITE(ICOUT,4112)
 4112     FORMAT('</BODY>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4114)
 4114     FORMAT('</HTML>')
          CALL DPWRST('XXX','WRIT')
        ELSE
          IOUNI2=IST1NU
          IFILE2=IHTMFO
          ISTAT2='OLD'
          IFORM2='FORMATTED'
          IACCE2='SEQUENTIAL'
          IPROT2='READONLY'
          ICURS2='CLOSED'
          ISUBN0='CAPT'
          IERRF2='NO'
C
          IREWI2='ON'
          CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
C
C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
C
          DO4121I=1,1000
            IATEMP=' '
            READ(IOUNI2,4122,END=4129,ERR=4129)IATEMP
 4122       FORMAT(A240)
            ILAST=1
            DO4126J=240,1,-1
              IF(IATEMP(J:J).NE.' ')THEN
                ILAST=J
                GOTO4128
              ENDIF
 4126       CONTINUE
 4128       CONTINUE
            WRITE(ICOUT,4124)(IATEMP(J:J),J=1,ILAST)
            NCOUT=ILAST
 4124       FORMAT(240A1)
            CALL DPWRST('XXX','WRIT')
 4121     CONTINUE
 4129     CONTINUE
          IENDF2='OFF'
          IREWI2='ON'
          CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IENDF2,IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
        ENDIF
      ELSEIF(ICAPTY.EQ.'LATE')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4208)IBASLC
 4208   FORMAT(A1,'end{verbatim}')
        CALL DPWRST('XXX','WRIT')
        IF(ILATFO.EQ.'NULL')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4210)IBASLC
 4210     FORMAT(A1,'end{document}')
          CALL DPWRST('XXX','WRIT')
        ELSE
          IOUNI2=IST1NU
          IFILE2=ILATFO
          ISTAT2='OLD'
          IFORM2='FORMATTED'
          IACCE2='SEQUENTIAL'
          IPROT2='READONLY'
          ICURS2='CLOSED'
          ISUBN0='CAPT'
          IERRF2='NO'
C
          IREWI2='ON'
          CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
C
C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
C
          DO4221I=1,1000
            IATEMP=' '
            READ(IOUNI2,4222,END=4229,ERR=4229)IATEMP
 4222       FORMAT(A240)
            ILAST=1
            DO4226J=240,1,-1
              IF(IATEMP(J:J).NE.' ')THEN
                ILAST=J
                GOTO4228
              ENDIF
 4226       CONTINUE
 4228       CONTINUE
            WRITE(ICOUT,4224)(IATEMP(J:J),J=1,ILAST)
            NCOUT=ILAST
 4224       FORMAT(240A1)
            CALL DPWRST('XXX','WRIT')
 4221     CONTINUE
 4229     CONTINUE
          IENDF2='OFF'
          IREWI2='ON'
          CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IENDF2,IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
        ENDIF
      ELSEIF(ICAPTY.EQ.'RTF ')THEN
        IRTFMD='OFF'
        WRITE(ICOUT,4301)IBASLC
 4301   FORMAT(A1,'par}')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4303)
 4303   FORMAT('}')
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      ICAPTY='TEXT'
      IOUNIT=ICAPNU
      IPR=IPRDEF
C
      IENDFI='ON'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
 4090 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO4019
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4011)
 4011 FORMAT('THE CAPTURE SWITCH HAS JUST BEEN TURNED OFF.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4012)ICAPNA
 4012 FORMAT('NAME OF (JUST-CLOSED) CAPTURE FILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4013)
 4013 FORMAT('ALL FUTURE TEXT OUTPUT WILL NOW REVERT TO ',
     1'THE SCREEN.')
      CALL DPWRST('XXX','BUG ')
 4019 CONTINUE
      GOTO9000
C
C               ****************************************************************
C               **  STEP 50--
C               **  TREAT THE CAPTURE FILE CLOSE CASE.
C               ****************************************************************
C
 5000 CONTINUE
      ISTEPN='50'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC ICAPSW='OFF'
CCCCC JUNE 2002. SUPPORT FOR SPECIAL CAPTURE OPERATIONS.
CCCCC IF(ICAPTY.EQ.'GRAP')THEN
CCCCC   IPR=IPRDEF
      IF(ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
 5113   FORMAT('</BODY>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
 5115   FORMAT('</HTML>')
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPTY.EQ.'LATE')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5208)IBASLC
 5208   FORMAT(A1,'end{verbatim}')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5210)IBASLC
 5210   FORMAT(A1,'end{document}')
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPTY.EQ.'RTF ')THEN
        IRTFMD='OFF'
        WRITE(ICOUT,5301)IBASLC
 5301   FORMAT(A1,'par}')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5303)
 5303   FORMAT('}')
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      ICAPTY='TEXT'
      IOUNIT=ICAPNU
C
      IENDFI='OFF'
C     ***** DO WE NEED THE FOLLOWING REWIND ????? *****
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'CAPT')GOTO5019
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5011)ICAPNU
 5011 FORMAT('THE CAPTURE FILE NUMBER ',I8,' HAS JUST BEEN CLOSED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5012)ICAPNA
 5012 FORMAT('NAME OF (JUST-CLOSED) CAPTURE FILE = ',A80)
      CALL DPWRST('XXX','BUG ')
 5019 CONTINUE
      GOTO9000
C
C     **********************************************************
C     **  STEP 60--                                           **
C     **  TREAT THE FLUSH  CAPTURE CASE.                      **
C     **      1) CLEAR GRAPHICS SCREEN (DPERAS)               **
C     **      2) CLOSE CAPTURE FILE (IF CURRENTLY OPEN)       **
C     **      3) OPEN THE CAPTURE FILE                        **
C     **      4) LOOP THROUGH THE FILE AND CALL DPWRSG        **
C     **      5) CLOSE THE CAPTURE FILE                       **
C     **      6) RE-OPEN THE CAPTURE FILE                     **
C     **********************************************************
C
 6000 CONTINUE
      ISTEPN='40'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CAPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
C  STEP 2: CLEAR THE GRAPHICS SCREEN
C          (SKIP IF MULTIPLOTTING ON)
C
      IF(IMPSW.NE.'ON')THEN
          CALL DPERAS(IHARG,IARGT,IARG,NUMARG,
     1                IBACCO,
     1                IGRASW,IDIASW,
     1                PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1                PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1                NUMDEV,
     1                IDMANU,IDMODE,IDMOD2,IDMOD3,
     1                IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1                IDNVOF,IDNHOF,
     1                IDFONT,
     1                ICAPSW,
     1                IBUGS2,ISUBRO,IFOUND,IERROR)
      ENDIF
C
C  STEP 2: CLOSE THE FILE
C
      IOUNIT=ICAPNU
      IFILE=ICAPNA
      ISTAT=ICAPST
      IFORM=ICAPFO
      IACCES=ICAPAC
      IPROT=ICAPPR
      ICURST=ICAPCS
      ICURST=ICAPCS
      IF(ICAPCS.EQ.'CLOSED')GOTO6090
      IENDFI='ON'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
 6090 CONTINUE
C
C  STEP 3: RE-OPEN THE FILE
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
      ICAPCS=ICURST
C
C  STEP 4: LOOP THROUGH THE FILE
C
      ILINE=0
      ICOUNT=1
      DO6110I=1,10000
        ICOUT=' '
        READ(ICAPNU,'(A120)',END=6129,ERR=6119)ICOUT
        ILINE=ILINE+1
        IF(ILINE.GT.ICAPLI(ICOUNT).AND.IMPSW.NE.'ON')THEN
          CALL DPERAS(IHARG,IARGT,IARG,NUMARG,
     1                IBACCO,
     1                IGRASW,IDIASW,
     1                PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1                PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1                NUMDEV,
     1                IDMANU,IDMODE,IDMOD2,IDMOD3,
     1                IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1                IDNVOF,IDNHOF,
     1                IDFONT,
     1                ICAPSW,
     1                IBUGS2,ISUBRO,IFOUND,IERROR)
          ILINE=1
          ICOUNT=ICOUNT+1
          IF(ICOUNT.GT.MAXCLI)ICOUNT=1
        ENDIF
        IF(I.EQ.1)THEN
          IFLAG='INIT'
        ELSEIF(ILINE.EQ.1)THEN
          IFLAG='NEW'
        ELSE
          IFLAG='OLD'
        ENDIF
        CALL DPWRSG('XXXX','BUG ',IREPCH,IMPSW,IFLAG,ICAPNM,ICAPBX,
     1              ILINE)
 6110 CONTINUE
 6119 CONTINUE
 6129 CONTINUE
C
C  STEP 5: CLOSE THE FILE
C
      IENDFI='ON'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      ICAPCS=ICURST
      IF(IERRFI.EQ.'YES')GOTO9000
C
C  STEP 6: RE-OPEN THE FILE
C
      IFILE=ICAPNA
      IOUNIT=ICAPNU
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
      ICAPCS=ICURST
C
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
C
      IFILQU=IFILQ2
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'CAPT')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCAPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICAPSW,ICAPNU,ICAPCS,IPR,IPRDEF
 9012 FORMAT('ICAPSW,ICAPNU,ICAPCS,IPR,IPRDEF = ',A4,I8,2X,A12,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,IFOUND,IERROR
 9013 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IOUNIT
 9014 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICOM,ICOM2,IWIDTH
 9015 FORMAT('ICOM,ICOM2,IWIDTH = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)(IANSLC(I),I=1,IWIDTH)
 9017 FORMAT('IANSLC(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)NUMARG
 9018 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9022
      DO9019I=1,NUMARG
      WRITE(ICOUT,9020)I,IHARG(I),IHARG2(I)
 9020 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9019 CONTINUE
 9022 CONTINUE
      WRITE(ICOUT,9025)IOFILE
 9025 FORMAT('IOFILE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)JP3,JP4,JP5,KMIN,KDEL,KMAX
 9031 FORMAT('JP2,JP3,JP4,KMIN,KDEL,KMAX = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)NUMNAM,MAXNAM
 9032 FORMAT('NUMNAM,MAXNAM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,NUMNAM
      WRITE(ICOUT,9036)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
 9036 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
      WRITE(ICOUT,9042)NUMCHA
 9042 FORMAT('NUMCHA = ',I8)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9043)(IA(I),I=1,MIN(100,IMAX))
C9043 FORMAT('(IA(I),I=1,IMAX) = ',100A1)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)IOUNIT
 9051 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IFILE
 9052 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)ISTAT
 9053 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9054)IFORM
 9054 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9055)IACCES
 9055 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9056)IPROT
 9056 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9057)ICURST
 9057 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9058)IENDFI
 9058 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9059)IREWIN
 9059 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)ISUBN0
 9061 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)IERRFI
 9062 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCASE(ICOM,IHARG,NUMARG,
     1IDEFCA,
     1ITEXCA,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE CASE (UPPER OR LOWER) TYPE FOR
C              TITLE, LABEL, AND LEGEND SCRIPT
C              ON A PLOT.
C              THE CASE (UPPER OR LOWER) FOR THE SCRIPT WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXCA.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFCA
C                     --IBUGD2
C     OUTPUT ARGUMENTS--ITEXCA
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --OCTOBER   1993.  ACCEPT "ASIS" AS ARGUMENT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCA
      CHARACTER*4 ITEXCA
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCASE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICOM,NUMARG,IDEFCA
   53 FORMAT('ICOM,NUMARG,IDEFCA = ',A4,2X,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ************************************************
C               **  TREAT THE CASE (UPPER VERSUS LOWER) CASE  **
C               ************************************************
C
 1110 CONTINUE
      IF(ICOM.EQ.'CASE')GOTO1120
      IF(ICOM.EQ.'UPPE')GOTO1130
      IF(ICOM.EQ.'LOWE')GOTO1140
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
      IF(ICOM.EQ.'ASIS')GOTO1150
      GOTO9000
C
 1120 CONTINUE
      IF(NUMARG.LE.0)GOTO1161
      IF(IHARG(NUMARG).EQ.'ON')GOTO1161
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1162
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      IF(IHARG(NUMARG).EQ.'UPPE')GOTO1161
      IF(IHARG(NUMARG).EQ.'LOWE')GOTO1162
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
      IF(IHARG(NUMARG).EQ.'ASIS')GOTO1163
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      GOTO1170
C
 1130 CONTINUE
      IF(NUMARG.LE.0)GOTO9000
      IF(IHARG(1).NE.'CASE')GOTO9000
      IF(NUMARG.LE.1)GOTO1161
      IF(IHARG(NUMARG).EQ.'ON')GOTO1161
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1162
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      GOTO9000
C
 1140 CONTINUE
      IF(NUMARG.LE.0)GOTO9000
      IF(IHARG(1).NE.'CASE')GOTO9000
      IF(NUMARG.LE.1)GOTO1162
      IF(IHARG(NUMARG).EQ.'ON')GOTO1162
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1161
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1162
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      GOTO9000
CCCCC OCTOBER 1993.  ADD FOLLOWING SECTION
C
 1150 CONTINUE
      IF(NUMARG.LE.0)GOTO9000
      IF(IHARG(1).NE.'CASE')GOTO9000
      IF(NUMARG.LE.1)GOTO1163
      IF(IHARG(NUMARG).EQ.'ON')GOTO1162
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1161
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1162
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      GOTO9000
C
 1161 CONTINUE
      ITEXCA='UPPE'
      GOTO1180
C
 1162 CONTINUE
      ITEXCA='LOWE'
      GOTO1180
CCCCC OCTOBER 1993.  ADD FOLLOWING SECTION
C
 1163 CONTINUE
      ITEXCA='ASIS'
      GOTO1180
C
 1165 CONTINUE
      ITEXCA=IDEFCA
      GOTO1180
C
 1170 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1171)
 1171 FORMAT('***** ERROR IN DPCASE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('      ILLEGAL ENTRY FOR CASE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)
 1173 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)
 1174 FORMAT('      SUPPOSE THE THE ANALYST WISHES TO HAVE CASE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1175)
 1175 FORMAT('      FOR ALL PLOT TITLES, LABELS, AND LEGENDS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1176)
 1176 FORMAT('      THEN ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1177)
 1177 FORMAT('           CASE UPPER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1178)
 1178 FORMAT('           UPPER CASE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1179)
 1179 FORMAT('           CASE')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE CASE (FOR PLOT SCRIPT AND TEXT) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ITEXCA
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)ITEXCA
 8111 FORMAT('THE CURRENT CASE IS ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IDEFCA
 8112 FORMAT('THE DEFAULT CASE IS ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCASE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
 9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ITEXCA,IDEFCA
 9013 FORMAT('ITEXCA,IDEFCA = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICONT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 4 CONTROL CHARTS--
C              1) MEAN
C              2) RANGE
C              3) STANDARD DEVIATION
C              4) CUSUM
C              5) P
C              6) PN
C              7) C
C              8) U
C              9) EWMA (EXPONENTIALLY WEIGHTED MOVING AVERAGE)
C             10) MOVING AVERAGE 
C             11) MOVING RANGE 
C             12) MOVING STANDARD DEVIATION 
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1988. (P, PN, C, AND U CHARTS)
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --JULY      1990. ADD    R CHART    CHECK
C     UPDATED         --JULY      1990. FIX P, NP, C, & U CHARTS
C     UPDATED         --SEPTEMBER 1990. LSL, USL, TARGET
C     UPDATED         --AUGUST    1991. TURN OFF MESS.--LSL/USL/TARGET
C     UPDATED         --MARCH     1997. EWMA, ACTIVATE CUSUM
C     UPDATED         --MARCH     1997. MOVING AVERAGE
C     UPDATED         --MARCH     1997. MOVING RANGE
C     UPDATED         --MARCH     1997. MOVING STANDARD DEVIATION
C     UPDATED         --SEPTEMBER 1998. ACTIVATED CUSUM MEAN CHART
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
CCCCC ADD FOLLING LINE 3/97
      CHARACTER*4 ICASP2
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 1990
      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)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      DIMENSION Y2(MAXOBV)
      DIMENSION X1(MAXOBV)
C
      DIMENSION XIDTEM(MAXOBV)
      DIMENSION TEMP(MAXOBV)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      DIMENSION TEMP2(MAXOBV)
CCCCC FOLLOWING 5 LINES ADDED JUNE, 1990 (ALAN)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
CCCCC THE FOLLOWING 2 LINES WERE REPLACED BY THE SUCCEEDING 4 LINES   JULY 190
CCCCC EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1))
CCCCC EQUIVALENCE (GARBAG(IGARB4),TEMP(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
CCCCC ADD FOLLOWING LINE APRIL 1997
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPCC'
      ISUBN2='    '
C
CCCCC ADD FOLLOWING LINE 3/97 (FOR CUSUM CHARTS)
      ICASP2='NONE'
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 CONTROL CHART CASE  **
C               ************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICONT,IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('ICONT,IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *************************************
C               **  STEP 1.1--                     **
C               **  SEARCH FOR 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
CCCCC ADD FOLLOWING SECTION FEBRUARY 1994.
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'X'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'X'.AND.IHARG(1).EQ.'CHAR')GOTO111
C
C               ***************************************************
C               **  STEP 1.2--                                   **
C               **  SEARCH FOR STANDARD DEVIATION 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 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
CCCCC THE FOLLOWING 3 LINES WERE ADDED JULY 1990
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'R'.AND.IHARG(1).EQ.'CHAR')
     1GOTO111
C
C               **************************************
C               **  STEP 1.4--                      **
C               **  SEARCH FOR CUSUM CONTROL CHART  **
C               **************************************
C
      ICASPL='CUCC'
      ICASP2='MEAN'
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
CCCCC FOLLOWING SECTIONS ADDED 3/97
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'MEAN'.AND.IHARG(1).EQ.'CUMU'.AND.
     1IHARG(2).EQ.'SUM'.AND.IHARG(3).EQ.'CONT'.AND.
     1IHARG(4).EQ.'CHAR')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'MEAN'.AND.IHARG(1).EQ.'CUSU'.AND.
     1IHARG(2).EQ.'CONT'.AND.IHARG(3).EQ.'CHAR')
     1GOTO113
C
      ICASP2='MEAN'
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'RANG'.AND.IHARG(1).EQ.'CUMU'.AND.
     1IHARG(2).EQ.'SUM'.AND.IHARG(3).EQ.'CONT'.AND.
     1IHARG(4).EQ.'CHAR')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'RANGE'.AND.IHARG(1).EQ.'CUSU'.AND.
     1IHARG(2).EQ.'CONT'.AND.IHARG(3).EQ.'CHAR')
     1GOTO113
C
      ICASP2='MEAN'
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'CUMU'.AND.
     1IHARG(2).EQ.'SUM'.AND.IHARG(3).EQ.'CONT'.AND.
     1IHARG(4).EQ.'CHAR')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'CUSU'.AND.
     1IHARG(2).EQ.'CONT'.AND.IHARG(3).EQ.'CHAR')
     1GOTO113
C
      IF(NUMARG.GE.5.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'CUMU'.AND.IHARG(2).EQ.'SUM'.AND.
     1IHARG(3).EQ.'CONT'.AND.IHARG(4).EQ.'CHAR')GOTO115
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'CUSU'.AND.IHARG(3).EQ.'CONT'.AND.
     1IHARG(4).EQ.'CHAR')GOTO114
      ICASP2='NONE'
C
C               **************************************
C               **  STEP 1.5--                      **
C               **  SEARCH FOR 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 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 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 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
C               **************************************
C               **  STEP 1.9--                      **
C               **  SEARCH FOR EWMA CONTROL CHART   **
C               **************************************
C
      ICASPL='EWCC'
C
      IF(NUMARG.GE.5.AND.
     1ICOM.EQ.'EXPO'.AND.IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'MOVI'.AND.
     1IHARG(3).EQ.'AVER'.AND.IHARG(4).EQ.'CONT'.AND.
     1IHARG(5).EQ.'CHAR')GOTO115
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'EXPO'.AND.IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'MOVI'.AND.
     1IHARG(3).EQ.'CONT'.AND.IHARG(4).EQ.'CHAR')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'EXPO'.AND.IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'CONT'.AND.
     1IHARG(3).EQ.'CHAR')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'EWMA'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
C
C               ************************************************
C               **  STEP 1.10--                               **
C               **  SEARCH FOR MOVING AVERAGE CONTROL CHART   **
C               ************************************************
C
      ICASPL='MACC'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'AVER'.AND.IHARG(2).EQ.'CONT'.AND.
     1IHARG(3).EQ.'CHAR')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'MEAN'.AND.IHARG(2).EQ.'CONT'.AND.
     1IHARG(3).EQ.'CHAR')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MA'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
C
C               ************************************************
C               **  STEP 1.11--                               **
C               **  SEARCH FOR MOVING RANGE   CONTROL CHART   **
C               ************************************************
C
      ICASPL='MRCC'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'RANG'.AND.IHARG(2).EQ.'CONT'.AND.
     1IHARG(3).EQ.'CHAR')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MR'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
C
C               ************************************************
C               **  STEP 1.12--                               **
C               **  SEARCH FOR MOVING STANDARD DEVIATION      **
C               **  CONTROL CHART                             **
C               ************************************************
C
      ICASPL='MSCC'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'CONT'.AND.
     1IHARG(3).EQ.'CHAR')GOTO113
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'CONT'.AND.IHARG(4).EQ.'CHAR')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MSD'.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO112
C
      ICASPL='    '
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  114 CONTINUE
      ILASTC=4
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  115 CONTINUE
      ILASTC=5
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               ***********************************************************
C               **  STEP 1--                                             **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,ICOLL,NLEFT
  211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.                **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPCC--')
      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 MEAN CONTROL CHART ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'SDCC')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A STANDARD DEVIATION CONTROL CHART ')
      IF(ICASPL.EQ.'SDCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'RACC')WRITE(ICOUT,323)
  323 FORMAT('      (FOR WHICH A RANGE CONTROL CHART ')
      IF(ICASPL.EQ.'RACC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUCC')WRITE(ICOUT,324)
  324 FORMAT('      (FOR WHICH A CUSUM CONTROL CHART ')
      IF(ICASPL.EQ.'CUCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PCC')WRITE(ICOUT,325)
  325 FORMAT('      (FOR WHICH A P CONTROL CHART ')
      IF(ICASPL.EQ.'PCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PNCC')WRITE(ICOUT,326)
  326 FORMAT('      (FOR WHICH A NP CONTROL CHART ')
      IF(ICASPL.EQ.'PNCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CCC')WRITE(ICOUT,327)
  327 FORMAT('      (FOR WHICH A C CONTROL CHART ')
      IF(ICASPL.EQ.'CCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'UCC')WRITE(ICOUT,328)
  328 FORMAT('      (FOR WHICH A U CONTROL CHART ')
      IF(ICASPL.EQ.'UCC')CALL DPWRST('XXX','BUG ')
CCCCC ADD FOLLOWING 12 LINES 3/97
      IF(ICASPL.EQ.'EWCC')WRITE(ICOUT,329)
  329 FORMAT('      (FOR WHICH A EWMA CONTROL CHART ')
      IF(ICASPL.EQ.'EWCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MACC')WRITE(ICOUT,330)
  330 FORMAT('      (FOR WHICH A MOVING AVERAGE CONTROL CHART ')
      IF(ICASPL.EQ.'MACC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MRCC')WRITE(ICOUT,331)
  331 FORMAT('      (FOR WHICH A MOVING RANGE CONTROL CHART ')
      IF(ICASPL.EQ.'MRCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MSCC')WRITE(ICOUT,332)
  332 FORMAT('      (FOR WHICH A MOVING STANDARD DEVIATION ',
     1'CONTROL CHART ')
      IF(ICASPL.EQ.'MSCC')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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPCC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ************************************************************
C               **  STEP 5--                                              **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS                **
C               **  INDICATES THAT THE VALUES IN THE                      **
C               **  FIRST VARIABLE ARE TO BE GROUPED                      **
C               **  BASED ON VALUES OF THE SECOND VARIABLE;               **
C               **  THAT IS, THE SECOND VARAIBLE DEFINES THE              **
C               **  GROUP NUMBERS WITHIN WHICH THE MEANS,                 **
C               **  STANDARD DEVIATIONS, RANGES, AND                      **
C               **  CUMULATIVE SUMS ARE TO BE COMPUTED.                   **
C               **  THE VALUES IN THE SECOND VARIABLE                     **
C               **  ARE THE X VALUES FOR EACH MEAN, STANDARD DEVIATION,   **
C               **  ETC.  IN THE RESULTING 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')CALL 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 DPCC--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,512)
  512 FORMAT('      FOR A MEAN CONTROL CHART, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'SDCC')WRITE(ICOUT,513)
  513 FORMAT('      FOR A STANDARD DEVIATION CONTROL CHART, ')
      IF(ICASPL.EQ.'SDCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'RACC')WRITE(ICOUT,514)
  514 FORMAT('      FOR A RANGE CONTROL CHART, ')
      IF(ICASPL.EQ.'RACC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUCC')WRITE(ICOUT,515)
  515 FORMAT('      FOR A CUSUM CONTROL CHART, ')
      IF(ICASPL.EQ.'CUCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PCC')WRITE(ICOUT,516)
  516 FORMAT('      (FOR WHICH A P CONTROL CHART ')
      IF(ICASPL.EQ.'PCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'PNCC')WRITE(ICOUT,517)
  517 FORMAT('      (FOR WHICH A NP CONTROL CHART ')
      IF(ICASPL.EQ.'PNCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CCC')WRITE(ICOUT,518)
  518 FORMAT('      (FOR WHICH A C CONTROL CHART ')
      IF(ICASPL.EQ.'CCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'UCC')WRITE(ICOUT,519)
  519 FORMAT('      (FOR WHICH A U CONTROL CHART ')
      IF(ICASPL.EQ.'UCC')CALL DPWRST('XXX','BUG ')
CCCCC FOLLOWING 12 LINES ADDED 3/97
      IF(ICASPL.EQ.'EWCC')WRITE(ICOUT,520)
  520 FORMAT('      (FOR WHICH A EWMA CONTROL CHART ')
      IF(ICASPL.EQ.'EWCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MACC')WRITE(ICOUT,521)
  521 FORMAT('      (FOR WHICH A MOVING AVERAGE CONTROL CHART ')
      IF(ICASPL.EQ.'MACC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MRCC')WRITE(ICOUT,522)
  522 FORMAT('      (FOR WHICH A MOVING RANGE CONTROL CHART ')
      IF(ICASPL.EQ.'MRCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MSCC')WRITE(ICOUT,535)
  535 FORMAT('      (FOR WHICH A MOVING STANDARD DEVIATION ',
     1'CONTROL CHART ')
      IF(ICASPL.EQ.'MSCC')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')WRITE(ICOUT,531)IHHOR,ICOLH,NHOR
  531 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      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')WRITE(ICOUT,541)IHEXT,ICOLE,NEXT
  541 FORMAT('IHEXT,ICOLE,NEXT   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      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')WRITE(ICOUT,542)IHHOR,ICOLH,NHOR
  542 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(NHOR.NE.NLEFT)GOTO570
      GOTO599
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPCC--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,572)
  572 FORMAT('      FOR A MEAN CONTROL CHART, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'SDCC')WRITE(ICOUT,573)
  573 FORMAT('      FOR A STANDARD DEVIATION CONTROL CHART,')
      IF(ICASPL.EQ.'SDCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'RACC')WRITE(ICOUT,574)
  574 FORMAT('      FOR A RANGE CONTROL CHART, ')
      IF(ICASPL.EQ.'RACC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUCC')WRITE(ICOUT,575)
  575 FORMAT('      FOR A 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 C CONTROL CHART ')
      IF(ICASPL.EQ.'CCC')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'UCC')WRITE(ICOUT,579)
  579 FORMAT('      (FOR WHICH A 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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
      IF(NUMV2.LE.1)GOTO660
C
      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 7--                                                  **
C               **  FOR THE 1-VARIABLE CASE ONLY,                             *
C               **  DETERMINE IF THE ANALYST                                  **
C               **  HAS SPECIFIED    THE GROUP SIZE,                          **
C               **  FOR THE CONTROL CHART ANALYSIS.                           **
C               **  THE GROUP SIZE SETTING IS DEFINED BY SEARCHING THE        **
C               **  INTERNAL TABLE FOR THE PARAMETER NAME      NI   ;         **
C               **  IF FOUND, USE THE SPECIFIED VALUE.                        **
C               **  IF NOT FOUND, GENERATE AN ERROR MESSAGE.                  **
C               ****************************************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.GE.2)GOTO790
C
      IH='NI  '
      IH2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IF(IERRO2.EQ.'YES')THEN
        ISIZE=1
      ELSE
        ISIZE=VALUE(ILOCP)+0.5
      ENDIF
  790 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED SEPTEBMER 1990
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               **      P (FOR EWMA CHARTS)
C               **      K (FOR UNGROUPED DATA, FILTER WIDTH)
C               **      WIDTH AS ALTERNATIVE TO K           
C               **      WEIGHT AS ALTERNATIVE TO P          
C               **  FOR THE CONTROL CHART ANALYSIS.                           **
C               ****************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CCLSL=CPUMIN
      IH='LSL '
      IH2='    '
      IHWUSE='P'
CCCCC THE FOLLOWING LINE WAS CHANGED AUGUST 1991
CCCCC MESSAG='YES'
      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'
CCCCC THE FOLLOWING LINE WAS CHANGED AUGUST 1991
CCCCC MESSAG='YES'
      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'
CCCCC THE FOLLOWING LINE WAS CHANGED AUGUST 1991
CCCCC MESSAG='YES'
      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
      P=CPUMIN
      IH='P   '
      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')THEN
        P=VALUE(ILOCP)
      ELSE
        IH='WEIG'
        IH2='HT  '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IH,IH2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
        IF(IERRO2.EQ.'NO')P=VALUE(ILOCP)
      ENDIF
C
      KWIDTH=3
      IH='K   '
      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')THEN
        KWIDTH=INT(VALUE(ILOCP)+0.5)
      ELSE
        IH='WIDT'
        IH2='H   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IH,IH2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
        IF(IERRO2.EQ.'NO')KWIDTH=INT(VALUE(ILOCP)+0.5)
      ENDIF
C
      USRSIG=CPUMIN
      IH='SIGM'
      IH2='AE  '
      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')USRSIG=VALUE(ILOCP)
C
      AK=0.5
      IH='K   '
      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')AK=VALUE(ILOCP)
C
      H=5.0
      IH='H   '
      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')H=VALUE(ILOCP)
C
      H=5.0
      IH='H   '
      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')H=VALUE(ILOCP)
C
      SHI=CPUMIN
      IH='SHI '
      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')SHI=VALUE(ILOCP)
C
      SLI=CPUMIN
      IH='SLI '
      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')SLI=VALUE(ILOCP)
C
C               *******************************************************
C               **  STEP 9--                                         **
C               **  COMPUTE THE APPROPRIATE 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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  809 CONTINUE
CCCCC THE FOLLOWING 2 LINES WERE UPDATED JULY 1990
CCCCC CALL DPCC2(Y1,X1,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,
CCCCC1XIDTEM,TEMP,
      CALL DPCC2(Y1,Y2,X1,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,
CCCCC THE FOLLOWING LINE WAS FIXED SEPTEBMER 1990
CCCCC THE FOLLOWING LINE WAS FIXED MARCH 1997
CCCCC1XIDTEM,TEMP,TEMP2,
CCCCC1XIDTEM,TEMP,TEMP2,CCLSL,CCUSL,CCTARG,
     1XIDTEM,TEMP,TEMP2,CCLSL,CCUSL,CCTARG,P,KWIDTH,
CCCCC ADD FOLLOWING LINE APRIL 1997
     1ICCHPR,ICCHWT,USRSIG,
CCCCC ADD FOLLOWING LINE SEPTEMBER 1998
     1AK,H,SHI,SLI,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCC--')
      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 DPCC2(Y,YN,X,N,NUMV2,ICASPL,ISIZE,ICONT,
CCCCC THE FOLLOWING LINE WAS FIXED SEPTEMBER 1990
CCCCC1XIDTEM,TEMP,TEMP2,
CCCCC THE FOLLOWING LINE WAS FIXED MARCH 1997
CCCCC1XIDTEM,TEMP,TEMP2,CCLSL,CCUSL,CCTARG,
     1XIDTEM,TEMP,TEMP2,CCLSL,CCUSL,CCTARG,P,KWIDTH,
CCCCC ADD FOLLOWING LINE APRIL 1997
     1ICCHPR,ICCHWT,USRSIG,
CCCCC ADD FOLLOWING LINE SEPTEMBER 1998
     1AK,H,SHI,SLI,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
CCCCC THE YN AND TEMP2 ARGUMENTS WERE ADDED ABOVE  JULY 1990
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A CONTROL CHART
C              OF THE FOLLOWING TYPES--
C                 1) MEAN CONTROL CHART    Y X
C                 2) STANDARD DEVIATION CONTROL CHART    Y X
C                 3) RANGE CONTROL CHART    Y X
C                 4) CUSUM CONTROL CHART    Y X
C                 5) P CONTROL CHART    NUMDEF NUMTOT X
C                 6) PN CONTROL CHART    NUMDEF NUMTOT X
C                 7) U CONTROL CHART    NUMDEF SIZE X
C                 8) P CONTROL CHART    NUMDEF SIZE X
C                 9) EWMA CONTROL CHART Y X
C                10) MOVING AVERAGE CONTROL CHART Y X
C                11) MOVING RANGE CONTROL CHART Y X
C                12) MOVING STANDARD DEVIATION CONTROL CHART Y 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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     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--82/7
C     ORIGINAL VERSION--JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY  1988. P, PN, U, AND C CHARTS
C     UPDATED         --JULY     1990. FIX P, PN, U, & C CHARTS
C     UPDATED         --SEPTEMBER 1990. LSL, USL, TARGET
C     UPDATED         --MARCH     1997. EWMA CHART, ACTIVATE CUSUM
C     UPDATED         --MARCH     1997. MOVING AVERAGE CHART
C     UPDATED         --MARCH     1997. MOVING RANGE CHART
C     UPDATED         --MARCH     1997. MOVING STANDARD DEVIATION CHART
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
CCCCC ADD FOLLOWING LINE MARCH 1997.
CCCCC CHARACTER*4 ICASP2
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICCHPR
      CHARACTER*4 ICCHWT
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      DIMENSION YN(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION XIDTEM(*)
      DIMENSION TEMP(*)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      DIMENSION TEMP2(*)
C
CCCCC DIMENSION A(30)
CCCCC DIMENSION A0(30)
CCCCC DIMENSION A1(30)
CCCCC DIMENSION A2(30)
      DIMENSION A3(30)
CCCCC DIMENSION C2(30)
      DIMENSION C4(30)
CCCCC DIMENSION B1(30)
CCCCC DIMENSION B2(30)
      DIMENSION B3(30)
      DIMENSION B4(30)
      DIMENSION E2(30)
CCCCC DIMENSION D1(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
CCCCC DATA(A(I),I=    1,   25)
CCCCC1/9.999,2.121,1.732,1.500,1.342,1.225,1.134,1.061,1.000,0.945,
CCCCC1 0.905,0.866,0.832,0.802,0.775,0.750,0.723,0.707,0.688,0.671,
CCCCC1 0.655,0.640,0.626,0.612,0.600/
CCCCC DATA(A0(I),I=    1,   25)
CCCCC1/9.999,3.760,3.070,2.914,2.884,2.899,2.935,2.980,3.030,3.085,
CCCCC1 3.136,3.189,3.242,3.295,3.347,3.398,3.448,3.497,3.545,3.592,
CCCCC1 3.639,3.684,3.729,3.773,3.816/
CCCCC DATA(A1(I),I=    1,   25)
CCCCC1/9.999,3.760,2.394,1.880,1.596,1.410,1.277,1.175,1.094,1.028,
CCCCC1 0.973,0.925,0.884,0.848,0.816,0.788,0.762,0.738,0.717,0.697,
CCCCC1 0.679,0.662,0.647,0.632,0.619/
CCCCC DATA(A2(I),I=    1,   25)
CCCCC1/9.999,1.880,1.023,0.729,0.577,0.483,0.419,0.373,0.337,0.308,
CCCCC1 0.285,0.266,0.249,0.235,0.223,0.212,0.203,0.194,0.187,0.180,
CCCCC1 0.173,0.167,0.162,0.157,0.153/
      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/
CCCCC DATA(C2(I),I=    1,   25)
CCCCC1/9.9999,0.5642,0.7236,0.7979,0.8407,
CCCCC1 0.8686,0.8882,0.9027,0.9139,0.9227,
CCCCC1 0.9300,0.9359,0.9410,0.9453,0.9490,
CCCCC1 0.9523,0.9551,0.9576,0.9599,0.9619,
CCCCC1 0.9638,0.9655,0.9670,0.9684,0.9696/
      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/
CCCCC DATA(B1(I),I=    1,   25)
CCCCC1/0.000,0.000,0.000,0.000,0.000,0.026,0.105,0.167,0.219,0.262,
CCCCC1 0.299,0.331,0.359,0.384,0.406,0.427,0.445,0.461,0.477,0.491,
CCCCC1 0.504,0.516,0.527,0.538,0.548/
CCCCC DATA(B2(I),I=    1,   25)
CCCCC1/9.999,1.843,1.858,1.808,1.756,1.711,1.672,1.638,1.609,1.584,
CCCCC1 1.561,1.541,1.523,1.507,1.492,1.478,1.465,1.454,1.443,1.433,
CCCCC1 1.424,1.415,1.407,1.399,1.392/
      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(E2(I),I=    1,   25)
     1/9.999,1.128,1.693,2.059,2.326,2.534,2.704,2.847,2.970,3.078,
     1 3.173,3.258,3.336,3.407,3.472,3.532,3.588,3.640,3.689,3.735,
     1 3.778,3.819,3.858,3.895,3.931/
CCCCC DATA(D1(I),I=    1,   25)
CCCCC1/0.000,0.000,0.000,0.000,0.000,0.000,0.205,0.387,0.546,0.687,
CCCCC1 0.812,0.924,1.026,1.121,1.207,1.285,1.359,1.426,1.490,1.548,
CCCCC1 1.606,1.659,1.710,1.759,1.804/
      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='DPCC'
      ISUBN2='2   '
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 DPCC2--')
      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 DPCC2--')
      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 DPCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPCC2--')
      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 CONTROL CHART.  **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.EQ.1)GOTO110
CCCCC THE FOLLOWING LINE WAS CHANGED JULY 1990
CCCCC IF(NUMV2.EQ.2)GOTO150
      IF(NUMV2.GE.2)GOTO150
C
CCCCC SEPTEMBER 1998.  RECODE THIS SECTION.
  110 CONTINUE
      NUMSET=0
      IF(ISIZE.EQ.1)THEN
        DO120I=1,N
          XIDTEM(I)=REAL(I)
          X(I)=XIDTEM(I)
  120   CONTINUE
      ELSE
        NUMSET=0
        ILOOP=N/ISIZE
        DO145I=1,ILOOP
          NUMSET=NUMSET+1
          XIDTEM(NUMSET)=REAL(NUMSET)
          ISTART=(I-1)*ISIZE+1
          ISTOP=I*ISIZE
          DO147J=ISTART,ISTOP
            X(J)=XIDTEM(NUMSET)
  147     CONTINUE
  145   CONTINUE
        ILEFT=MOD(N,ISIZE)
        IF(ILEFT.NE.0)THEN
          ISTART=ILOOP*ISIZE+1
          NUMSET=NUMSET+1
          XIDTEM(NUMSET)=REAL(NUMSET)
          DO148J=ISTART,N
            X(J)=XIDTEM(NUMSET)
  148     CONTINUE
        ENDIF
      ENDIF
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 DPCC2 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
CCCCC THE FOLLOWING 4 LINES WERE ADDED JULY 1990
      IF(ICASPL.EQ.'PCC')GOTO199
      IF(ICASPL.EQ.'PNCC')GOTO199
      IF(ICASPL.EQ.'UCC')GOTO199
      IF(ICASPL.EQ.'CCC')GOTO199
CCCCC THE FOLLOWING LINES ADDED MARCH 1997
      IF(ICASPL.EQ.'EWCC')GOTO199
      IF(ICASPL.EQ.'MACC')GOTO199
      IF(ICASPL.EQ.'MRCC')GOTO199
      IF(ICASPL.EQ.'MSCC')GOTO199
      IF(ICASPL.EQ.'CUCC')GOTO199
C
      IF(NUMSET.NE.N)GOTO199
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,195)
  195 FORMAT('***** ERROR IN DPCC2 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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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 DPCC2--')
      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')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
C  FOR UNGROUPED DATA, USE THE MOVING RANGE OR THE MOVING STANDARD
C  DEVIATION TO COMPUTE AN ESTIMATE FOR SIGMAE.  MARCH 1997.
C
      RANGEM=0.0
      SDM=0.0
      IF(N.EQ.NUMSET)THEN
        IF(KWIDTH.LT.2)KWIDTH=2
        IF(KWIDTH.GT.N-1)KWIDTH=N-1
        NBEF=KWIDTH/2
        NAFT=NBEF
        IF(MOD(KWIDTH,2).EQ.0)NAFT=NBEF-1
        IF(1+NBEF.GT.NUMSET-NAFT)THEN
          WRITE(ICOUT,1071)KWIDTH
          CALL DPWRST('XXXX','BUG')
          IERROR='YES'
          GOTO9000
        ENDIF
 1071   FORMAT(
     1'***** ERROR: THERE ARE NOT ENOUGH DATA POINTS TO FORM THE'/,
     1'      MOVING RANGE ESTIMATE OF THE ERROR STANDARD DEVIATION'/,
     1'      FOR UNGROUPED DATA.  YOU PROBABLY NEED TO SET A '/,
     1'      SMALLER VALUE FOR THE FILTER WIDTH.  FOR EXAMPLE, '//,
     1'           LET K = 3'//,
     1'      THE PARAMETER K DEFINES HOW MANY VALUES ARE USED TO '/,
     1'      COMPUTE THE MOVING RANGE (3 IS THE TYPICALY VALUE).'/,
     1'      THE CURRENT VALUE OF K IS ',I5,' .')
        SUM=0.0
        SUM2=0.0
        ICOUNT=0
        DO1073I=1+NBEF,NUMSET-NAFT
          ICOUNT=ICOUNT+1
          SUM1=0.0
          XTMIN=Y(I-NBEF)
          XTMAX=Y(I+NAFT)
          DO1076II=I-NBEF,I+NAFT
            IF(Y(II).LT.XTMIN)XTMIN=Y(II)
            IF(Y(II).GT.XTMAX)XTMAX=Y(II)
            SUM1=SUM1+Y(II)
 1076     CONTINUE
          SUM=SUM+(XTMAX-XTMIN)
          XMEAN=SUM1/REAL(KWIDTH)
          SUM1=0.0
          DO1077II=I-NBEF,I+NAFT
            SUM1=SUM1+(Y(II)-XMEAN)**2
 1077     CONTINUE
          SUM2=SUM2+SQRT(SUM1/REAL(KWIDTH-1))
 1073   CONTINUE
        RANGEM=SUM/REAL(ICOUNT)
        SDM=SUM2/REAL(ICOUNT)
      ENDIF
            
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) MEAN CONTROL CHART;                           **
C               **         2) STANDARD DEVIATION CONTROL CHART;             **
C               **         3) RANGE CONTROL CHART;                          **
C               **         4) CUSUM CONTROL CHART;                          **
C               **         5) P CONTROL CHART;                              **
C               **         6) PN CONTROL CHART;                             **
C               **         7) C CONTROL CHART;                              **
C               **         8) U CONTROL CHART;                              **
C               **         9) EWMA CONTROL CHART;                           **
C               **        10) MOVING AVERAGE CONTROL CHART;                 **
C               **        11) MOVING RANGE   CONTROL CHART;                 **
C               **        12) MOVING SD      CONTROL CHART;                 **
C               **************************************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON')CALL 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
CCCCC ADD FOLLOWING LINES MARCH 1997
      IF(ICASPL.EQ.'EWCC')GOTO1900
      IF(ICASPL.EQ.'MACC')GOTO2000
      IF(ICASPL.EQ.'MRCC')GOTO2100
      IF(ICASPL.EQ.'MSCC')GOTO2200
C
 1050 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1051)
 1051 FORMAT('***** INTERNAL ERROR IN DPCC2')
      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 MEAN CONTROL CHART CASE  **
C               *****************************************
C
 1100 CONTINUE
C
      ISTEPN='5.1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      DO1110ISET=1,NUMSET
C
      K=0
      DO1120I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 1120 CONTINUE
      NI=K
      ANI=NI
C
      IF(NI.GE.1)GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** INTERNAL ERROR IN DPCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)ISET,XIDTEM(ISET),NI
 1133 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      SUM=0.0
      DO1140I=1,NI
      SUM=SUM+TEMP(I)
 1140 CONTINUE
      XBARI=SUM/ANI
C
      YMID=XBARG
C
      C4LARG=1.0
      IF(NI.LE.25)SADJ=C4(NI)*SIGMAE
      IF(NI.GE.26)SADJ=C4LARG*SIGMAE
C
      A3LARG=3.0/SQRT(ANI)
      IF(NI.LE.25)YUPPER=XBARG+A3(NI)*SADJ
      IF(NI.GE.26)YUPPER=XBARG+A3LARG*SADJ
C
      IF(NI.LE.25)YLOWER=XBARG-A3(NI)*SADJ
      IF(NI.GE.26)YLOWER=XBARG-A3LARG*SADJ
C
      IF(IBUGG3.EQ.'OFF')GOTO1169
      WRITE(ICOUT,1161)ISET,NI,ANI
 1161 FORMAT('ISET,NI,ANI = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1162)XBARI
 1162 FORMAT('XBARI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1163)SDI,C4(NI),C4LARG,SIGMAE,SADJ
 1163 FORMAT('SDI,C4(NI),C4LARG,SIGMAE,SADJ = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1164)XBARG,YMID
 1164 FORMAT('XBARG,YMID = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1165)NI,ANI,A3(NI),A3LARG,YUPPER
 1165 FORMAT('NI,ANI,A3(NI),A3LARG,YUPPER = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1166)NI,ANI,A3(NI),A3LARG,YLOWER
 1166 FORMAT('NI,ANI,A3(NI),A3LARG,YLOWER = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
C
      J=J+1
      Y2(J)=XBARI
      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
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      IF(CCTARG.EQ.CPUMIN)GOTO1171
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XIDTEM(ISET)
      D2(J)=5.0
 1171 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO1172
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XIDTEM(ISET)
      D2(J)=6.0
 1172 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO1173
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XIDTEM(ISET)
      D2(J)=7.0
 1173 CONTINUE
C
 1110 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ********************************************************
C               **  STEP 5.2--                                        **
C               **  TREAT THE  STANDARD DEVIATION CONTROL CHART CASE  **
C               ********************************************************
C
 1200 CONTINUE
C
      ISTEPN='5.2'
      IF(IBUGG3.EQ.'ON')CALL 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 DPCC2--')
      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')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
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      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 RANGE CONTROL CHART CASE  **
C               ******************************************
C
 1300 CONTINUE
C
      ISTEPN='5.3'
      IF(IBUGG3.EQ.'ON')CALL 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 DPCC2--')
      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')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
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      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 CUSUM CONTROL CHART PLOT SUBCASE.       **
C               ******************************************************
C
 1400 CONTINUE
C
      ISTEPN='3.4'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC WRITE(ICOUT,1405)
C1405 FORMAT('CUSUM CAPABILITY NOT YET AVAILABLE.')
CCCCC CALL DPWRST('XXX','BUG ')
C
      J=0
C
      SUMH=0.0
      SUML=0.0
      IF(SHI.NE.CPUMIN)SUMH=SHI
      IF(SLI.NE.CPUMIN)SUML=SLI
      ZHIGH=3.5
      IF(CCUSL.NE.CPUMIN)ZHIGH=CCUSL
C
      DO1410ISET=1,NUMSET
C
      K=0
      DO1420I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 1420 CONTINUE
      NI=K
      ANI=NI
C
      IF(NI.GE.1)GOTO1439
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1431)
 1431 FORMAT('***** INTERNAL ERROR IN DPCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1432)
 1432 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1433)ISET,XIDTEM(ISET),NI
 1433 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1439 CONTINUE
C
      IF(NI.EQ.1)THEN
        ZI=(TEMP(1)-XBARG)/RANGEM
      ELSE
        SUM=0.0
        DO1441I=1,NI
          SUM=SUM+TEMP(I)
 1441   CONTINUE
        XBARI=SUM/ANI
        ZI=(XBARI-XBARG)/SIGMAE
      ENDIF
C
      SUMH=MAX(0.0,SUMH+(ZI-AK))
      SUML=MAX(0.0,SUML+(-ZI-AK))
C
      IF(IBUGG3.EQ.'OFF')GOTO1469
      WRITE(ICOUT,1461)ISET,NI,ANI
 1461 FORMAT('ISET,NI,ANI = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1462)XBARI
 1462 FORMAT('XBARI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1463)ZI,SUMH,SUML
 1463 FORMAT('ZI,SUMH,SUML = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
 1469 CONTINUE
C
      YUPPER=H
      YLOWER=-H
C
      J=J+1
      Y2(J)=SUMH
      X2(J)=XIDTEM(ISET)
      D2(J)=1.0
C
      J=J+1
      Y2(J)=-SUML
      X2(J)=XIDTEM(ISET)
      D2(J)=2.0
C
      J=J+1
      Y2(J)=0.0
      X2(J)=XIDTEM(ISET)
      D2(J)=3.0
C
      J=J+1
      Y2(J)=YUPPER
      X2(J)=XIDTEM(ISET)
      D2(J)=4.0
C
      J=J+1
      Y2(J)=YLOWER
      X2(J)=XIDTEM(ISET)
      D2(J)=5.0
C
      IF(ZI.LE.ZHIGH)GOTO1472
      J=J+1
      Y2(J)=SUMH
      X2(J)=XIDTEM(ISET)
      D2(J)=6.0
      J=J+1
      Y2(J)=SUML
      X2(J)=XIDTEM(ISET)
      D2(J)=7.0
 1472 CONTINUE
C
 1410 CONTINUE
C
 1490 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS COMPLETELY REWRITTEN JULY 1990
C               ********************************************************
C               **  STEP 5.5--                                        **
C               **  TREAT THE  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')CALL 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
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      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
CCCCC THE FOLLOWING SECTION WAS COMPLETELY REWRITTEN JULY 1990
C               ********************************************************
C               **  STEP 5.6--                                        **
C               **  TREAT THE 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')CALL 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
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      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
CCCCC THE FOLLOWING SECTION WAS COMPLETELY REWRITTEN JULY 1990
C               ********************************************************
C               **  STEP 5.7--                                        **
C               **  TREAT THE 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')CALL 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
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      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
CCCCC THE FOLLOWING SECTION WAS COMPLETELY REWRITTEN JULY 1990
C               ********************************************************
C               **  STEP 5.8--                                        **
C               **  TREAT THE 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')CALL 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
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      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 5.9--                         **
C               **  TREAT THE EXPONETIALLY WEIGHTED    **
C               **  CONTROL CHART CASE                 **
C               *****************************************
C
 1900 CONTINUE
C
      ISTEPN='5.9'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(P.GE.1.0 .AND. P.LE.100.)P=P/100.
      IF(P.LE.0.0 .OR. P.GE.1.0)THEN
        WRITE(ICOUT,1901)
 1901   FORMAT('***** ERROR: FOR EWMA CONTROL CHARTS, THE WEIGHTING',
     1         ' PARAMETER P MUST BE SPECIFIED')
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1902)
 1902   FORMAT('     AND IN THE RANGE (0,1).  IT IS TYPICALLY ',
     1         ' BETWEEN 0.1 AND 0.5 .')
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1903)
 1903   FORMAT('     FOR EXAMPLE: LET P = 0.2 ')
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      J=0
      IF(CCTARG.NE.CPUMIN)THEN
        AK0=CCTARG
      ELSE
        AK0=XBARG
      ENDIF
      YMID=AK0
C
      DO1910ISET=1,NUMSET
C
      K=0
      DO1920I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 1920 CONTINUE
      NI=K
      ANI=NI
C
      IF(NI.GE.1)GOTO1939
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1931)
 1931 FORMAT('***** INTERNAL ERROR IN DPCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1932)
 1932 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1933)ISET,XIDTEM(ISET),NI
 1933 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1939 CONTINUE
C
      SUM=0.0
      DO1940I=1,NI
      SUM=SUM+TEMP(I)
 1940 CONTINUE
      XBARI=SUM/ANI
C
      AK1=P*XBARI + (1.0-P)*AK0
      IF(N.NE.NUMSET)THEN
        SADJ=SIGMAE*3.0902*SQRT(P/(ANI*(2.0-P)))
      ELSE
        IF(KWIDTH.LE.25)THEN
          SADJ=(RANGEM/E2(KWIDTH))*3.0902*SQRT(P/(ANI*(2.0-P)))
        ELSE
          SADJ=(RANGEM/E2(25))*3.0902*SQRT(P/(ANI*(2.0-P)))
        ENDIF
      ENDIF
      YUPPER=XBARG+SADJ
      YLOWER=XBARG-SADJ
C
      IF(IBUGG3.EQ.'OFF')GOTO1969
      WRITE(ICOUT,1961)ISET,NI,ANI
 1961 FORMAT('ISET,NI,ANI = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1962)XBARI
 1962 FORMAT('XBARI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1963)SDI,SIGMAE,SADJ
 1963 FORMAT('SDI,SIGMAE,SADJ = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1964)XBARG,AK0,AK1
 1964 FORMAT('XBARG,AK0,AK1 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1965)YLOWER,YUPPER
 1965 FORMAT('YLOWER,YUPPER = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1969 CONTINUE
C
      J=J+1
      Y2(J)=AK1
      X2(J)=XIDTEM(ISET)
      D2(J)=1.0
C
      J=J+1
      Y2(J)=XBARG
      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
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      IF(CCTARG.EQ.CPUMIN)GOTO1971
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XIDTEM(ISET)
      D2(J)=5.0
 1971 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO1972
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XIDTEM(ISET)
      D2(J)=6.0
 1972 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO1973
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XIDTEM(ISET)
      D2(J)=7.0
 1973 CONTINUE
C
      AK0=AK1
C
 1910 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               *****************************************
C               **  STEP 5.10--                        **
C               **  TREAT THE MOVING AVERAGE           **
C               **  CONTROL CHART CASE                 **
C               *****************************************
C
 2000 CONTINUE
C
      ISTEPN='5.10'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(KWIDTH.LT.2)KWIDTH=2
      IF(KWIDTH.GT.N-1)KWIDTH=N-1
      AK=REAL(KWIDTH)
      NBEF=KWIDTH/2
      NAFT=NBEF
      IF(MOD(KWIDTH,2).EQ.0)NAFT=NBEF-1
C
      J=0
C
      DO2010ISET=1,NUMSET
C
      K=0
      DO2020I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 2020 CONTINUE
      NI=K
      ANI=NI
C
      IF(NI.GE.1)GOTO2039
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2031)
 2031 FORMAT('***** INTERNAL ERROR IN DPCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2032)
 2032 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2033)ISET,XIDTEM(ISET),NI
 2033 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2039 CONTINUE
C
      IF(NI.EQ.1)THEN
        TEMP2(ISET)=TEMP(1)
      ELSE
        SUM=0.0
        DO2040I=1,NI
        SUM=SUM+TEMP(I)
 2040   CONTINUE
        TEMP2(ISET)=SUM/ANI
      ENDIF
C
 2010 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO2069
      WRITE(ICOUT,2061)ISET,NI,ANI
 2061 FORMAT('ISET,NI,ANI = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2062)XBARI
 2062 FORMAT('XBARI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2063)SDI,SIGMAE,SADJ
 2063 FORMAT('SDI,SIGMAE,SADJ = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2064)XBARG,AK0,AK1
 2064 FORMAT('XBARG,AK0,AK1 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2065)YLOWER,YUPPER
 2065 FORMAT('YLOWER,YUPPER = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 2069 CONTINUE
C
      IF(1+NBEF.GT.NUMSET-NAFT)THEN
        WRITE(ICOUT,2085)KWIDTH,NUMSET
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ENDIF
 2085 FORMAT(
     1'***** ERROR: THERE ARE NOT ENOUGH GROUPS TO FORM THE MOVING',
     1/,
     1'      AVERAGE PLOT.  THE FILTER WIDTH IS ',I5,' AND THE ',/,
     1'      NUMBER OF GROUPS IS ',I5,' .')
C
      DO2090ISET=1,NUMSET
C
      SUM=0.0
      IF(ISET.LT.1+NBEF)THEN
      DO2092II=1,ISET+NAFT
      SUM=SUM+TEMP2(II)
 2092 CONTINUE
      YVAL=SUM/REAL(ISET+NAFT)
      ELSEIF(ISET.GT.NUMSET-NAFT)THEN
      DO2094II=ISET-NBEF,NUMSET
      SUM=SUM+TEMP2(II)
 2094 CONTINUE
      YVAL=SUM/REAL(NUMSET-(ISET-NBEF)+1)
      ELSE
      DO2096II=ISET-NBEF,ISET+NAFT
      SUM=SUM+TEMP2(II)
 2096 CONTINUE
      YVAL=SUM/REAL(KWIDTH)
      ENDIF
      J=J+1
      Y2(J)=YVAL
      XVAL=XIDTEM(ISET)
      IF(NBEF.NE.NAFT)THEN
        IF(ISET.GT.1)THEN
          XVAL=(XIDTEM(ISET)+XIDTEM(ISET-1))/2.0
        ELSE
          XVAL=XIDTEM(1)
        ENDIF
      ENDIF
      X2(J)=XVAL
      D2(J)=1.0
C
      J=J+1
      Y2(J)=XBARG
      X2(J)=XVAL
      D2(J)=2.0
C
      IF(N.NE.NUMSET)THEN
        YUPPER=XBARG+3.09*SIGMAE/SQRT(AK)
        YLOWER=XBARG-3.09*SIGMAE/SQRT(AK)
      ELSE
        IF(KWIDTH.LE.25)THEN
          YUPPER=XBARG+3.09*RANGEM/(E2(KWIDTH)*SQRT(AK))
          YLOWER=XBARG-3.09*RANGEM/(E2(KWIDTH)*SQRT(AK))
        ELSE
          YUPPER=XBARG+3.09*RANGEM/(E2(25)*SQRT(AK))
          YLOWER=XBARG-3.09*RANGEM/(E2(25)*SQRT(AK))
        ENDIF
      ENDIF
C
      J=J+1
      Y2(J)=YUPPER
      X2(J)=XVAL
      D2(J)=3.0
C
      J=J+1
      Y2(J)=YLOWER
      X2(J)=XVAL
      D2(J)=4.0
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      IF(CCTARG.EQ.CPUMIN)GOTO2071
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XVAL
      D2(J)=5.0
 2071 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO2072
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XVAL
      D2(J)=6.0
 2072 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO2073
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XVAL
      D2(J)=7.0
 2073 CONTINUE
C
 2090 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               *****************************************
C               **  STEP 5.11--                        **
C               **  TREAT THE MOVING RANGE             **
C               **  CONTROL CHART CASE                 **
C               *****************************************
C
 2100 CONTINUE
C
      ISTEPN='5.11'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(KWIDTH.LT.2)KWIDTH=2
      IF(KWIDTH.GT.N-1)KWIDTH=N-1
      AK=REAL(KWIDTH)
      NBEF=KWIDTH/2
      NAFT=NBEF
      IF(MOD(KWIDTH,2).EQ.0)NAFT=NBEF-1
C
      J=0
C
C  2 CASES:
C    1) UNGROUPED DATA (N=NUMSET)
C    2) GROUPED DATA (N> NUMSET).  FOR GROUPED DATA, EACH GROUP
C       SHOULD HAVE AT LEAST 2 VALUES.
C
C  UNGROUPED CASE
C
      IF(N.EQ.NUMSET)THEN
        DO2102ISET=1,N
        TEMP2(ISET)=Y(ISET)
 2102   CONTINUE
        GOTO2119
      ENDIF
C
C  GROUPED CASE
C
      DO2110ISET=1,NUMSET
C
      K=0
      DO2120I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 2120 CONTINUE
      NI=K
      ANI=NI
C
      IF(NI.GE.1)GOTO2139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2131)
 2131 FORMAT('***** INTERNAL ERROR IN DPCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2132)
 2132 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2133)ISET,XIDTEM(ISET),NI
 2133 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2139 CONTINUE
C
      XTMIN=TEMP(1)
      XTMAX=TEMP(1)
      DO2140I=1,NI
      IF(TEMP(I).LT.XTMIN)XTMIN=TEMP(I)
      IF(TEMP(I).GT.XTMAX)XTMAX=TEMP(I)
 2140 CONTINUE
C
      TEMP2(ISET)=XTMAX-XTMIN
C
 2110 CONTINUE
 2119 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO2169
      WRITE(ICOUT,2161)ISET,NI,ANI
 2161 FORMAT('ISET,NI,ANI = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2162)XBARI
 2162 FORMAT('XBARI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2163)SDI,SIGMAE,SADJ
 2163 FORMAT('SDI,SIGMAE,SADJ = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2164)XBARG,AK0,AK1
 2164 FORMAT('XBARG,AK0,AK1 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2165)YLOWER,YUPPER
 2165 FORMAT('YLOWER,YUPPER = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 2169 CONTINUE
C
      IF(1+NBEF.GT.NUMSET-NAFT)THEN
        WRITE(ICOUT,2168)KWIDTH,NUMSET
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ENDIF
 2168 FORMAT(
     1'***** ERROR: THERE ARE NOT ENOUGH GROUPS TO FORM THE MOVING',
     1/,
     1'      RANGE PLOT.  THE FILTER WIDTH IS ',I5,' AND THE ',/,
     1'      NUMBER OF GROUPS IS ',I5,' .')
C
      SUM2=0.0
      NUMRAN=0
      DO2190ISET=1,NUMSET
C
C GROUPED DATA
C
      IF(N.NE.NUMSET)THEN
        SUM=0.0
        IF(ISET.LT.1+NBEF)THEN
          DO2192II=1,ISET+NAFT
          SUM=SUM+TEMP2(II)
 2192     CONTINUE
          YVAL=SUM/REAL(ISET+NAFT)
        ELSEIF(ISET.GT.NUMSET-NAFT)THEN
          DO2194II=ISET-NBEF,NUMSET
          SUM=SUM+TEMP2(II)
 2194     CONTINUE
          YVAL=SUM/REAL(NUMSET-(ISET-NBEF)+1)
        ELSE
          DO2196II=ISET-NBEF,ISET+NAFT
          SUM=SUM+TEMP2(II)
 2196     CONTINUE
          YVAL=SUM/AK
        ENDIF
C
        J=J+1
        Y2(J)=YVAL
C
C UNGROUPED DATA
C
      ELSE
        IF(ISET.LT.1+NBEF)THEN
          XTMIN=TEMP2(1)
          XTMMAX=TEMP2(1)
          DO2182II=1,ISET+NAFT
          IF(TEMP2(II).LT.XTMIN)XTMIN=TEMP2(II)
          IF(TEMP2(II).GT.XTMAX)XTMAX=TEMP2(II)
 2182     CONTINUE
          YVAL=XTMAX-XTMIN
        ELSEIF(ISET.GT.NUMSET-NAFT)THEN
          XTMIN=TEMP2(ISET-NBEF)
          XTMMAX=TEMP2(ISET-NBEF)
          DO2184II=ISET-NBEF,NUMSET
          IF(TEMP2(II).LT.XTMIN)XTMIN=TEMP2(II)
          IF(TEMP2(II).GT.XTMAX)XTMAX=TEMP2(II)
 2184     CONTINUE
          YVAL=XTMAX-XTMIN
        ELSE
          XTMIN=TEMP2(ISET-NBEF)
          XTMMAX=TEMP2(ISET-NBEF)
          DO2186II=ISET-NBEF,ISET+NAFT
          IF(TEMP2(II).LT.XTMIN)XTMIN=TEMP2(II)
          IF(TEMP2(II).GT.XTMAX)XTMAX=TEMP2(II)
 2186     CONTINUE
          YVAL=XTMAX-XTMIN
        ENDIF
C
        J=J+1
        Y2(J)=YVAL
      ENDIF
      XVAL=XIDTEM(ISET)
      IF(NBEF.NE.NAFT)XVAL=(XIDTEM(ISET)+XIDTEM(ISET-1))/2.0
      X2(J)=XVAL
      D2(J)=1.0
C
      IF(KWIDTH.LE.25)THEN
        YUPPER=D4(KWIDTH)*RANGEM
        YLOWER=D3(KWIDTH)*RANGEM
      ELSE
        YUPPER=(1.0+3.0*D4FACT/SQRT(2.0*(REAL(KWIDTH)-1.0)))*RANGEM
     1         /E2(25)
        YLOWER=(1.0-3.0*D3FACT/SQRT(2.0*(REAL(KWIDTH)-1.0)))*RANGEM
     1         /E2(25)
      ENDIF
      IF(YLOWER.LT.0.0)YLOWER=0.0
C
      J=J+1
      Y2(J)=RANGEM
      X2(J)=XVAL
      D2(J)=2.0
C
      J=J+1
      Y2(J)=YUPPER
      X2(J)=XVAL
      D2(J)=3.0
C
      J=J+1
      Y2(J)=YLOWER
      X2(J)=XVAL
      D2(J)=4.0
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      IF(CCTARG.EQ.CPUMIN)GOTO2171
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XVAL
      D2(J)=5.0
 2171 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO2172
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XVAL
      D2(J)=6.0
 2172 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO2173
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XVAL
      D2(J)=7.0
 2173 CONTINUE
C
 2190 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               *****************************************
C               **  STEP 5.12--                        **
C               **  TREAT THE MOVING STANDARD DEVIATION**
C               **  CONTROL CHART CASE                 **
C               *****************************************
C
 2200 CONTINUE
C
      ISTEPN='5.12'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(KWIDTH.LT.2)KWIDTH=2
      IF(KWIDTH.GT.N-1)KWIDTH=N-1
      AK=REAL(KWIDTH)
      NBEF=KWIDTH/2
      NAFT=NBEF
      IF(MOD(KWIDTH,2).EQ.0)NAFT=NBEF-1
C
      J=0
C
C  2 CASES:
C    1) UNGROUPED DATA (N=NUMSET)
C    2) GROUPED DATA (N> NUMSET).  FOR GROUPED DATA, EACH GROUP
C       SHOULD HAVE AT LEAST 2 VALUES.
C
C  UNGROUPED CASE
C
      IF(N.EQ.NUMSET)THEN
        DO2202ISET=1,N
        TEMP2(ISET)=Y(ISET)
 2202   CONTINUE
        GOTO2219
      ENDIF
C
C  GROUPED CASE
C
      DO2210ISET=1,NUMSET
C
      K=0
      DO2220I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 2220 CONTINUE
      NI=K
      ANI=NI
C
      IF(NI.GE.2)GOTO2239
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2231)
 2231 FORMAT('***** ERROR IN DPCC2 FOR MOVING STANDARD DEVIATION',
     1' CONTROL CHART--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2232)
 2232 FORMAT('NI FOR SOME CLASS <= 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2233)ISET,XIDTEM(ISET),NI
 2233 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2239 CONTINUE
C
      SUM1=0.0
      DO2240I=1,NI
      SUM1=SUM1+TEMP(I)
 2240 CONTINUE
      XMEAN=SUM1/ANI
      SUM1=0.0
      DO2242I=1,NI
        SUM1=SUM1+(TEMP(I)-XMEAN)**2
 2242 CONTINUE
      SD=SQRT(SUM1/(ANI-1.0))
C
      TEMP2(ISET)=SD
C
 2210 CONTINUE
 2219 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO2269
      WRITE(ICOUT,2261)ISET,NI,ANI
 2261 FORMAT('ISET,NI,ANI = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2262)XBARI
 2262 FORMAT('XBARI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2263)SDI,SIGMAE,SADJ
 2263 FORMAT('SDI,SIGMAE,SADJ = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2264)XBARG,AK0,AK1
 2264 FORMAT('XBARG,AK0,AK1 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2265)YLOWER,YUPPER
 2265 FORMAT('YLOWER,YUPPER = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 2269 CONTINUE
C
      IF(1+NBEF.GT.NUMSET-NAFT)THEN
        WRITE(ICOUT,2268)KWIDTH,NUMSET
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ENDIF
 2268 FORMAT(
     1'***** ERROR: THERE ARE NOT ENOUGH GROUPS TO FORM THE MOVING',
     1/,
     1'      STANDARD DEVIATION PLOT.  THE FILTER WIDTH IS ',I5,
     1'      AND THE NUMBER OF GROUPS IS ',I5,' .')
C
      SUM2=0.0
      NUMSD=0
      DO2290ISET=1,NUMSET
C
C GROUPED DATA
C
      IF(N.NE.NUMSET)THEN
        SUM=0.0
        IF(ISET.LT.1+NBEF)THEN
          DO2292II=1,ISET+NAFT
          SUM=SUM+TEMP2(II)
 2292     CONTINUE
          YVAL=SUM/REAL(ISET+NAFT)
        ELSEIF(ISET.GT.NUMSET-NAFT)THEN
          DO2294II=ISET-NBEF,NUMSET
          SUM=SUM+TEMP2(II)
 2294     CONTINUE
          YVAL=SUM/REAL(NUMSET-(ISET-NBEF)+1)
        ELSE
          DO2296II=ISET-NBEF,ISET+NAFT
          SUM=SUM+TEMP2(II)
 2296     CONTINUE
          YVAL=SUM/AK
        ENDIF
C
        J=J+1
        Y2(J)=YVAL
C
C UNGROUPED DATA
C
      ELSE
        IF(ISET.LT.1+NBEF)THEN
          SUM1=0.0
          ICOUNT=0
          DO2282II=1,ISET+NAFT
          ICOUNT=ICOUNT+1
          SUM1=SUM1+TEMP2(II)
 2282     CONTINUE
          XMEAN=SUM1/REAL(ICOUNT)
          SUM1=0.0
          DO2283II=1,ISET+NAFT
          SUM1=SUM1+(TEMP2(II)-XMEAN)**2
 2283     CONTINUE
          IF(ICOUNT.LT.2)GOTO2290
          YVAL=SQRT(SUM1/REAL(ICOUNT-1))
        ELSEIF(ISET.GT.NUMSET-NAFT)THEN
          SUM1=0.0
          ICOUNT=0
          DO2284II=ISET-NBEF,NUMSET
          ICOUNT=ICOUNT+1
          SUM1=SUM1+TEMP2(II)
 2284     CONTINUE
          XMEAN=SUM1/REAL(ICOUNT)
          SUM1=0.0
          DO2285II=ISET-NBEF,NUMSET
          SUM1=SUM1+(TEMP2(II)-XMEAN)**2
 2285     CONTINUE
          IF(ICOUNT.LT.2)GOTO2290
          YVAL=SQRT(SUM1/REAL(ICOUNT-1))
        ELSE
          SUM1=0.0
          ICOUNT=0
          DO2286II=ISET-NBEF,ISET+NAFT
          ICOUNT=ICOUNT+1
          SUM1=SUM1+TEMP2(II)
 2286     CONTINUE
          XMEAN=SUM1/REAL(ICOUNT)
          SUM1=0.0
          DO2287II=ISET-NBEF,ISET+NAFT
          SUM1=SUM1+(TEMP2(II)-XMEAN)**2
 2287     CONTINUE
          YVAL=SQRT(SUM1/REAL(ICOUNT-1))
        ENDIF
C
        J=J+1
        Y2(J)=YVAL
      ENDIF
      XVAL=XIDTEM(ISET)
      IF(NBEF.NE.NAFT)XVAL=(XIDTEM(ISET)+XIDTEM(ISET-1))/2.0
      X2(J)=XVAL
      D2(J)=1.0
C
      IF(KWIDTH.LE.25)THEN
        YUPPER=B4(KWIDTH)*SDM
        YLOWER=B3(KWIDTH)*SDM
      ELSE
        YUPPER=(1.0+3.0/SQRT(2.0*(REAL(KWIDTH)-1.0)))*SDM
        YLOWER=(1.0-3.0/SQRT(2.0*(REAL(KWIDTH)-1.0)))*SDM
      ENDIF
      IF(YLOWER.LT.0.0)YLOWER=0.0
C
      J=J+1
      Y2(J)=SDM
      X2(J)=XVAL
      D2(J)=2.0
C
      J=J+1
      Y2(J)=YUPPER
      X2(J)=XVAL
      D2(J)=3.0
C
      J=J+1
      Y2(J)=YLOWER
      X2(J)=XVAL
      D2(J)=4.0
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED SEPTEMBER
      IF(CCTARG.EQ.CPUMIN)GOTO2271
      J=J+1
      Y2(J)=CCTARG
      X2(J)=XVAL
      D2(J)=5.0
 2271 CONTINUE
C
      IF(CCUSL.EQ.CPUMIN)GOTO2272
      J=J+1
      Y2(J)=CCUSL
      X2(J)=XVAL
      D2(J)=6.0
 2272 CONTINUE
C
      IF(CCLSL.EQ.CPUMIN)GOTO2273
      J=J+1
      Y2(J)=CCLSL
      X2(J)=XVAL
      D2(J)=7.0
 2273 CONTINUE
C
 2290 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCC2--')
      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 DPCD(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,DEMOFR,DEMODF,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 2
C              COMPLEX DEMODULATION PLOTS--
C                   1) AMPLITUDE;
C                   2) PHASE;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1978.
C     UPDATED         --JULY      1981.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(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-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.141592653/
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPCD'
      ISUBN2='    '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=1
      MINN2=2
C
C               ***********************************************
C               **  TREAT THE COMPLEX DEMODULATION CASE      **
C               ***********************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'COMP'.AND.IHARG(1).EQ.'DEMO'.AND.IHARG(2).EQ.'AMPL'.AND.
     1IHARG(3).EQ.'PLOT')GOTO110
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'COMP'.AND.IHARG(1).EQ.'DEMO'.AND.IHARG(2).EQ.'PHAS'.AND.
     1IHARG(3).EQ.'PLOT')GOTO120
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ICASPL='CDAM'
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  120 CONTINUE
      ICASPL='CDPH'
      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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,ICOLL,NLEFT
  211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.                   **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPCD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CDAM')WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A COMPLEX DEMODULATION ',
     1'AMPLITUDE PLOT ')
      IF(ICASPL.EQ.'CDAM')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CDPH')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A COMPLEX DEMODULATION ',
     1'PHASE PLOT ')
      IF(ICASPL.EQ.'CDPH')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPCD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  CHECK FOR PROPER NUMBER OF VARIABLES.  **
C               **  FOR A COMPLEX DEMODULATION PLOT,       **
C               **  THE PROPER NUMBER OF VARIABLES IS      **
C               **  EXACTLY 1.                             **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.1)GOTO590
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPCD--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CDAM')WRITE(ICOUT,552)
  552 FORMAT('      FOR A COMPLEX DEMODULATION  ',
     1'AMPLITUDE PLOT,')
      IF(ICASPL.EQ.'CDAM')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CDPH')WRITE(ICOUT,553)
  553 FORMAT('      FOR A COMPLEX DEMODULATION  ',
     1'PHASE PLOT,')
      IF(ICASPL.EQ.'CDPH')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,559)
  559 FORMAT('      MUST BE EXACTLY 1  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  560 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,561)
  561 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)NUMV2
  562 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,564)(IANS(I),I=1,IWIDTH)
  564 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *************************************************
C               **  STEP 6--                                   **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
      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)
  660 CONTINUE
      NLOCAL=J
C
C               ***********************************************************
C               **  STEP 7--                                             **
C               **  DETERMINE IF THE ANALYST                             **
C               **  HAS SPECIFIED    THE DEMODULATION FREQUENCY          **
C               **  FOR THE COMPLEX DEMODULATION ANALYSIS.               **
C               **  THE FREQUENCY SETTING IS DEFINED BY PRE-USE          **
C               **  OF THE DEMODULATION FREQUENCY     COMMAND.           **
C               **  IF FOUND, USE THE SPECIFIED VALUE.                   **
C               **  IF NOT FOUND, GENERATE AN ERROR MESSAGE.             **
C               ***********************************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DEMOF2=DEMOFR
      IF(IANGLU.EQ.'DEGR')DEMOF2=DEMOF2*PI/180.0
      IF(IANGLU.EQ.'GRAD')DEMOF2=DEMOF2*PI/200.0
      IF(0.0.LT.DEMOF2.AND.DEMOF2.LT.0.5)GOTO790
C
  740 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,741)
  741 FORMAT('****** ERROR IN DPCD--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CDAM')WRITE(ICOUT,742)
  742 FORMAT('       FOR A COMPLEX DEMODULATION ',
     1'AMPLITUDE PLOT,')
      IF(ICASPL.EQ.'CDAM')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CDPH')WRITE(ICOUT,743)
  743 FORMAT('       FOR A COMPLEX DEMODULATION ',
     1'PHASE PLOT,')
      IF(ICASPL.EQ.'CDPH')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,744)
  744 FORMAT('       THE FREQUENCY AT WHICH THE DEMODULATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,745)
  745 FORMAT('       IS TO BE PERFORMED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,746)
  746 FORMAT('       MUST BE PRE-SPECIFIED BY THE ANALYST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,747)
  747 FORMAT('       AND MUST BE BETWEEN 0 AND 0.5 RADIANS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,748)
  748 FORMAT('       SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,749)DEMOFR,IANGLU
  749 FORMAT('       THE DEMODULATION FREQUENCY = ',E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IANGLU.NE.'RADI')WRITE(ICOUT,750)DEMOF2
  750 FORMAT('       THE DEMODULATION FREQUENCY = ',E15.7,2X,
     1'RADIANS')
      IF(IANGLU.NE.'RADI')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,751)
  751 FORMAT('       TO DEFINE THE DEMODULATION FREQUENCY,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,752)
  752 FORMAT('       THE ANALYST USES THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,753)
  753 FORMAT('       DEMODULATION FREQUENCY     COMMAND, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,754)
  754 FORMAT('            DEMODULATION FREQUENCY 0.3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,755)
  755 FORMAT('            DEMODULATION FREQUENCY 0.155')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  790 CONTINUE
C
C               ****************************************************************
C               **  STEP 8--                                                   *
C               **  COMPUTE THE APPROPRIATE COMPLEX DEMODULATION               *
C               **  PLOT  (AMPLITUDE OR PHASE).                                *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                      *
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.                         *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).              *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).              *
C               ****************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPCD2(Y1,NLEFT,ICASPL,DEMOF2,DEMODF,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHIST--')
      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)DEMOFR,IANGLU,DEMOF2
 9014 FORMAT('DEMOFR,IANGLU,DEMOF2 = ',E15.7,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCD2(Y,N,ICASPL,F,DEMODF,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A COMPLEX DEMODULATION
C              ON THE DATA IN THE INPUT VECTOR X
C              AT THE INPUT DEMODULATION FREQUENCY = F.
C              THE COMPLEX DEMODULATION CONSISTS OF THE FOLLOWING--
C              1) AN AMPLITUDE VERSUS TIME PLOT;
C              2) A PHASE VERSUS TIME PLOT;
C              3) AN UPDATED DEMODULATION FREQUENCY ESTIMATE
C                 TO ASSIST THE ANALYST IN DETERMINING A
C                 MORE APPROPRIATE FREQUENCY AT WHICH
C                 TO DEMODULATE IN CASE THE SPECIFIED
C                 INPUT DEMODULATION FREQUENCY F
C                 DOES NOT FLATTEN SUFFICIENTLY THE
C                 PHASE PLOT.
C
C              THE ALLOWABLE RANGE OF THE INPUT DEMODULATION
C              FREQUENCY F IS 0.0 TO 0.5 (EXCLUSIVELY).
C              THE INPUT DEMODULATION FREQUENCY F IS MEASURED  OF
C              IN UNITS OF CYCLES PER 'DATA POINT' OR,
C              MORE PRECISELY, IN CYCLES PER UNIT TIME WHERE
C              'UNIT TIME' IS DEFINED AS THE
C              ELAPSED TIME BETWEEN ADJACENT OBSERVATIONS.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C                      FREQ   = THE SINGLE PRECISION
C                               DEMODULATION FREQUENCY.
C                               F IS IN UNITS OF CYCLES PER DATA POINT.
C                               F IS BETWEEN 0.0 AND 0.5 (EXCLUSIVELY).
C     OUTPUT--2 PAGES OF AUTOMATIC PRINTOUT--
C             1) AN AMPLITUDE PLOT;
C             2) A PHASE PLOT; AND
C             3) AN UPDATED DEMODULATION FREQUENCY ESTIMATE.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 5000.
C                 --THE SAMPLE SIZE N MUST BE GREATER
C                   THAN OR EQUAL TO 3.
C                 --THE INPUT FREQUENCY F MUST BE
C                   GREATER THAN OR EQUAL TO 2/(N-2).
C                 --THE INPUT FREQUENCY F MUST BE
C                   SMALLER THAN 0.5.
C     OTHER DATAPAC   SUBROUTINES NEEDED--PLOTX.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, SIN, COS, ATAN.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     COMMENT--IN ORDER THAT THE RESULTS OF THE COMPLEX DEMODULATION
C              BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA
C              IN X SHOULD BE EQUI-SPACED IN TIME
C              (OR WHATEVER VARIABLE CORRESPONDS TO TIME).
C            --IF THE INPUT OBSERVATIONS IN X ARE CONSIDERED
C              TO HAVE BEEN COLLECTED 1 SECOND APART IN TIME,
C              THEN THE DEMODULATION FREQUENCY F
C              WOULD BE IN UNITS OF HERTZ
C              (= CYCLES PER SECOND).
C            --A FREQUENCY OF 0.0 CORRESPONDS TO A CYCLE
C              IN THE DATA OF INFINITE (= 1/(0.0))
C              LENGTH OR PERIOD.
C              A FREQUENCY OF 0.5 CORRESPONDS TO A CYCLE
C              IN THE DATA OF LENGTH = 1/(0.5) = 2 DATA POINTS.
C            --IN EXAMINING THE AMPLITUDE AND PHASE PLOTS,
C              ATTENTION SHOULD BE PAID NOT ONLY TO THE
C              STRUCTURE OF THE PHASE PLOT
C              (NEAR-ZERO SLOPE VERSUS NON-ZERO SLOPE)
C              BUT ALSO TO THE RANGE
C              OF VALUES ON THE VERTICAL AXIS.
C              A PLOT WITH MUCH STRUCTURE BUT
C              WITH A SMALL RANGE ON THE VERTICAL AXIS
C              IS USUALLY MORE INDICATIVE OF A
C              DEFINITE CYCLIC COMPONENT AT THE
C              SPECIFIED INPUT DEMODULATION FREQUENCY,
C              THAN IS A PLOT WITH LESS STRUCTURE BUT
C              A WIDER RANGE ON THE VERTICAL AXIS.
C            --INTERNAL TO THIS SUBROUTINE, 2 MOVING
C              AVERAGES ARE APPLIED, EACH OF LENGTH 1/F.
C              HENCE THE AMPLITUDE AND PHASE PLOTS
C              HAVE N - 2/F VALUES
C              (RATHER THAN N VALUES) ALONG THE
C              HORIZONTAL (TIME) AXIS.
C              IN ORDER THAT THE AMPLITUDE AND PHASE
C              PLOTS BE NON-EMPTY, AN INPUT
C              REQUIREMENT ON F FOR THIS SUBROUTINE
C              IS THAT THE SAMPLE SIZE N
C              AND THE DEMODULATION FREQUENCY F
C              MUST BE SUCH THAT
C              N - 2/F BE GREATER THAN ZERO.
C              FURTHER, SINCE A PLOT WITH BUT
C              1 POINT IS MEANINGLESS
C              AND OUGHT ALSO BE EXCLUDED,
C              THE REQUIREMENT IS EXTENDED
C              SO THAT N - 2/F MUST BE GREATER THAN 1.
C     REFERENCES--GRANGER AND HATANAKA, PAGES 170 TO 189,
C                 ESPECIALLY PAGES 173, 177, AND 182.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1972.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --FEBRUARY  1976.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y(*)
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-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.141592653/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPCD'
      ISUBN2='2   '
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,ICASPL
   52 FORMAT('N,ICASPL = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      ILOWER=3
      IUPPER=MAXOBV
      AN=N
      FMIN=2.0/(AN-2.0)
C
C               ********************************************
C               **  STEP 0--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LT.ILOWER.OR.N.GT.IUPPER)GOTO50
      IF(F.LE.FMIN.OR.F.GE.0.5)GOTO60
      HOLD=Y(1)
      DO65I=2,N
      IF(Y(I).NE.HOLD)GOTO95
   65 CONTINUE
      WRITE(ICOUT, 9)HOLD
      CALL DPWRST('XXX','BUG ')
      GOTO9000
   50 WRITE(ICOUT,17)ILOWER,IUPPER
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)N
      CALL DPWRST('XXX','BUG ')
      GOTO9000
   60 WRITE(ICOUT,27)FMIN
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)F
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,28)FMIN,N
      CALL DPWRST('XXX','BUG ')
      GOTO9000
   95 CONTINUE
    9 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME',
     1'NT (A VECTOR) TO THE DPCD2  SUBROUTINE HAS ALL ELEMENTS = ',
     1E15.8)
   17 FORMAT('***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE ',
     1'DPCD2  SUBROUTINE IS OUTSIDE THE ALLOWABLE (',I6,',',I6,') ',
     1'INTERVAL')
   27 FORMAT('***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE ',
     1'DPCD2  SUBROUTINE IS OUTSIDE THE ALLOWABLE (',I6,'0.5) ',
     1'INTERVAL')
   28 FORMAT('                   THE ABOVE LOWER LIMIT (',F10.8,
     1') = 2/(N-2) WHERE N = THE INPUT SAMPLE SIZE = ',I8)
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8)
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
C
C               ******************************
C               **  STEP 1--                **
C               **  FORM THE COSINE SERIES  **
C               ******************************
C
      DO100I=1,N
      AI=I
      Y2(I)=Y(I)*COS(2.0*PI*F*AI)
  100 CONTINUE
C
C     DEFINE THE LENGTH OF THE 2 MOVING AVERAGES
C
      LENMA1=1.0/F
      LENMA2=1.0/F
      ALEN1=LENMA1
      ALEN2=LENMA2
      IMAX1=N-LENMA1
      IMAX2=IMAX1-LENMA2
C
C               ***********************************************************
C               **  STEP 2--                                             **
C               **  FORM THE FIRST MOVING AVERAGE FOR THE COSINE SERIES  **
C               ***********************************************************
C
      DO200I=1,IMAX1
      ISTART=I+1
      IEND=I+LENMA1-1
      IENDP1=I+LENMA1
      SUM=0.0
      DO300J=ISTART,IEND
      SUM=SUM+Y2(J)
  300 CONTINUE
      SUM=SUM+Y2(I)/2.0+Y2(IENDP1)/2.0
      D2(I)=SUM/ALEN1
  200 CONTINUE
C
C               ************************************************************
C               **  STEP 3--                                              **
C               **  FORM THE SECOND MOVING AVERAGE FOR THE COSINE SERIES  **
C               ************************************************************
C
      DO400I=1,IMAX2
      ISTART=I+1
      IEND=I+LENMA2-1
      IENDP1=I+LENMA2
      SUM=0.0
      DO500J=ISTART,IEND
      SUM=SUM+D2(J)
  500 CONTINUE
      SUM=SUM+D2(I)/2.0+D2(IENDP1)/2.0
      Y2(I)=SUM/ALEN2
  400 CONTINUE
C
C               ****************************
C               **  STEP 4--              **
C               **  FORM THE SINE SERIES  **
C               ****************************
C
      DO700I=1,N
      AI=I
      X2(I)=Y(I)*SIN(2.0*PI*F*AI)
  700 CONTINUE
C
C               *********************************************************
C               **  STEP 5--                                           **
C               **  FORM THE FIRST MOVING AVERAGE FOR THE SINE SERIES  **
C               *********************************************************
C
      DO800I=1,IMAX1
      ISTART=I+1
      IEND=I+LENMA1-1
      IENDP1=I+LENMA1
      SUM=0.0
      DO900J=ISTART,IEND
      SUM=SUM+X2(J)
  900 CONTINUE
      SUM=SUM+X2(I)/2.0+X2(IENDP1)/2.0
      D2(I)=SUM/ALEN1
  800 CONTINUE
C
C               **********************************************************
C               **  STEP 6--                                            **
C               **  FORM THE SECOND MOVING AVERAGE FOR THE SINE SERIES  **
C               **********************************************************
C
      DO1000I=1,IMAX2
      ISTART=I+1
      IEND=I+LENMA1-1
      IENDP1=I+LENMA1
      SUM=0.0
      DO1100J=ISTART,IEND
      SUM=SUM+D2(J)
 1100 CONTINUE
      SUM=SUM+D2(I)/2.0+D2(IENDP1)/2.0
      X2(I)=SUM/ALEN2
 1000 CONTINUE
C
C     CHECK FOR DESIRED CASE
C     AND BRANCH ACCORDINGLY.
C
      IF(ICASPL.EQ.'CDAM')GOTO1400
      IF(ICASPL.EQ.'CDPH')GOTO1700
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** INTERNAL ERROR IN DPCD2 ',
     1'AT BRANCH POINT 1311--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      ICASPL SHOULD BE EITHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      CDAM   OR    CDPH, BUT IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1314)ICASPL
 1314 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *****************************************
C               **  STEP 7--                           **
C               **  FORM THE AMPLITUDES AND PLOT THEM  **
C               *****************************************
C
 1400 CONTINUE
      DO1450I=1,IMAX2
      Y2(I)=2.0*SQRT(Y2(I)*Y2(I)+X2(I)*X2(I))
      X2(I)=I
      D2(I)=1.0
 1450 CONTINUE
      N2=IMAX2
      NPLOTV=2
CCCCC WRITE(ICOUT,1451)F
C1451 FORMAT(30X, 48HAMPLITUDE PLOT FOR THE DEMODULATION FREQUENCY =
CCCCC1 ,F8.6,21H CYCLES PER UNIT TIME)
CCCCC CALL DPWRST('XXX','BUG ')
C
C     COMPUTE THE DIFFERENCE BETWEEN THE MAX AND MIN AMPLITUDES AND WRITE IT OUT
C
      Y2MIN=Y2(1)
      Y2MAX=Y2(1)
      DO1600I=1,IMAX2
      IF(Y2(I).LT.Y2MIN)Y2MIN=Y2(I)
      IF(Y2(I).GT.Y2MAX)Y2MAX=Y2(I)
 1600 CONTINUE
      RANGE=Y2MAX-Y2MIN
CCCCC WRITE(ICOUT,1651)Y2MIN,Y2MAX,RANGE
C1651 FORMAT(9X,20HMINIMUM AMPLITUDE = ,E15.8,5X,20HMAXIMUM AMPLITUD
CCCCC1E = ,E15.8,5X,22HRANGE OF AMPLITUDES = ,E15.8)
CCCCC CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *************************************
C               **  STEP 8--                       **
C               **  FORM THE PHASES AND PLOT THEM  **
C               *************************************
C
 1700 CONTINUE
      DO1750I=1,IMAX2
      Y2(I)=ATAN(Y2(I)/X2(I))
      X2(I)=I
      D2(I)=1.0
 1750 CONTINUE
      N2=IMAX2
      NPLOTV=2
C
CCCCC WRITE(ICOUT,1751)F
C1751 FORMAT(32X, 44HPHASE PLOT FOR THE DEMODULATION FREQUENCY = ,F8
CCCCC1.6,21H CYCLES PER UNIT TIME)
CCCCC CALL DPWRST('XXX','BUG ')
C
C     COMPUTE A NEW ESTIMATE FOR THE DEMODULATION FREQUENCY AND WRITE IT OUT
C
      AIMAX2=IMAX2
      IMAX2M=IMAX2-1
      IFLAG=0
      Y2MIN=Y2(1)
      Y2MAX=Y2(1)
      DO1800I=1,IMAX2M
      IP1=I+1
      DEL=Y2(IP1)-Y2(I)
      IF(DEL.GT.2.5)IFLAG=IFLAG-1
      IF(DEL.LT.-2.5)IFLAG=IFLAG+1
      AIFLAG=IFLAG
      Y2NEW=Y2(IP1)+AIFLAG*PI
      IF(Y2NEW.LT.Y2MIN)Y2MIN=Y2NEW
      IF(Y2NEW.GT.Y2MAX)Y2MAX=Y2NEW
 1800 CONTINUE
      RANGE=Y2MAX-Y2MIN
      SLOPER=RANGE/AIMAX2
      SLOPEH=SLOPER/(2.0*PI)
      FEST=F+SLOPEH
      DEMODF=FEST
CCCCC WRITE(ICOUT,2025)Y2MIN,Y2MAX,RANGE
C2025 FORMAT(3X,16HMINIMUM PHASE = ,E15.8,11H RADIANS   ,16HMAXIMUM
CCCCC1PHASE = ,E15.8,11H RADIANS   ,18HRANGE OF PHASES = ,E15.8,8H RADIA
CCCCC1NS)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2030)SLOPER,SLOPEH,FEST
C2030 FORMAT(8HSLOPE = ,E14.8,11H RADIANS = ,E14.6,52H CYCLES PER UN
CCCCC1IT TIME    EST. OF NEW DEMOD. FREQ. = ,E15.8,15H CYC./UNIT TIME)
CCCCC CALL DPWRST('XXX','BUG ')
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHAL(ICHAR2,ICHARN,IBUG,IFOUND)
C
C     PURPOSE--CONVERT AN ALPHABETIC CHARACTER
C              (A TO Z) INTO A NUMERIC VALUE
C              (1 TO 26).
C     INPUT  ARGUMENTS--ICHAR2 (A HOLLERITH VARIABLE
C                              CONTAINING THE HOLLERITH
C                              CHARACTER(S) OF INTEREST.
C     OUTPUT ARGUMENTS--ICHARN (AN INTEGER VARIABLE
C                              CONTAINING THE NUMERIC
C                              DESIGNATION FOR THE
C                              ALPHABETIC CHARACTER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IBUG
      CHARACTER*4 IFOUND
C
      CHARACTER*1 ICH1
      CHARACTER*1 ICH2
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
C
      ICH1='-'
      ICH2='-'
C
      ICH1N=(-999)
      ICH2N=(-999)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHAL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCHAL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4
   59 FORMAT('IBUGG4,ISUBG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  CONVERT THE CHARACTER       **
C               **********************************
C
      ICH2(1:1)=ICHAR2(2:2)
CCCCC ICH2N=ICHAR(ICH2)
      CALL DPCOAN(ICH2,ICH2N)
      IF(ICH2N.EQ.32)GOTO1100
      GOTO7900
C
 1100 CONTINUE
      ICH1(1:1)=ICHAR2(1:1)
CCCCC ICH1N=ICHAR(ICH1)
      CALL DPCOAN(ICH1,ICH1N)
      ICHARN=ICH1N-64
      IF(1.LE.ICHARN.AND.ICHARN.LE.26)GOTO8000
      GOTO7900
C
 7900 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7911)
C7911 FORMAT('***** ERROR IN DPCHAL--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7912)
C7912 FORMAT('      NO MATCH FOUND FOR INPUT CHARACTER.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7913)ICHAR
C7913 FORMAT('      INPUT CHARACTER = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
      IFOUND='NO'
      GOTO9000
C
 8000 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHAL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCHAL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICH1,ICH1N
 9012 FORMAT('ICH1,ICH1N = ',A1,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICH2,ICH2N
 9013 FORMAT('ICH2,ICH2N = ',A1,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICHAR2,ICHARN
 9014 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IFOUND
 9019 FORMAT('IBUGG4,ISUBG4,IFOUND = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCHAN(MAXCHA,ACHAAN,
     1IBUGP2,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER ANGLES FOR USE IN MULTI-TRACE PLOTS.
C              THE ANGLE FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE FLOATING POINT
C              VECTOR ACHAAN(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXCHA
C     OUTPUT ARGUMENTS--ACHAAN  (A  FLOATING POINT VECTOR
C                       WHOSE I-TH ELEMENT IS THE ANGLE
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --ACHAAN = CHARACTER ANGLE
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/11
C     ORIGINAL VERSION--NOVEMBER  1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC CHARACTER*4 IHARG        DECEMBER 1986
CCCCC CHARACTER*4 IARGT        DECEMBER 1986
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ICASEQ
      CHARACTER*4 IWRITE
C
C---------------------------------------------------------------------
C
CCCCC DIMENSION IHARG(*)       DECEMBER 1986
CCCCC DIMENSION IARGT(*)       DECEMBER 1986
CCCCC DIMENSION IARG(*)        DECEMBER 1986
CCCCC DIMENSION ARG(*)         DECEMBER 1986
C
      DIMENSION ACHAAN(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPCH'
      ISUBN2='AN  '
C
      IFOUND='NO'
      IERROR='NO'
C
 1100 CONTINUE
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ANGL')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'ANGL')GOTO1105
      GOTO9000
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'AUTO')GOTO3000
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      ACHAAN(I)=0.0
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ACHAAN(I)
 1116 FORMAT('ALL CHARACTER ANGLES HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO8000
C
 1120 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB')GOTO1180
      ACHAAN(1)=ARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,ACHAAN(I)
 1126 FORMAT('THE ANGLE FOR CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO8000
C
 1130 CONTINUE
      I=1
      IF(IARGT(3).NE.'NUMB')GOTO1180
      DO1135I=1,MAXCHA
      ACHAAN(I)=ARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ACHAAN(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO8000
C
 1140 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB')GOTO1180
      DO1145I=1,MAXCHA
      ACHAAN(I)=ARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ACHAAN(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO8000
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
      IP1=I+1
      IF(IARGT(IP1).NE.'NUMB')GOTO1180
      ACHAAN(I)=ARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,ACHAAN(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO8000
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      ACHAAN(I)=0.0
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ACHAAN(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO8000
C
 1180 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('***** ERROR IN DPCHAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('CHARACTER ANGLES MUST BE NUMERIC;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('HOWEVER, THE SPECIFIED CHARACTER ANGLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)I
 1184 FORMAT('FOR CHARACTER ',I6,' WAS NON-NUMERIC.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               ***********************************************************
C               **  STEP 30--                                            **
C               **  TREAT THE   CHARACTER ANGLE AUTOMATIC <VARIABLE>  CASE **
C               ***********************************************************
C
 3000 CONTINUE
C
C               ********************************************
C               **  STEP 31--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 3      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='31'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(3)
      IHLEF2=IHARG2(3)
      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 32--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='32'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO3290
      DO3200J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO3210
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO3210
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO3220
 3200 CONTINUE
      GOTO3290
 3210 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO3290
 3220 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO3290
 3290 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO3295
      WRITE(ICOUT,3291)NUMARG,ILOCQ
 3291 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 3295 CONTINUE
C
C               *********************************************
C               **  STEP 33--                              **
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='33'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO3310
      IF(ICASEQ.EQ.'SUBS')GOTO3320
      IF(ICASEQ.EQ.'FOR')GOTO3330
C
 3310 CONTINUE
      DO3315I=1,NLEFT
      ISUB(I)=1
 3315 CONTINUE
      NQ=NLEFT
      GOTO3350
C
 3320 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3350
C
 3330 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3350
C
 3350 CONTINUE
      MINN2=1
      IF(NQ.GE.MINN2)GOTO3360
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3351)
 3351 FORMAT('***** ERROR IN DPCHAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3352)
 3352 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3353)IHLEFT,IHLEF2
 3353 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3354)
 3354 FORMAT('      (FOR WHICH CHARACTER ANGLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3355)
 3355 FORMAT('      ARE TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3356)MINN2
 3356 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3357)
 3357 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3358)
 3358 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3359)(IANS(I),I=1,IWIDTH)
 3359 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3360 CONTINUE
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3370I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3370
      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
 3370 CONTINUE
      NS=J
      NY=J
C
C               *****************************************
C               **  STEP 34--                          **
C               **  EXTRACT THE DISTINCT VALUES        **
C               **  FROM THE TARGET VARIABLE Y(.)   .  **
C               **  STORE THEM IN X(.)   .             **
C               *****************************************
C
      IWRITE='OFF'
      CALL DISTIN(Y,NY,IWRITE,X,NX,IBUGP2,IERROR)
C
C               ***********************************
C               **  STEP 35--                    **
C               **  SORT THESE DISTINCT VALUES   **
C               **  (IN PLACE).                  **
C               ***********************************
C
      CALL SORT(X,NX,X)
C
C               ******************************************
C               **  STEP 36--                           **
C               **  COPY    THE NUMERIC VALUES IN X(.)  **
C               **  INTO INDIVIDUAL ELEMENTS            **
C               **  OF ACHAAN(.)                        **
C               **  NOTE--MAX NUMBER OF VALUES  = 100   **
C               ******************************************
C
      IMAX=NX
      IF(IMAX.GT.MAXCHA)IMAX=MAXCHA
      DO3650I=1,IMAX
      ACHAAN(I)=X(I)
 3650 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO3679
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO3675I=1,IMAX
      WRITE(ICOUT,3676)I,ACHAAN(I)
 3676 FORMAT('CHARACTER ANGLE ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 3675 CONTINUE
 3679 CONTINUE
      GOTO8000
C
 8000 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCHAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2
 9012 FORMAT('IBUGP2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMAX
 9014 FORMAT('IMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NY
 9021 FORMAT('NY = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NY.LE.0)GOTO9022
      DO9023I=1,NY
      WRITE(ICOUT,9024)I,Y(I)
 9024 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9023 CONTINUE
 9022 CONTINUE
      WRITE(ICOUT,9031)NX
 9031 FORMAT('NX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NX.LE.0)GOTO9032
      DO9033I=1,NX
      WRITE(ICOUT,9034)I,X(I)
 9034 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9033 CONTINUE
 9032 CONTINUE
      WRITE(ICOUT,9041)MAXCHA
 9041 FORMAT('MAXCHA = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NX.LE.0)GOTO9042
      DO9043I=1,NX
      WRITE(ICOUT,9044)I,ACHAAN(I)
 9044 FORMAT('I,ACHAAN(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9043 CONTINUE
 9042 CONTINUE
 9090 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHAR(MAXCHA,ICHAPA,ICHAPO,
CCCCC AUGMENT ARGUMENT LIST FEBRUARY 1998.
CCCCC SUBROUTINE DPCHAR(MAXCHA,ICHAPA,
     1IBUGP2,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTERS FOR USE IN MULTI-TRACE PLOTS.
C              THE CHARACTER FOR THE I-TH TRACE WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ICHAPA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXCHA
C     OUTPUT ARGUMENTS--ICHAPA  (A  HOLLERITH VECTOR
C                       WHOSE I-TH ELEMENT IS THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JULY      1983.
C     UPDATED         --NOVEMBER  1986.
C     UPDATED         --JANAURY   1988 (OMIT SORTING FOR CHAR AUTOMATIC)
C     UPDATED         --AUGUST    1987.    TUFTE BOX PLOT
C     UPDATED         --NOVEMBER  1988.    ERROR BAR PLOT
C     UPDATED         --JUNE      1989.    CHAR AUTOMATIC DISTINCT
C     UPDATED         --SEPTEMBER 1990.    AUGMENT CONTROL CHART
C     UPDATED         --NOVEMBER  1995. SUPPORT CASE ASIS
C     UPDATED         --FEBRUARY  1998. CHAR <SAVE/RESTORE>
C     UPDATED         --JANUARY   2001. CHAR AUTOMATIC SIGN
C     UPDATED         --FEBRUARY  2003. CHAR VIOLIN PLOT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC CHARACTER*4 IHARG       DECEMBER 1986
      CHARACTER*4 ICHAPA
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      CHARACTER*4 ICHAPO
      CHARACTER*4 IBUGP2
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ICASEQ
      CHARACTER*4 IWRITE
      CHARACTER*4 ICTEXT
      CHARACTER*4 ICTEX4
      CHARACTER*1 ICTEX1
      CHARACTER*4 ICHAP4
CCCCC FOLLOWING LINE JANAURY 2001
      CHARACTER*4 ISIGNF
C
C---------------------------------------------------------------------
C
CCCCC DIMENSION IHARG(*)      DECEMBER 1986
      DIMENSION ICHAPA(*)
CCCCC ADD FOLLOWING LINE FEBRUARY 1998.
      DIMENSION ICHAPO(*)
      DIMENSION ICTEXT(100)
C
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPCH'
      ISUBN2='AR  '
C
      IFOUND='NO'
      IERROR='NO'
C
 1100 CONTINUE
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FILL')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TYPE')GOTO9000
C
CCCCC ADD FOLLOWING 2 LINES ADDED FEBRUARY 1998.
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SAVE')GOTO2160
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'REST')GOTO2165
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BOX'.AND.IHARG(2).EQ.'PLOT')
     1GOTO2110
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'TUFT'.AND.
     1                   IHARG(2).EQ.'BOX'.AND.IHARG(3).EQ.'PLOT')
     1GOTO2140
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ERRO'.AND.
     1                   IHARG(2).EQ.'BAR'.AND.IHARG(3).EQ.'PLOT')
     1GOTO2150
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BOX'.AND.IHARG(3).EQ.'PLOT')
     1GOTO2110
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'I'.AND.IHARG(2).EQ.'PLOT')
     1GOTO2120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'I'.AND.IHARG(3).EQ.'PLOT')
     1GOTO2120
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'CONT'.AND.IHARG(2).EQ.'CHAR')
     1GOTO2130
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'CONT'.AND.IHARG(3).EQ.'CHAR')
     1GOTO2130
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'VIOL'.AND.IHARG(2).EQ.'PLOT')
     1GOTO2145
      IF(NUMARG.GE.4.AND.IHARG(1).EQ.'VIOL'.AND.
     1IHARG(2).EQ.'BOX'.AND.IHARG(4).EQ.'PLOT')
     1GOTO2148
      IF(NUMARG.GE.4.AND.IHARG(1).EQ.'VIOL'.AND.IHARG(2).EQ.'TUFT'
     1.AND.IHARG(3).EQ.'BOX'.AND.IHARG(4).EQ.'PLOT')
     1GOTO2145
C
      IF(NUMARG.LE.0)GOTO1160
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ALL')GOTO1160
C
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
C
      IF(NUMARG.EQ.1)GOTO1120
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'ALL')GOTO1140
C
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'SUBS'.AND.
     1IHARG2(2).EQ.'ET  ')GOTO4110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'EXCE'.AND.
     1IHARG2(2).EQ.'PT  ')GOTO4110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'FOR '.AND.
     1IHARG2(2).EQ.'    ')GOTO4120
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'AUTO')GOTO3000
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      ICHAPA(I)='X   '
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAPA(I)
 1116 FORMAT('ALL CHARACTERS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO8000
C
 1120 CONTINUE
      IF(NUMARG.EQ.0)ICHAPA(1)='    '
CCCCC NOVEMBER 1995.  SUPPORT CASE ASIS
CCCCC IF(NUMARG.GE.1)ICHAPA(1)=IHARG(1)
CCCCC IF(ICHAPA(1).EQ.'BOX')ICHAPA(1)='SQUA'
      IF(NUMARG.GE.1)THEN
        IF(IHARG(1).EQ.'BOX')THEN
          ICHAPA(1)='SQUA'
        ELSE
          ICHAPA(1)=IHARLC(1)
        ENDIF
      ENDIF
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,ICHAPA(I)
 1126 FORMAT('CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO8000
C
 1130 CONTINUE
      DO1135I=1,MAXCHA
CCCCC NOVEMBER 1995.  SUPPORT CASE ASIS
CCCCC ICHAPA(I)=IHARG(2)
CCCCC IF(ICHAPA(I).EQ.'BOX')ICHAPA(I)='SQUA'
      IF(IHARG(2).EQ.'BOX')THEN
        ICHAPA(I)='SQUA'
      ELSE
        ICHAPA(I)=IHARLC(2)
      ENDIF
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAPA(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO8000
C
 1140 CONTINUE
      DO1145I=1,MAXCHA
CCCCC NOVEMBER 1995.  SUPPORT CASE ASIS
CCCCC ICHAPA(I)=IHARG(1)
CCCCC IF(ICHAPA(I).EQ.'BOX')ICHAPA(I)='SQUA'
      IF(IHARG(1).EQ.'BOX')THEN
        ICHAPA(I)='SQUA'
      ELSE
        ICHAPA(I)=IHARLC(1)
      ENDIF
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAPA(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO8000
C
 1150 CONTINUE
      IMAX=NUMARG
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
CCCCC NOVEMBER 1995.  SUPPORT CASE ASIS
CCCCC ICHAPA(I)=IHARG(I)
CCCCC IF(ICHAPA(I).EQ.'BOX')ICHAPA(I)='SQUA'
      IF(IHARG(I).EQ.'BOX')THEN
        ICHAPA(I)='SQUA'
      ELSE
        ICHAPA(I)=IHARLC(I)
      ENDIF
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,ICHAPA(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO8000
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      ICHAPA(I)='    '
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAPA(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO8000
C
 2110 CONTINUE
      IMAX=24
      ICHAPA(1)='X'
      ICHAPA(2)=' '
      ICHAPA(3)=' '
      ICHAPA(4)='X'
      ICHAPA(5)=' '
      ICHAPA(6)=' '
      ICHAPA(7)='X'
      ICHAPA(8)=' '
      ICHAPA(9)=' '
      ICHAPA(10)=' '
      ICHAPA(11)=' '
      ICHAPA(12)=' '
      ICHAPA(13)=' '
      ICHAPA(14)=' '
      ICHAPA(15)=' '
      ICHAPA(16)=' '
      ICHAPA(17)=' '
      ICHAPA(18)=' '
      ICHAPA(19)=' '
      ICHAPA(20)=' '
      ICHAPA(21)='CIRC'
      ICHAPA(22)='CIRC'
      ICHAPA(23)='CIRC'
      ICHAPA(24)='CIRC'
      GOTO2170
C
 2120 CONTINUE
      IMAX=5
      ICHAPA(1)='-'
      ICHAPA(2)='X'
      ICHAPA(3)='-'
      ICHAPA(4)=' '
      ICHAPA(5)=' '
      GOTO2170
C
 2130 CONTINUE
CCCCC THE FOLLOWING SECTION WAS CHANGED SEPTEMBER 1990
      IMAX=7
      ICHAPA(1)='CIRC'
      ICHAPA(2)=' '
      ICHAPA(3)=' '
      ICHAPA(4)=' '
      ICHAPA(5)=' '
      ICHAPA(6)=' '
      ICHAPA(7)=' '
      GOTO2170
C
 2140 CONTINUE
      IMAX=24
      ICHAPA(1)=' '
      ICHAPA(2)=' '
      ICHAPA(3)=' '
      ICHAPA(4)='X'
      ICHAPA(5)=' '
      ICHAPA(6)=' '
      ICHAPA(7)=' '
      ICHAPA(8)=' '
      ICHAPA(9)=' '
      ICHAPA(10)=' '
      ICHAPA(11)=' '
      ICHAPA(12)=' '
      ICHAPA(13)=' '
      ICHAPA(14)=' '
      ICHAPA(15)=' '
      ICHAPA(16)=' '
      ICHAPA(17)=' '
      ICHAPA(18)=' '
      ICHAPA(19)=' '
      ICHAPA(20)=' '
      ICHAPA(21)='CIRC'
      ICHAPA(22)='CIRC'
      ICHAPA(23)='CIRC'
      ICHAPA(24)='CIRC'
      GOTO2170
C
 2145 CONTINUE
      IMAX=25
      ICHAPA(1)=' '
      ICHAPA(2)=' '
      ICHAPA(3)=' '
      ICHAPA(4)=' '
      ICHAPA(5)='X'
      ICHAPA(6)=' '
      ICHAPA(7)=' '
      ICHAPA(8)=' '
      ICHAPA(9)=' '
      ICHAPA(10)=' '
      ICHAPA(11)=' '
      ICHAPA(12)=' '
      ICHAPA(13)=' '
      ICHAPA(14)=' '
      ICHAPA(15)=' '
      ICHAPA(16)=' '
      ICHAPA(17)=' '
      ICHAPA(18)=' '
      ICHAPA(19)=' '
      ICHAPA(20)=' '
      ICHAPA(21)=' '
      ICHAPA(22)='CIRC'
      ICHAPA(23)='CIRC'
      ICHAPA(24)='CIRC'
      ICHAPA(25)='CIRC'
      GOTO2170
C
 2148 CONTINUE
      IMAX=25
      ICHAPA(1)=' '
      ICHAPA(2)='X'
      ICHAPA(3)=' '
      ICHAPA(4)=' '
      ICHAPA(5)='X'
      ICHAPA(6)=' '
      ICHAPA(7)=' '
      ICHAPA(8)='X'
      ICHAPA(9)=' '
      ICHAPA(10)=' '
      ICHAPA(11)=' '
      ICHAPA(12)=' '
      ICHAPA(13)=' '
      ICHAPA(14)=' '
      ICHAPA(15)=' '
      ICHAPA(16)=' '
      ICHAPA(17)=' '
      ICHAPA(18)=' '
      ICHAPA(19)=' '
      ICHAPA(20)=' '
      ICHAPA(21)=' '
      ICHAPA(22)='CIRC'
      ICHAPA(23)='CIRC'
      ICHAPA(24)='CIRC'
      ICHAPA(25)='CIRC'
      GOTO2170
C
 2150 CONTINUE
      IMAX=7
      ICHAPA(1)='CIRC'
      ICHAPA(2)='-'
      ICHAPA(3)='-'
      ICHAPA(4)='|'
      ICHAPA(5)='|'
      ICHAPA(6)=' '
      ICHAPA(7)=' '
      GOTO2170
C
 2160 CONTINUE
CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1998
      DO2163I=1,MAXCHA 
      ICHAPO(I)=ICHAPA(I)
 2163 CONTINUE
      IF(IFEEDB.EQ.'ON')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2164)
 2164 FORMAT('THE CURRENT CHARACTER SETTINGS HAVE BEEN SAVED.')
      CALL DPWRST('XXX','BUG ')
      ENDIF
      IFOUND='YES'
      GOTO9000
C
 2165 CONTINUE
CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1998
      DO2168I=1,MAXCHA 
      ICHAPA(I)=ICHAPO(I)
 2168 CONTINUE
      IF(IFEEDB.EQ.'ON')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2169)
 2169 FORMAT('THE SAVED CHARACTER SETTINGS HAVE BEEN RESTORED.')
      CALL DPWRST('XXX','BUG ')
      ENDIF
      IFOUND='YES'
      GOTO9000
C
 2170 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO2179
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO2175I=1,IMAX
      WRITE(ICOUT,2176)I,ICHAPA(I)
 2176 FORMAT('CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 2175 CONTINUE
 2179 CONTINUE
      GOTO8000
C
C               ***********************************************************
C               **  STEP 30--                                            **
C               **  TREAT THE    CHARACTERS AUTOMATIC <VARIABLE>   CASE  **
C               ***********************************************************
C
 3000 CONTINUE
C
C               ********************************************
C               **  STEP 31--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 2 (OR 3)**
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='31'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(2)
      IHLEF2=IHARG2(2)
CCCCC THE FOLLOWING 2 LINES WERE ADDED JUNE 1989
      IF(IHARG(2).EQ.'DIST'.AND.IHARG2(2).EQ.'INCT')IHLEFT=IHARG(3)
      IF(IHARG(2).EQ.'DIST'.AND.IHARG2(2).EQ.'INCT')IHLEF2=IHARG2(3)
CCCCC THE FOLLOWING 4 LINES WERE ADDED JANUARY 2001
      ISIGNF='OFF'
      IF(IHARG(2).EQ.'SIGN'.AND.IHARG2(2).EQ.'    ')ISIGNF='ON'
      IF(IHARG(2).EQ.'SIGN'.AND.IHARG2(2).EQ.'    ')IHLEFT=IHARG(3)
      IF(IHARG(2).EQ.'SIGN'.AND.IHARG2(2).EQ.'    ')IHLEF2=IHARG2(3)
      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 32--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='32'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO3290
      DO3200J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO3210
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO3210
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO3220
 3200 CONTINUE
      GOTO3290
 3210 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO3290
 3220 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO3290
 3290 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO3295
      WRITE(ICOUT,3291)NUMARG,ILOCQ
 3291 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 3295 CONTINUE
C
C               *********************************************
C               **  STEP 33--                              **
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='33'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO3310
      IF(ICASEQ.EQ.'SUBS')GOTO3320
      IF(ICASEQ.EQ.'FOR')GOTO3330
C
 3310 CONTINUE
      DO3315I=1,NLEFT
      ISUB(I)=1
 3315 CONTINUE
      NQ=NLEFT
      GOTO3350
C
 3320 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3350
C
 3330 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3350
C
 3350 CONTINUE
      MINN2=1
      IF(NQ.GE.MINN2)GOTO3360
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3351)
 3351 FORMAT('***** ERROR IN DPCHAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3352)
 3352 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3353)IHLEFT,IHLEF2
 3353 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3354)
 3354 FORMAT('      (FOR WHICH CHARACTER DEFINITIONS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3355)
 3355 FORMAT('      ARE TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3356)MINN2
 3356 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3357)
 3357 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3358)
 3358 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3359)(IANS(I),I=1,IWIDTH)
 3359 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3360 CONTINUE
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3370I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3370
      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)
CCCCC FOLLOWING BLOCK OF CODE JANUARY 2001
      IF(ISIGNF.EQ.'ON')THEN
        IF(Y(J).GT.0.0)THEN
          ICHAPA(J)='+   '
        ELSEIF(Y(J).LT.0.0)THEN
          ICHAPA(J)='-   '
        ELSEIF(Y(J).EQ.0.0)THEN
          ICHAPA(J)='0   '
        ELSE
          ICHAPA(J)='0   '
        ENDIF
      ENDIF
C
 3370 CONTINUE
      NS=J
      NY=J
CCCCC FOLLOWING LINE JANUARY 2001
      IF(ISIGNF.EQ.'ON')GOTO8000
C
C               *****************************************
C               **  STEP 34--                          **
C               **  IF HAVE THE FORM--                 **
C               **  CHARACTERS AUTOMATIC DISTINCT X    **
C               **  EXTRACT THE DISTINCT VALUES        **
C               **  FROM THE TARGET VARIABLE Y(.)   .  **
C               **  STORE THEM IN X(.)   .             **
C               **  IF HAVE THE FORM--                 **
C               **  CHARACTERS AUTOMATIC X             **
C               **  DO NOTHING                         **
C               *****************************************
C
CCCCC THE FOLLOWING SECTION WAS REWRITTEN JUNE 1989
      IF(IHARG(2).EQ.'DIST'.AND.IHARG2(2).EQ.'INCT')GOTO3420
C
 3410 CONTINUE
      DO3411I=1,NY
      X(I)=Y(I)
 3411 CONTINUE
      NX=NY
      GOTO3490
C
 3420 CONTINUE
      IWRITE='OFF'
      CALL DISTIN(Y,NY,IWRITE,X,NX,IBUGP2,IERROR)
      GOTO3490
C
 3490 CONTINUE
C
C               ***********************************
C               **  STEP 35--                    **
C               **  SORT THESE DISTINCT VALUES   **
C               **  (IN PLACE).                  **
C               ***********************************
C
CCCCC CALL SORT(X,NX,X)
C
C               ******************************************
C               **  STEP 36--                           **
C               **  CONVERT THE NUMERIC VALUES IN X(.)  **
C               **  TO CHARACTER STRINGS.               **
C               **  THEN LOAD THESE STRINGS             **
C               **  INTO INDIVIDUAL ELEMENTS            **
C               **  OF ICHAPA(.)                        **
C               **  NOTE--MAX CHARACTERS/STRING = 4     **
C               **        MAX NUMBER OF STRINGS = 100   **
C               ******************************************
C
      IMAX=NX
      IF(IMAX.GT.MAXCHA)IMAX=MAXCHA
      DO3650I=1,IMAX
      VAL=X(I)
      IVAL=VAL+0.5
      IF(VAL.LT.0.0)IVAL=VAL-0.5
      NUMDID=(-1)
      CALL DPCON2(IVAL,VAL,ICTEXT,NCTEXT,NUMDID,IBUGP2,IERROR)
      JMAX=NCTEXT
      IF(JMAX.GT.4)JMAX=4
      ICTEX4='    '
      ICTEX1=' '
      ICHAP4='    '
      DO3660J=1,JMAX
      ICTEX4=ICTEXT(J)
      ICTEX1=ICTEX4(1:1)
      ICHAP4(J:J)=ICTEX1
 3660 CONTINUE
      ICHAPA(I)=ICHAP4
 3650 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO3679
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO3675I=1,IMAX
      WRITE(ICOUT,3676)I,ICHAPA(I)
 3676 FORMAT('CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 3675 CONTINUE
 3679 CONTINUE
      GOTO8000
C
C               ***********************************************************
C               **  STEP 40--                                            **
C               **  TREAT THE CHARACTERS ... SUBSET/EXCEPT/FOR CASE      **
C               **  FOR REDEFINING SPECIFIED CHARACTERS                  **
C               ***********************************************************
C
 4000 CONTINUE
C
C               *****************************************
C               **  STEP 41--                          **
C               **  DEFINE THE TYPE CASE--             **
C               **    1) SUBSET/EXCEPT                 **
C               **    2) FOR.                          **
C               *****************************************
C
      ISTEPN='41'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 4110 CONTINUE
      ICASEQ='SUBS'
      GOTO4190
 4120 CONTINUE
      ICASEQ='FOR'
      GOTO4190
 4190 CONTINUE
      ILOCQ=2
      IF(IBUGP2.EQ.'OFF')GOTO4195
      WRITE(ICOUT,4191)ICASEQ,ILOCQ,NUMARG
 4191 FORMAT('ICASEQ,ILOCQ,NUMARG = ',3I8)
      CALL DPWRST('XXX','BUG ')
 4195 CONTINUE
C
C               *********************************************
C               **  STEP 42--                              **
C               **  DETERMINE WHICH ELEMENTS ARE           **
C               **  TO BE REDEFINED.                       **
C               *********************************************
C
      ISTEPN='42'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NQ=0
      IF(ICASEQ.EQ.'SUBS')GOTO4220
      IF(ICASEQ.EQ.'FOR')GOTO4230
      GOTO4250
C
 4220 CONTINUE
      NIOLD=MAXCHA
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4250
C
 4230 CONTINUE
      NIOLD=MAXCHA
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4250
C
 4250 CONTINUE
      IF(NQ.GE.1)GOTO4290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4251)
 4251 FORMAT('***** ERROR IN DPCHAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4252)
 4252 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4253)IHLEFT,IHLEF2
 4253 FORMAT('      EXTRACTED, NO CHARACTER ELEMENTS  ',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4254)
 4254 FORMAT('      REMAINED TO BE REDEFINED. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4255)ICASEQ
 4255 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4258)
 4258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH)
 4259 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4290 CONTINUE
C
C               *********************************************
C               **  STEP 43--                              **
C               **  REDEFINE THE DESIGNATED                **
C               **  CHARACTERS.                            **
C               *********************************************
C
      ISTEPN='43'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMAX=MAXCHA
      IF(NQ.LT.MAXCHA)IMAX=NQ
      DO4310I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4310
CCCCC NOVEMBER 1995.  SUPPORT CASE ASIS
CCCCC ICHAPA(I)=IHARG(1)
      ICHAPA(I)=IHARLC(1)
 4310 CONTINUE
C
C               *********************************************
C               **  STEP 44--                              **
C               **  IF CALLED FOR,                         **
C               **  PRINT OUT A MESSAGE.                   **
C               *********************************************
C
      ISTEPN='44'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFEEDB.EQ.'OFF')GOTO4490
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO4410I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4410
      WRITE(ICOUT,4411)I,ICHAPA(I)
 4411 FORMAT('CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 4410 CONTINUE
 4490 CONTINUE
      GOTO8000
C
 8000 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCHAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2
 9012 FORMAT('IBUGP2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMAX
 9014 FORMAT('IMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NY
 9021 FORMAT('NY = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NY.LE.0)GOTO9022
      DO9023I=1,NY
      WRITE(ICOUT,9024)I,Y(I)
 9024 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9023 CONTINUE
 9022 CONTINUE
      WRITE(ICOUT,9031)NX
 9031 FORMAT('NX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NX.LE.0)GOTO9032
      DO9033I=1,NX
      WRITE(ICOUT,9034)I,X(I)
 9034 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9033 CONTINUE
 9032 CONTINUE
      WRITE(ICOUT,9041)MAXCHA
 9041 FORMAT('MAXCHA = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NX.LE.0)GOTO9042
      DO9043I=1,NX
      WRITE(ICOUT,9044)I,ICHAPA(I)
 9044 FORMAT('I,ICHAPA(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9043 CONTINUE
 9042 CONTINUE
 9090 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHCA(IHARG,NUMARG,IDEFCA,MAXCHA,ICHACA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER CASES FOR USE IN MULTI-TRACE PLOTS.
C              THE CASE FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ICHACA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCA
C                     --MAXCHA
C     OUTPUT ARGUMENTS--ICHACA  (A  HOLLERITH VECTOR
C                       WHOSE I-TH ELEMENT IS THE CASE
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCA
      CHARACTER*4 ICHACA
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ICHACA(*)
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
 1100 CONTINUE
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'CASE')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'CASE')GOTO1105
      GOTO1199
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      ICHACA(I)=IDEFCA
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHACA(I)
 1116 FORMAT('ALL CHARACTER CASES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1190
C
 1120 CONTINUE
      ICHACA(1)=IHARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,ICHACA(I)
 1126 FORMAT('THE CASE FOR CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1190
C
 1130 CONTINUE
      DO1135I=1,MAXCHA
      ICHACA(I)=IHARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHACA(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1190
C
 1140 CONTINUE
      DO1145I=1,MAXCHA
      ICHACA(I)=IHARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHACA(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1190
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
      IP1=I+1
      ICHACA(I)=IHARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,ICHACA(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO1190
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      ICHACA(I)=IDEFCA
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHACA(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHCL(IHARG,NUMARG,IDEFCO,MAXCHA,ICHACO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER COLORS FOR USE IN MULTI-TRACE PLOTS.
C              THE COLOR FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ICHACO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C                     --MAXCHA
C     OUTPUT ARGUMENTS--ICHACO  (A  HOLLERITH VECTOR
C                       WHOSE I-TH ELEMENT IS THE COLOR
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCO
      CHARACTER*4 ICHACO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ICHACO(*)
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
 1100 CONTINUE
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COLO')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'COLO')GOTO1105
      GOTO1199
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      ICHACO(I)=IDEFCO
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHACO(I)
 1116 FORMAT('ALL CHARACTER COLORS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1190
C
 1120 CONTINUE
      ICHACO(1)=IHARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,ICHACO(I)
 1126 FORMAT('THE COLOR FOR CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1190
C
 1130 CONTINUE
      DO1135I=1,MAXCHA
      ICHACO(I)=IHARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHACO(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1190
C
 1140 CONTINUE
      DO1145I=1,MAXCHA
      ICHACO(I)=IHARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHACO(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1190
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
      IP1=I+1
      ICHACO(I)=IHARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,ICHACO(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO1190
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      ICHACO(I)=IDEFCO
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHACO(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHEC(K,IHOL,IHOL2,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1INT1,FLOAT1,IBUGA3,IERROR)
C
C     PURPOSE--EXAMINE COMPONENT K OF IHOL(.) AND IHOL2(.).
C     IF IT IS A PARAMETER NAME, DETERMINE THE VALUE
C     OF THE PARAMETER AND PLACE THIS VALUE
C     IN INT1(K) AND FLOAT1(K).
C     IF OTHERWISE, DO NOTHING.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHOL
      CHARACTER*4 IHOL2
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
C---------------------------------------------------------------------
C
      DIMENSION IHOL(*)
      DIMENSION IHOL2(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      DIMENSION INT1(*)
      DIMENSION FLOAT1(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('****** AT THE BEGINNING OF DPCHEC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)K,IHOL(K),IHOL2(K)
   52 FORMAT('K,IHOL(K),IHOL2(K) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMNAM,IBUGA3,IERROR
   53 FORMAT('NUMNAM,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMNAM
      WRITE(ICOUT,56)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
   56 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)K,INT1(K),FLOAT1(K)
   57 FORMAT('K,INT1(K),FLOAT1(K) = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IH=IHOL(K)
      IH2=IHOL2(K)
      IF(NUMNAM.LE.0)GOTO2799
      DO2795I=1,NUMNAM
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO2796
      GOTO2795
 2796 CONTINUE
      INT1(K)=IVALUE(I)
      FLOAT1(K)=VALUE(I)
      GOTO2799
 2795 CONTINUE
 2799 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('****** AT THE END       OF DPCHEC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)K,IHOL(K),IHOL2(K)
 9012 FORMAT('K,IHOL(K),IHOL2(K) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMNAM,IBUGA3,IERROR
 9013 FORMAT('NUMNAM,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMNAM
      WRITE(ICOUT,9016)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
 9016 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)K,INT1(K),FLOAT1(K)
 9017 FORMAT('K,INT1(K),FLOAT1(K) = ',I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCHEX(ISTAR1,ILEN1,IX1,ISTAR2,ILEN2,IX2)
C
C     PURPOSE--CHARACTER EXTRACTION--
C              GIVEN A CHARACTER STRING IN A WORD (IX1),
C              MOVE THE BIT STRING WHICH STARTS IN BIT ISTAR1
C              (ISTAR1 RANGES FROM 0 TO 35 IN A UNIVAC 1108,
C                                  0 TO 31 IN AN IBM 3033,
C                                  0 TO 59 IN A CDC 7600, ETC.
C              AND IS OF LENGTH ILEN1 BITS)
C              INTO BITS STARTING AT ISTAR2 OF LENGTH ILEN2
C              (HERE ILEN2 USUALLY = ILEN1) IN THE WORD IX2.
C              OUTPUT THE NEW CHARACTER VARIABLE (IX2).
C     NOTE--0 DENOTES THE LEFT-MOST (THAT IS, THE HIGH-ORDER) BIT.
C     NOTE--ISTAR1 AND ISTAR2 RANGE FROM 0 TO NUMBPW-1
C           THAT IS, FROM 0 TO ONE LESS THAN THE TOTLA NUMBER OF BITS PER WORD.
C           (FOR EXAMPLE, ON UNIVAC 1100/82--FROM 0 TO 35
C                         ON VAX    11/780 --FROM 0 TO 31)
C     NOTE--IX1 AND IX2 ARE CHARACTER*4 VARIABLES.
C     NOTE--THIS SUBROUTINE HAS BEEN CONSTRAINED SO THAT
C           NEITHER ILEN1 NOR ILEN2 ARE EXPLICITELY USED.
C           THIS SUBROUTINE, AS CODED, OPERATES ON THE ASSUMPTIONS THAT
C              1) ILEN1 = NUMBPC (THAT IS, THE LENGTH
C                 OF THE BIT STRING BEING MOVED IS IDENTICAL
C                 TO THE NUMBER OF BITS PER CHARACTER ON
C                 YOUR COMPUTER).
C              2) ILEN2 = ILEN1 (THAT IS, THE LENGTH OF THE OUTPUT STRING =
C                 THE LENGTH OF THE INPUT STRING),
C              3) ISTAR1 IS SUCH THAT THE START OF THE BIT STRING
C                 IS ALWAYS AT THE BEGINNING OF A CHARACTER
C           THE NET RESULT IS THAT THIS SUBROUTINE, AS CODED,
C           EXTRACTS EXACTLY 1 CHARACTER AND
C           MOVES IT TO THE POSITION OF ANOTHER CHARACTER.
C           THESE CONSTRAINTS WILL BE ACCEPTABLE FOR ALL USES
C           OF THIS SUBROUTINE BY ANY OTHER DATAPLOT SUBROUTINE.
C     NOTE--THE VALUES FOR NUMBPC (NUMBER OF BITS PER CHARACTER)
C           AND NUMBPW (NUMBER OF BITS PER WORD) ARE SET
C           FOR YOUR COMPUTER IN DATAPLOT SUBROUTINE INITMC.
C     NOTE--ALGORITHM PROVIDED BY MICHAEL VOGT
C                                 CENTER FOR APPLIED MATHEMATICS
C                                 NATIONAL BUREAU OF STANDARDS
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--OCTOBER  1978.
C     UPDATED         --JUNE      1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IX1
      CHARACTER*4 IX2
C
C---------------------------------------------------------------------
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C               ****************************************************************
C               **  THE FOLLOWING CODE WILL CARRY OUT
C               **  THE CHARACTER EXTRACTION FOR ALL COMPUTERS
C               **  WITH AN ANSI 77 FORTRAN COMPILER--IT MAKES
C               **  USE OF THE ANSI FORTRAN 77 CONSTRUCT--
C               **  IY(IC:ID)=IX(IA:IB)
C               **  WHERE IX AND IY ARE CHARACTER*4 VARIABLES,
C               **  WHERE IA, IB, IC, AND ID ARE INTEGER VARIABLES,
C               **  AND WHERE IY(IC:ID)=IX(IA:IB) MEANS
C               **  TO COPY CHARACTERS IA THROUGH IB OF VARIABLE IX AND
C               **  PLACE THEM INTO CHARACTERS IC THROUGH ID OF VARIABLE IY.
C               **  WITH ALL OTHER CHARACTERS IN IY BEING UNAFFECTED.
C               **  USUALLY IA, IB, IC, AND ID RANGE FROM 1 TO 4.
C               ****************************************************************
C
      IBYTE1=(ISTAR1+NUMBPC)/NUMBPC
      IBYTE2=(ISTAR2+NUMBPC)/NUMBPC
      IX2(IBYTE2:IBYTE2)=IX1(IBYTE1:IBYTE1)
      GOTO9000
C
C               ****************************************************************
C               **  CHARACTER EXTRACTION FOR THE UNIVAC 1100 SERIES. FOR COMPILE
C               **  (FORTRAN 1966 COMPILER)
C               ****************************************************************
C
CCCCC ISTAR1=IABS(ISTAR1)
CCCCC ISTAR2=IABS(ISTAR2)
C
CCCCC FLD(ISTAR2,ILEN2,IX2)=FLD(ISTAR1,ILEN1,IX1)
C
C               ****************************************************************
C               **  CHARACTER EXTRACTION FOR THE UNIVAC 1100 SERIES. FTN COMPILE
C               **  (FORTRAN 1977 COMPILER)
C               ****************************************************************
C
CCCCC ISTR1P=ISTAR1+1
CCCCC ISTR2P=ISTAR2+1
C
CCCCC BITS(IX2,ISTR2P,ILEN2)=BITS(IX1,ISTR1P,ILEN1)
C
C               ***********************************************
C               **  CHARACTER EXTRACTION FOR THE VAX-11/780  **
C               **  (FORTRAN 1966 COMPILER)
C               ***********************************************
C
CCCCC LOGICAL*1 IX1(4)
CCCCC LOGICAL*1 IX2(4)
C
CCCCC I1=(ISTAR1+8)/8
CCCCC I2=(ISTAR2+8)/8
CCCCC IX2(I2)=IX1(I1)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHFI(IHARG,NUMARG,IDEFFI,MAXCHA,ICHAFI,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER FILL SWITCH FOR USE IN MULTI-TRACE PLOTS.
C              THE FILL SWITCH FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ICHAFI(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFI
C                     --MAXCHA
C     OUTPUT ARGUMENTS--ICHAFI  (A  HOLLERITH VECTOR
C                       WHOSE I-TH ELEMENT IS THE FILL SWITCH
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1998. CHECK FOR CHARCTER FILL COLOR
C                                       (SKIP IF ABOVE FOUND)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFFI
      CHARACTER*4 ICHAFI
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ICHAFI(*)
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
 1100 CONTINUE
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'FILL')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FILL')GOTO1105
      GOTO1199
C
 1105 CONTINUE
CCCCC IF(IHARG(NUMARG).EQ.'ON')GOTO1110
CCCCC IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
CCCCC ADD FOLLOWING LINE  JUNE 1998
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1199
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      ICHAFI(I)=IDEFFI
      IF(IHARG(NUMARG).EQ.'ON')ICHAFI(I)='ON'
      IF(IHARG(NUMARG).EQ.'OFF')ICHAFI(I)='OFF'
      IF(IHARG(NUMARG).EQ.'AUTO')ICHAFI(I)='ON'
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAFI(I)
 1116 FORMAT('ALL CHARACTER FILL SWITCHES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1190
C
 1120 CONTINUE
      ICHAFI(1)=IHARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,ICHAFI(I)
 1126 FORMAT('THE FILL SWITCH FOR CHARACTER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1190
C
 1130 CONTINUE
      DO1135I=1,MAXCHA
      ICHAFI(I)=IHARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAFI(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1190
C
 1140 CONTINUE
      DO1145I=1,MAXCHA
      ICHAFI(I)=IHARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAFI(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1190
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
      IP1=I+1
      ICHAFI(I)=IHARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,ICHAFI(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO1190
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      ICHAFI(I)=IDEFFI
      IF(IHARG(1).EQ.'ON')ICHAFI(I)='ON'
      IF(IHARG(1).EQ.'OFF')ICHAFI(I)='OFF'
      IF(IHARG(1).EQ.'AUTO')ICHAFI(I)='ON'
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'FILL')ICHAFI(I)='ON'
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAFI(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHFO(IHARG,NUMARG,IDEFFO,MAXCHA,ICHAFO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER FONTS FOR USE IN MULTI-TRACE PLOTS.
C              THE FONT FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ICHAFO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFO
C                     --MAXCHA
C     OUTPUT ARGUMENTS--ICHAFO  (A  HOLLERITH VECTOR
C                       WHOSE I-TH ELEMENT IS THE FONT
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFFO
      CHARACTER*4 ICHAFO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ICHAFO(*)
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
 1100 CONTINUE
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'FONT')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FONT')GOTO1105
      GOTO1199
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      ICHAFO(I)=IDEFFO
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAFO(I)
 1116 FORMAT('ALL CHARACTER FONTS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1190
C
 1120 CONTINUE
      ICHAFO(1)=IHARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,ICHAFO(I)
 1126 FORMAT('THE FONT FOR CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1190
C
 1130 CONTINUE
      DO1135I=1,MAXCHA
      ICHAFO(I)=IHARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAFO(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1190
C
 1140 CONTINUE
      DO1145I=1,MAXCHA
      ICHAFO(I)=IHARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAFO(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1190
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
      IP1=I+1
      ICHAFO(I)=IHARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,ICHAFO(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO1190
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      ICHAFO(I)=IDEFFO
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAFO(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHGR(ICHAR2,ICHARN,IBUG,IFOUND)
C
C     PURPOSE--NUMERICALLY CONVERT A GREEK ALPHABETIC CHARACTER.
C              CONVERT A PACKED ALPHABETIC STRING
C              (PACKED INTO 1 COMPUTER WORD
C              WITH ONLY THE FIRST 4 CHARACTERS BEING SIGNIFICANT)
C              (ALPH... TO OMEG...) INTO A NUMERIC VALUE
C              (1 TO 24).
C     INPUT  ARGUMENTS--ICHAR2 (A HOLLERITH VARIABLE
C                              CONTAINING THE HOLLERITH
C                              CHARACTER(S) OF INTEREST.
C     OUTPUT ARGUMENTS--ICHARN (AN INTEGER VARIABLE
C                              CONTAINING THE NUMERIC
C                              DESIGNATION FOR THE
C                              ALPHABETIC CHARACTER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IBUG
      CHARACTER*4 IFOUND
C
C-----COMMON VARIABLES (BUGS & ERROR)-------------------------------------------
C
      CHARACTER*4 IBUGG4
      CHARACTER*4 ISUBG4
      CHARACTER*4 IERRG4
C
      COMMON /ICOMBE/IBUGG4,ISUBG4,IERRG4
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'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHGR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCHGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4
   59 FORMAT('IBUGG4,ISUBG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  CONVERT THE CHARACTER       **
C               **********************************
C
      IF(ICHAR2.EQ.'ALPH')GOTO100
      IF(ICHAR2.EQ.'BETA')GOTO200
      IF(ICHAR2.EQ.'GAMM')GOTO300
      IF(ICHAR2.EQ.'DELT')GOTO400
      IF(ICHAR2.EQ.'EPSI')GOTO500
      IF(ICHAR2.EQ.'ZETA')GOTO600
      IF(ICHAR2.EQ.'ETA')GOTO700
      IF(ICHAR2.EQ.'THET')GOTO800
      IF(ICHAR2.EQ.'IOTA')GOTO900
      IF(ICHAR2.EQ.'KAPP')GOTO1000
      IF(ICHAR2.EQ.'LAMB')GOTO1100
      IF(ICHAR2.EQ.'MU')GOTO1200
      IF(ICHAR2.EQ.'NU')GOTO1300
      IF(ICHAR2.EQ.'XI')GOTO1400
      IF(ICHAR2.EQ.'OMIC')GOTO1500
      IF(ICHAR2.EQ.'PI')GOTO1600
      IF(ICHAR2.EQ.'RHO')GOTO1700
      IF(ICHAR2.EQ.'SIGM')GOTO1800
      IF(ICHAR2.EQ.'TAU')GOTO1900
      IF(ICHAR2.EQ.'UPSI')GOTO2000
      IF(ICHAR2.EQ.'PHI')GOTO2100
      IF(ICHAR2.EQ.'CHI')GOTO2200
      IF(ICHAR2.EQ.'PSI')GOTO2300
      IF(ICHAR2.EQ.'OMEG')GOTO2400
      GOTO7900
C
  100 CONTINUE
      ICHARN=1
      GOTO8000
C
  200 CONTINUE
      ICHARN=2
      GOTO8000
C
  300 CONTINUE
      ICHARN=3
      GOTO8000
C
  400 CONTINUE
      ICHARN=4
      GOTO8000
C
  500 CONTINUE
      ICHARN=5
      GOTO8000
C
  600 CONTINUE
      ICHARN=6
      GOTO8000
C
  700 CONTINUE
      ICHARN=7
      GOTO8000
C
  800 CONTINUE
      ICHARN=8
      GOTO8000
C
  900 CONTINUE
      ICHARN=9
      GOTO8000
C
 1000 CONTINUE
      ICHARN=10
      GOTO8000
C
 1100 CONTINUE
      ICHARN=11
      GOTO8000
C
 1200 CONTINUE
      ICHARN=12
      GOTO8000
C
 1300 CONTINUE
      ICHARN=13
      GOTO8000
C
 1400 CONTINUE
      ICHARN=14
      GOTO8000
C
 1500 CONTINUE
      ICHARN=15
      GOTO8000
C
 1600 CONTINUE
      ICHARN=16
      GOTO8000
C
 1700 CONTINUE
      ICHARN=17
      GOTO8000
C
 1800 CONTINUE
      ICHARN=18
      GOTO8000
C
 1900 CONTINUE
      ICHARN=19
      GOTO8000
C
 2000 CONTINUE
      ICHARN=20
      GOTO8000
C
 2100 CONTINUE
      ICHARN=21
      GOTO8000
C
 2200 CONTINUE
      ICHARN=22
      GOTO8000
C
 2300 CONTINUE
      ICHARN=23
      GOTO8000
C
 2400 CONTINUE
      ICHARN=24
      GOTO8000
C
 7900 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7911)
C7911 FORMAT('***** ERROR IN DPCHNU--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7912)
C7912 FORMAT('      NO MATCH FOUND FOR INPUT CHARACTER.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7913)ICHAR2
C7913 FORMAT('      INPUT CHAR2ACTER = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
      IFOUND='NO'
      GOTO9000
C
 8000 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHGR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCHGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND
 9012 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IFOUND
 9019 FORMAT('IBUGG4,ISUBG4,IFOUND = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCHHW(IHARG,IARGT,IARG,ARG,NUMARG,
     1MAXCHA,
     1PCHAHE,PCHAWI,PDEFHE,PDEFWI,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER HEIGHT AND WIDTH
C              FOR USE IN MULTI-TRACE PLOTS.
C              THE HEIGHT AND WIDTH FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE FLOATING POINT
C              VECTORS PCHAHE(.) AND PCHAWI(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXCHA
C     OUTPUT ARGUMENTS--PCHAHE  (A  FLOATING POINT VECTOR
C                       WHOSE I-TH ELEMENT IS THE HEIGHT
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --PCHAWI  (A  FLOATING POINT VECTOR
C                       WHOSE I-TH ELEMENT IS THE WIDTH
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --PDEFHE  = DEFAULT CHARACTER HEIGHT
C                     --PDEFWI  = DEFAULT CHARACTER WIDTH
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/8
C     ORIGINAL VERSION--AUGUST    1988.
C     UPDATED         --JANUARY   1995. ALLOW ? AS ARGUMENT (FOR HELP)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PCHAHE(*)
      DIMENSION PCHAWI(*)
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
 1100 CONTINUE
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'HW')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'HW')GOTO1105
      GOTO9000
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
      IF(IHARG(NUMARG).EQ.'?')GOTO1200
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.3)GOTO1120
      IF(NUMARG.GE.4.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      PCHAWI(I)=PDEFHE
      PCHAHE(I)=PDEFWI
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)
 1116 FORMAT('THE HEIGHTS AND WIDTHS OF ALL CHARACTERS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)PCHAHE(I),PCHAWI(I)
 1117 FORMAT('    HAVE JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO2190
C
 1120 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB'.OR.IARGT(3).NE.'NUMB')GOTO1180
      PCHAHE(1)=ARG(2)
      PCHAWI(1)=ARG(3)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I
 1126 FORMAT('THE HEIGHT AND WIDTH OF CHARACTER ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)PCHAHE(I),PCHAWI(I)
 1127 FORMAT('    HAS JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO2190
C
 1130 CONTINUE
      I=1
      IF(IARGT(3).NE.'NUMB'.OR.IARGT(4).NE.'NUMB')GOTO1180
      DO1135I=1,MAXCHA
      PCHAHE(I)=ARG(3)
      PCHAWI(I)=ARG(4)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)PCHAHE(I),PCHAWI(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO2190
C
 1140 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB'.OR.IARGT(3).NE.'NUMB')GOTO1180
      DO1145I=1,MAXCHA
      PCHAHE(I)=ARG(2)
      PCHAWI(I)=ARG(3)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)PCHAHE(I),PCHAWI(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO2190
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      J=0
      DO1155I=1,IMAX,2
      IP1=I+1
      IP2=I+2
      IF(IARGT(IP1).NE.'NUMB')GOTO1180
      IF(IARGT(IP2).NE.'NUMB')GOTO1180
      J=J+1
      PCHAHE(J)=ARG(IP1)
      PCHAWI(J)=ARG(IP2)
 1155 CONTINUE
      JMAX=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,JMAX
      WRITE(ICOUT,1126)I
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)PCHAHE(I),PCHAWI(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO2190
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      PCHAHE(I)=PDEFHE
      PCHAWI(I)=PDEFWI
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)PCHAHE(I),PCHAWI(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO2190
C
 1180 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('***** ERROR IN DPCHHW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('THE HEIGHTS AND WIDTHS OF CHARACTERS MUST BE NUMERIC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('HOWEVER, THE SPECIFIED CHARACTER HEIGHT AND WIDTH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)I
 1184 FORMAT('FOR CHARACTER ',I6,' WAS NON-NUMERIC.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED    JANUARY 1995
 1200 CONTINUE
      IFOUND='YES'
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1221)I,PCHAHE(I)
 1221 FORMAT('THE CURRENT HEIGHT FOR CHARACTER ',I6,' IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)I,PCHAWI(I)
 1222 FORMAT('THE CURRENT WIDTH  FOR CHARACTER ',I6,' IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)I,PDEFHE
 1223 FORMAT('THE DEFAULT HEIGHT FOR CHARACTER ',I6,' IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1224)I,PDEFWI
 1224 FORMAT('THE DEFAULT WIDTH  FOR CHARACTER ',I6,' IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO9000
C
 2190 CONTINUE
      IFOUND='YES'
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHJU(IHARG,NUMARG,MAXCHA,ICHAJU,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER JUSTIFICATION FOR USE IN MULTI-TRACE PLOTS.
C              THE JUSTIFICATION FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ICHAJU(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXCHA
C     OUTPUT ARGUMENTS--ICHAJU  (A  HOLLERITH VECTOR
C                       WHOSE I-TH ELEMENT IS THE JUSTIFICATION
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 ICHAJU
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ICHAJU(*)
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
 1100 CONTINUE
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'JUST')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'JUST')GOTO1105
      GOTO1199
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      ICHAJU(I)='CENT'
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAJU(I)
 1116 FORMAT('ALL CHARACTER JUSTIFICATIONS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1190
C
 1120 CONTINUE
      ICHAJU(1)=IHARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,ICHAJU(I)
 1126 FORMAT('THE JUSTIFICATION FOR CHARACTER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1190
C
 1130 CONTINUE
      DO1135I=1,MAXCHA
      ICHAJU(I)=IHARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAJU(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1190
C
 1140 CONTINUE
      DO1145I=1,MAXCHA
      ICHAJU(I)=IHARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAJU(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1190
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
      IP1=I+1
      ICHAJU(I)=IHARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,ICHAJU(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO1190
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      ICHAJU(I)='CENT'
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)ICHAJU(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHLI(ICONT,NUMCPL,YSTART,YSTOP,XSTART,XSTOP,
     1J,JD,Y2,X2,D2,IERROR)
C
C     PURPOSE--GENERATE PLOT COORDINATES FOR A POINT
C              OR FOR A LINE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICONT
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
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
      IERROR='NO'
C
      NUMCP2=NUMCPL
      IF(ICONT.EQ.'ON')NUMCP2=2
      ANUMC2=NUMCP2
C
      IF(YSTART.EQ.YSTOP)GOTO200
      IF(XSTART.EQ.XSTOP)GOTO1300
      GOTO1400
C
  200 CONTINUE
      IF(XSTART.EQ.XSTOP)GOTO1100
      GOTO1200
C
C               ***************************
C               **  STEP 2.1--           **
C               **  TREAT THE CASE WHEN  **
C               **  Y HAS NO CHANGE      **
C               **  X HAS NO CHANGE      **
C               ***************************
C
 1100 CONTINUE
      J=J+1
      JD=JD+1
      Y2(J)=YSTART
      X2(J)=XSTART
      D2(J)=JD
      GOTO9000
C
C               ***************************
C               **  STEP 2.2--           **
C               **  TREAT THE CASE WHEN  **
C               **  Y HAS NO CHANGE      **
C               **  X HAS    CHANGE      **
C               ***************************
C
 1200 CONTINUE
      JD=JD+1
      XDEL=XSTOP-XSTART
      DO1210I=1,NUMCP2
      J=J+1
      AI=I
      P=(AI-1.0)/(ANUMC2-1.0)
      XP=XSTART+P*XDEL
      Y2(J)=YSTART
      X2(J)=XP
      D2(J)=JD
 1210 CONTINUE
      GOTO9000
C
C               ***************************
C               **  STEP 2.3--           **
C               **  TREAT THE CASE WHEN  **
C               **  Y HAS    CHANGE      **
C               **  X HAS NO CHANGE      **
C               ***************************
C
 1300 CONTINUE
      JD=JD+1
      YDEL=YSTOP-YSTART
      DO1310I=1,NUMCP2
      J=J+1
      AI=I
      P=(AI-1.0)/(ANUMC2-1.0)
      YP=YSTART+P*YDEL
      Y2(J)=YP
      X2(J)=XSTART
      D2(J)=JD
 1310 CONTINUE
      GOTO9000
C
C               ***************************
C               **  STEP 2.4--           **
C               **  TREAT THE CASE WHEN  **
C               **  Y HAS    CHANGE      **
C               **  X HAS    CHANGE      **
C               ***************************
C
 1400 CONTINUE
      JD=JD+1
      XDEL=XSTOP-XSTART
      YDEL=YSTOP-YSTART
      DO1410I=1,NUMCP2
      J=J+1
      AI=I
      P=(AI-1.0)/(ANUMC2-1.0)
      XP=XSTART+P*XDEL
      YP=YSTART+P*YDEL
      Y2(J)=YP
      X2(J)=XP
      D2(J)=JD
 1410 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUG,IERROR)
C
C     PURPOSE--CHECK FOR A LEFT AND RIGHT PARENTHESIS.
C              CHECK FOR A LEFT  PARENTHESIS IN LOCATION ILOCLP.
C              CHECK FOR A RIGHT PARENTHESIS IN LOCATION ILOCRP.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --FEBRUARY  1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISTRIN
      CHARACTER*4 IFOULR
      CHARACTER*4 IBUG
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION ISTRIN(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOULR='NO'
      IERROR='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHLR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCHLR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NUMCHS,ILOCLP,ILOCRP
   52 FORMAT('NUMCHS,ILOCLP,ILOCRP = ',I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)(ISTRIN(I),I=1,NUMCHS)
   53 FORMAT('(ISTRIN(I),I=1,NUMCHS) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IF(ILOCLP.LT.1)GOTO1200
      IF(ILOCLP.GT.NUMCHS)GOTO1200
C
      IF(ILOCRP.LT.1)GOTO1200
      IF(ILOCRP.GT.NUMCHS)GOTO1200
C
      IF(ISTRIN(ILOCLP).NE.'(')GOTO1200
      IF(ISTRIN(ILOCRP).NE.')')GOTO1200
C
 1100 CONTINUE
      IFOULR='YES'
      GOTO9000
C
 1200 CONTINUE
      IFOULR='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHLR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END      OF DPCHLR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOULR
 9012 FORMAT('IFOULR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCHMA(ICHAR2,ICHARN,IBUG,IFOUND)
C
C     PURPOSE--CONVERT A MATHEMATICAL SYMBOL
C              INTO A NUMERIC VALUE
C              (1 TO 66).
C     INPUT  ARGUMENTS--ICHAR2 (A HOLLERITH VARIABLE
C                              CONTAINING THE HOLLERITH
C                              CHARACTER(S) OF INTEREST.
C     OUTPUT ARGUMENTS--ICHARN (AN INTEGER VARIABLE
C                              CONTAINING THE NUMERIC
C                              DESIGNATION FOR THE
C                              ALPHABETIC CHARACTER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     1987.
C     UPDATED         --AUGUST    1992.  ADD SYNONYMS FOR REVERSE
C                                        TRIANGLE (TO AGREE WITH
C                                        DOCUMENTATION), ADD ARROW CASE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IBUG
      CHARACTER*4 IFOUND
C
      CHARACTER*1 IBASLC
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHMA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCHMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4
   59 FORMAT('IBUGG4,ISUBG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  CONVERT THE CHARACTER       **
C               **********************************
C
      IF(ICHAR2.EQ.'/   ')GOTO100
      IF(ICHAR2.EQ.'(   ')GOTO200
      IF(ICHAR2.EQ.')   ')GOTO300
      IF(ICHAR2.EQ.'[   ')GOTO400
      IF(ICHAR2.EQ.'LBRA')GOTO400
      IF(ICHAR2.EQ.']   ')GOTO500
      IF(ICHAR2.EQ.'RBRA')GOTO500
      IF(ICHAR2.EQ.'{   ')GOTO600
      IF(ICHAR2.EQ.'LCBR')GOTO600
      IF(ICHAR2.EQ.'}   ')GOTO700
      IF(ICHAR2.EQ.'RCBR')GOTO700
      IF(ICHAR2.EQ.'LELB')GOTO800
      IF(ICHAR2.EQ.'RELB')GOTO900
      IF(ICHAR2.EQ.'|   ')GOTO1000
      IF(ICHAR2.EQ.'VBAR')GOTO1000
      IF(ICHAR2.EQ.':   ')GOTO1100
      IF(ICHAR2.EQ.'DVBA')GOTO1100
      IF(ICHAR2.EQ.'COLO')GOTO1100
      IF(ICHAR2.EQ.'-   ')GOTO1200
      IF(ICHAR2.EQ.'MINU')GOTO1200
      IF(ICHAR2.EQ.'+   ')GOTO1300
      IF(ICHAR2.EQ.'PLUS')GOTO1300
      IF(ICHAR2.EQ.'CROS')GOTO1300
      IF(ICHAR2.EQ.'+-  ')GOTO1400
      IF(ICHAR2.EQ.'-+  ')GOTO1500
      IF(ICHAR2.EQ.'TIME')GOTO1600
      IF(ICHAR2.EQ.'DOTP')GOTO1700
      IF(ICHAR2.EQ.'/   ')GOTO1800
      IF(ICHAR2.EQ.'DIVI')GOTO1800
      IF(ICHAR2.EQ.'SLAS')GOTO1800
      IF(ICHAR2.EQ.'=   ')GOTO1900
      IF(ICHAR2.EQ.'EQUA')GOTO1900
      IF(ICHAR2.EQ.'NOT=')GOTO2000
      IF(ICHAR2.EQ.'<>')GOTO2000
      IF(ICHAR2.EQ.'><')GOTO2000
      IF(ICHAR2.EQ.'EQUI')GOTO2100
      IF(ICHAR2.EQ.'<   ')GOTO2200
      IF(ICHAR2.EQ.'LT  ')GOTO2200
      IF(ICHAR2.EQ.'>   ')GOTO2300
      IF(ICHAR2.EQ.'GT  ')GOTO2300
      IF(ICHAR2.EQ.'<=  ')GOTO2400
      IF(ICHAR2.EQ.'=<  ')GOTO2400
      IF(ICHAR2.EQ.'LTEQ')GOTO2400
      IF(ICHAR2.EQ.'>=  ')GOTO2500
      IF(ICHAR2.EQ.'=>  ')GOTO2500
      IF(ICHAR2.EQ.'GTEQ')GOTO2500
      IF(ICHAR2.EQ.'VARI')GOTO2600
      IF(ICHAR2.EQ.'APPR')GOTO2700
      IF(ICHAR2.EQ.'~   ')GOTO2700
      IF(ICHAR2.EQ.'TILD')GOTO2700
      IF(ICHAR2.EQ.'CARA')GOTO2800
      IF(ICHAR2.EQ.'PRIM')GOTO2900
      IF(ICHAR2.EQ.'`   ')GOTO3000
      IF(ICHAR2.EQ.'LACC')GOTO3000
      IF(ICHAR2.EQ.'BREV')GOTO3100
      IF(ICHAR2.EQ.'RQUO')GOTO3200
      IF(ICHAR2.EQ.'LQUO')GOTO3300
      IF(ICHAR2.EQ.'NASP')GOTO3400
      IF(ICHAR2.EQ.'IASP')GOTO3500
      IF(ICHAR2.EQ.'RADI')GOTO3600
      IF(ICHAR2.EQ.'SUBS')GOTO3700
      IF(ICHAR2.EQ.'UNIO')GOTO3800
      IF(ICHAR2.EQ.'SUPE')GOTO3900
      IF(ICHAR2.EQ.'INTR')GOTO4000
      IF(ICHAR2.EQ.'ELEM')GOTO4100
      IF(ICHAR2.EQ.'RARR')GOTO4200
      IF(ICHAR2.EQ.'^   ')GOTO4300
      IF(ICHAR2.EQ.'UARR')GOTO4300
      IF(ICHAR2.EQ.'LARR')GOTO4400
      IF(ICHAR2.EQ.'DARR')GOTO4500
      IF(ICHAR2.EQ.'PART')GOTO4600
      IF(ICHAR2.EQ.'DEL ')GOTO4700
      IF(ICHAR2.EQ.'LRAD')GOTO4800
      IF(ICHAR2.EQ.'INTE')GOTO4900
      IF(ICHAR2.EQ.'CINT')GOTO5000
      IF(ICHAR2.EQ.'INFI')GOTO5100
      IF(ICHAR2.EQ.'%   ')GOTO5200
      IF(ICHAR2.EQ.'&   ')GOTO5300
      IF(ICHAR2.EQ.'@   ')GOTO5400
      IF(ICHAR2.EQ.'$   ')GOTO5500
      IF(ICHAR2.EQ.'#   ')GOTO5600
      IF(ICHAR2.EQ.'PARA')GOTO5700
      IF(ICHAR2.EQ.'DAGG')GOTO5800
      IF(ICHAR2.EQ.'DDAG')GOTO5900
      IF(ICHAR2.EQ.'THEX')GOTO6000
      IF(ICHAR2.EQ.'PROD')GOTO6100
      IF(ICHAR2.EQ.'SUMM')GOTO6200
      IF(ICHAR2.EQ.'THFO')GOTO6300
      IF(ICHAR2.EQ.'LVBA')GOTO6400
      IF(ICHAR2.EQ.'HBAR')GOTO6500
      IF(ICHAR2.EQ.'LHBA')GOTO6600
C
      IF(ICHAR2.EQ.'.   ')GOTO10100
      IF(ICHAR2.EQ.'POIN')GOTO10100
      IF(ICHAR2.EQ.'PO  ')GOTO10100
      IF(ICHAR2.EQ.'PT  ')GOTO10100
      IF(ICHAR2.EQ.'CIRC')GOTO10200
      IF(ICHAR2.EQ.'CI  ')GOTO10200
      IF(ICHAR2.EQ.'SQUA')GOTO10300
      IF(ICHAR2.EQ.'SQ  ')GOTO10300
      IF(ICHAR2.EQ.'TRIA')GOTO10400
      IF(ICHAR2.EQ.'TR  ')GOTO10400
      IF(ICHAR2.EQ.'DIAM')GOTO10500
      IF(ICHAR2.EQ.'DI  ')GOTO10500
      IF(ICHAR2.EQ.'STAR')GOTO10600
      IF(ICHAR2.EQ.'ST  ')GOTO10600
      IF(ICHAR2.EQ.'*   ')GOTO10700
      IF(ICHAR2.EQ.'ASTE')GOTO10700
      IF(ICHAR2.EQ.'AS  ')GOTO10700
      IF(ICHAR2.EQ.'TRIR')GOTO10800
      IF(ICHAR2.EQ.'TRII')GOTO10800
C  AUGUST 1992.  ADD FOLLOWING 2 LINES (TO MAKE DOCUMENTATION CORRECT)
      IF(ICHAR2.EQ.'REVT')GOTO10800
      IF(ICHAR2.EQ.'RT  ')GOTO10800
C
      IF(ICHAR2.EQ.'BARU')GOTO10900
      IF(ICHAR2.EQ.'BU  ')GOTO10900
      IF(ICHAR2.EQ.'BARV')GOTO10900
      IF(ICHAR2.EQ.'BV  ')GOTO10900
      IF(ICHAR2.EQ.'BARH')GOTO11000
      IF(ICHAR2.EQ.'BH  ')GOTO11000
      IF(ICHAR2.EQ.'ARRU')GOTO11100
      IF(ICHAR2.EQ.'AU  ')GOTO11100
      IF(ICHAR2.EQ.'ARRD')GOTO11200
      IF(ICHAR2.EQ.'AD  ')GOTO11200
      IF(ICHAR2.EQ.'ARRL')GOTO11300
      IF(ICHAR2.EQ.'AL  ')GOTO11300
      IF(ICHAR2.EQ.'ARRR')GOTO11400
      IF(ICHAR2.EQ.'AR  ')GOTO11400
      CALL DPCONA(92,IBASLC)
      IF(ICHAR2.EQ.IBASLC)GOTO11500
      IF(ICHAR2.EQ.'BASL')GOTO11500
      IF(ICHAR2.EQ.'BACK')GOTO11500
      IF(ICHAR2.EQ.'BS  ')GOTO11500
      IF(ICHAR2.EQ.'_   ')GOTO11600
      IF(ICHAR2.EQ.'UNDE')GOTO11600
      IF(ICHAR2.EQ.'CUBE')GOTO11700
      IF(ICHAR2.EQ.'PYRA')GOTO11800
C  AUGUST 1992.  ADD AN ARROW OPTION
      IF(ICHAR2.EQ.'ARRO')GOTO11900
      IF(ICHAR2.EQ.'ARRH')GOTO11900
      IF(ICHAR2.EQ.'VECT')GOTO11900
C
      GOTO17900
C
  100 CONTINUE
      ICHARN=1
      GOTO18000
C
  200 CONTINUE
      ICHARN=2
      GOTO18000
C
  300 CONTINUE
      ICHARN=3
      GOTO18000
C
  400 CONTINUE
      ICHARN=4
      GOTO18000
C
  500 CONTINUE
      ICHARN=5
      GOTO18000
C
  600 CONTINUE
      ICHARN=6
      GOTO18000
C
  700 CONTINUE
      ICHARN=7
      GOTO18000
C
  800 CONTINUE
      ICHARN=8
      GOTO18000
C
  900 CONTINUE
      ICHARN=9
      GOTO18000
C
 1000 CONTINUE
      ICHARN=10
      GOTO18000
C
 1100 CONTINUE
      ICHARN=11
      GOTO18000
C
 1200 CONTINUE
      ICHARN=12
      GOTO18000
C
 1300 CONTINUE
      ICHARN=13
      GOTO18000
C
 1400 CONTINUE
      ICHARN=14
      GOTO18000
C
 1500 CONTINUE
      ICHARN=15
      GOTO18000
C
 1600 CONTINUE
      ICHARN=16
      GOTO18000
C
 1700 CONTINUE
      ICHARN=17
      GOTO18000
C
 1800 CONTINUE
      ICHARN=18
      GOTO18000
C
 1900 CONTINUE
      ICHARN=19
      GOTO18000
C
 2000 CONTINUE
      ICHARN=20
      GOTO18000
C
 2100 CONTINUE
      ICHARN=21
      GOTO18000
C
 2200 CONTINUE
      ICHARN=22
      GOTO18000
C
 2300 CONTINUE
      ICHARN=23
      GOTO18000
C
 2400 CONTINUE
      ICHARN=24
      GOTO18000
C
 2500 CONTINUE
      ICHARN=25
      GOTO18000
C
 2600 CONTINUE
      ICHARN=26
      GOTO18000
C
 2700 CONTINUE
      ICHARN=27
      GOTO18000
C
 2800 CONTINUE
      ICHARN=28
      GOTO18000
C
 2900 CONTINUE
      ICHARN=29
      GOTO18000
C
 3000 CONTINUE
      ICHARN=30
      GOTO18000
C
 3100 CONTINUE
      ICHARN=31
      GOTO18000
C
 3200 CONTINUE
      ICHARN=32
      GOTO18000
C
 3300 CONTINUE
      ICHARN=33
      GOTO18000
C
 3400 CONTINUE
      ICHARN=34
      GOTO18000
C
 3500 CONTINUE
      ICHARN=35
      GOTO18000
C
 3600 CONTINUE
      ICHARN=36
      GOTO18000
C
 3700 CONTINUE
      ICHARN=37
      GOTO18000
C
 3800 CONTINUE
      ICHARN=38
      GOTO18000
C
 3900 CONTINUE
      ICHARN=39
      GOTO18000
C
 4000 CONTINUE
      ICHARN=40
      GOTO18000
C
 4100 CONTINUE
      ICHARN=41
      GOTO18000
C
 4200 CONTINUE
      ICHARN=42
      GOTO18000
C
 4300 CONTINUE
      ICHARN=43
      GOTO18000
C
 4400 CONTINUE
      ICHARN=44
      GOTO18000
C
 4500 CONTINUE
      ICHARN=45
      GOTO18000
C
 4600 CONTINUE
      ICHARN=46
      GOTO18000
C
 4700 CONTINUE
      ICHARN=47
      GOTO18000
C
 4800 CONTINUE
      ICHARN=48
      GOTO18000
C
 4900 CONTINUE
      ICHARN=49
      GOTO18000
C
 5000 CONTINUE
      ICHARN=50
      GOTO18000
C
 5100 CONTINUE
      ICHARN=51
      GOTO18000
C
 5200 CONTINUE
      ICHARN=52
      GOTO18000
C
 5300 CONTINUE
      ICHARN=53
      GOTO18000
C
 5400 CONTINUE
      ICHARN=54
      GOTO18000
C
 5500 CONTINUE
      ICHARN=55
      GOTO18000
C
 5600 CONTINUE
      ICHARN=56
      GOTO18000
C
 5700 CONTINUE
      ICHARN=57
      GOTO18000
C
 5800 CONTINUE
      ICHARN=58
      GOTO18000
C
 5900 CONTINUE
      ICHARN=59
      GOTO18000
C
 6000 CONTINUE
      ICHARN=60
      GOTO18000
C
 6100 CONTINUE
      ICHARN=61
      GOTO18000
C
 6200 CONTINUE
      ICHARN=62
      GOTO18000
C
 6300 CONTINUE
      ICHARN=63
      GOTO18000
C
 6400 CONTINUE
      ICHARN=64
      GOTO18000
C
 6500 CONTINUE
      ICHARN=65
      GOTO18000
C
 6600 CONTINUE
      ICHARN=66
      GOTO18000
C
10100 CONTINUE
      ICHARN=101
      GOTO18000
C
10200 CONTINUE
      ICHARN=102
      GOTO18000
C
10300 CONTINUE
      ICHARN=103
      GOTO18000
C
10400 CONTINUE
      ICHARN=104
      GOTO18000
C
10500 CONTINUE
      ICHARN=105
      GOTO18000
C
10600 CONTINUE
      ICHARN=106
      GOTO18000
C
10700 CONTINUE
      ICHARN=107
      GOTO18000
C
10800 CONTINUE
      ICHARN=108
      GOTO18000
C
10900 CONTINUE
      ICHARN=109
      GOTO18000
C
11000 CONTINUE
      ICHARN=110
      GOTO18000
C
11100 CONTINUE
      ICHARN=111
      GOTO18000
C
11200 CONTINUE
      ICHARN=112
      GOTO18000
C
11300 CONTINUE
      ICHARN=113
      GOTO18000
C
11400 CONTINUE
      ICHARN=114
      GOTO18000
C
11500 CONTINUE
      ICHARN=115
      GOTO18000
C
11600 CONTINUE
      ICHARN=116
      GOTO18000
C
11700 CONTINUE
      ICHARN=117
      GOTO18000
C
11800 CONTINUE
      ICHARN=118
      GOTO18000
C  AUGUST 1992.  ADDED FOLLOWING 3 LINES
11900 CONTINUE
      ICHARN=119
      GOTO18000
C
17900 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7911)
C7911 FORMAT('***** ERROR IN DPCHMA--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7912)
C7912 FORMAT('      NO MATCH FOUND FOR INPUT CHARACTER.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7913)ICHAR2
C7913 FORMAT('      INPUT CHARACTER = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
      IFOUND='NO'
      GOTO19000
C
18000 CONTINUE
      IFOUND='YES'
      GOTO19000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
19000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHMA')GOTO19090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19011)
19011 FORMAT('***** AT THE END       OF DPCHMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19012)IFOUND
19012 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19013)ICHAR2,ICHARN
19013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19019)IBUGG4,ISUBG4,IFOUND
19019 FORMAT('IBUGG4,ISUBG4,IFOUND = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
19090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCHNU(ICHAR2,ICHARN,IBUG,IFOUND)
C
C     PURPOSE--CONVERT AN ALPHABETIC CHARACTER
C              (0 TO 9) INTO A NUMERIC VALUE
C              (1 TO 10).
C     INPUT  ARGUMENTS--ICHAR2 (A HOLLERITH VARIABLE
C                              CONTAINING THE HOLLERITH
C                              CHARACTER(S) OF INTEREST.
C     OUTPUT ARGUMENTS--ICHARN (AN INTEGER VARIABLE
C                              CONTAINING THE NUMERIC
C                              DESIGNATION FOR THE
C                              ALPHABETIC CHARACTER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IBUG
      CHARACTER*4 IFOUND
C
      CHARACTER*1 ICH1
      CHARACTER*1 ICH2
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
C
      ICH1='-'
      ICH2='-'
C
      ICH1N=(-999)
      ICH2N=(-999)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHNU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCHNU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4
   59 FORMAT('IBUGG4,ISUBG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  CONVERT THE CHARACTER       **
C               **********************************
C
      ICH2(1:1)=ICHAR2(2:2)
CCCCC ICH2N=ICHAR(ICH2)
      CALL DPCOAN(ICH2,ICH2N)
      IF(ICH2N.EQ.32)GOTO1100
      GOTO7900
C
 1100 CONTINUE
      ICH1(1:1)=ICHAR2(1:1)
CCCCC ICH1N=ICHAR(ICH1)
      CALL DPCOAN(ICH1,ICH1N)
      ICHARN=ICH1N-47
      IF(1.LE.ICHARN.AND.ICHARN.LE.10)GOTO8000
      GOTO7900
C
 7900 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7911)
C7911 FORMAT('***** ERROR IN DPCHNU--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7912)
C7912 FORMAT('      NO MATCH FOUND FOR INPUT CHARACTER.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7913)ICHAR
C7913 FORMAT('      INPUT CHARACTER = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
      IFOUND='NO'
      GOTO9000
C
 8000 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHNU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCHAL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICH1,ICH1N
 9012 FORMAT('ICH1,ICH1N = ',A1,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICH2,ICH2N
 9013 FORMAT('ICH2,ICH2N = ',A1,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICHAR2,ICHARN
 9014 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IFOUND
 9019 FORMAT('IBUGG4,ISUBG4,IFOUND = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCHOF(IHARG,IARGT,IARG,ARG,NUMARG,
     1MAXCHA,
     1PCHAHO,PCHAVO,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER (HORIZONTAL AND VERTICAL) OFFSET
C              FOR USE IN MULTI-TRACE PLOTS.
C              THE OFFSET FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE FLOATING POINT
C              VECTORS PCHAHO(.) AND PCHAVO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXCHA
C     OUTPUT ARGUMENTS--PCHAHO  (A  FLOATING POINT VECTOR
C                       WHOSE I-TH ELEMENT IS THE HORIZONTAL OFFSET
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --PCHAVO  (A  FLOATING POINT VECTOR
C                       WHOSE I-TH ELEMENT IS THE VERTICAL OFFSET
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --PCHAHO = CHARACTER WIDTH
C                     --PCHAVG = VERTICAL GAP BETWEEN CHARACTERS
C                     --PCHAHG = HORIZONTAL GAP BETWEEN CHARACTERS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1986.
C     UPDATED         --AUGUST    1988.  CORRECTED FORMAT STATEMENT
C     UPDATED         --AUGUST    1988.  CORRECTED LOOP LOGIC
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PCHAHO(*)
      DIMENSION PCHAVO(*)
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
 1100 CONTINUE
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'OFFS')GOTO1160
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DISP')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'OFFS')GOTO1105
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DISP')GOTO1105
      GOTO2199
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.3)GOTO1120
      IF(NUMARG.GE.4.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      PCHAVO(I)=0.0
      PCHAHO(I)=0.0
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)
 1116 FORMAT('ALL CHARACTER (HORIZ. AND VERT.) OFFSETS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)PCHAHO(I),PCHAVO(I)
 1117 FORMAT('    HAVE JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO2190
C
 1120 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB'.OR.IARGT(3).NE.'NUMB')GOTO1180
      PCHAHO(1)=ARG(2)
      PCHAVO(1)=ARG(3)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I
 1126 FORMAT('THE (HORIZ. AND VERT.) OFFSET FOR CHARACTER ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)PCHAHO(I),PCHAVO(I)
 1127 FORMAT('    HAS JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO2190
C
 1130 CONTINUE
      I=1
      IF(IARGT(3).NE.'NUMB'.OR.IARGT(4).NE.'NUMB')GOTO1180
      DO1135I=1,MAXCHA
      PCHAHO(I)=ARG(3)
      PCHAVO(I)=ARG(4)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)PCHAHO(I),PCHAVO(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO2190
C
 1140 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB'.OR.IARGT(3).NE.'NUMB')GOTO1180
      DO1145I=1,MAXCHA
      PCHAHO(I)=ARG(2)
      PCHAVO(I)=ARG(3)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)PCHAHO(I),PCHAVO(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO2190
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
CCCCC THE FOLLOWING 1 LINE WAS INSERTED IN AUGUST 1988
      J=0
      DO1155I=1,IMAX,2
      IP1=I+1
      IP2=I+2
      IF(IARGT(IP1).NE.'NUMB')GOTO1180
      IF(IARGT(IP2).NE.'NUMB')GOTO1180
CCCCC PCHAHO(I)=ARG(IP1)                  AUGUST 1988
CCCCC PCHAVO(I)=ARG(IP2)                  AUGUST 1988
CCCCC THE FOLLOWING 3 LINES WERE INSERTED IN AUGUST 1988
      J=J+1
      PCHAHO(J)=ARG(IP1)
      PCHAVO(J)=ARG(IP2)
 1155 CONTINUE
CCCCC THE FOLLOWING 1 LINE WAS INSERTED IN AUGUST 1988
      JMAX=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC DO1156I=1,IMAX                      AUGUST 1988
CCCCC THE FOLLOWING 1 LINE WAS INSERTED IN AUGUST 1988
      DO1156I=1,JMAX
      WRITE(ICOUT,1126)I
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1127)I,PCHAHO(I),PCHAVO(I)             AUGUST 1988
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)PCHAHO(I),PCHAVO(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO2190
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      PCHAHO(I)=0.0
      PCHAVO(I)=0.0
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)PCHAHO(I),PCHAVO(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO2190
C
 1180 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('***** ERROR IN DPCHOF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('CHARACTER (HORIZ. AND VERT.) OFFSETS MUST BE NUMERIC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('HOWEVER, THE SPECIFIED CHARACTER OFFSET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)I
 1184 FORMAT('FOR CHARACTER ',I6,' WAS NON-NUMERIC.')
      CALL DPWRST('XXX','BUG ')
      GOTO2199
C
 2190 CONTINUE
      IFOUND='YES'
C
 2199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHSQ(X1,X2,Y1,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--COMPUTE A CHI-SQUARE GOODNESS OF FIT ANALYSIS
C              FOR ONE OF THE FOLLOWING DISTRIBUTIONS--
C              1 ) UNIFORM
C              2 ) NORMAL
C              3 ) LOGISTIC
C              4 ) DOUBLE EXPONENTIAL
C              5 ) CAUCHY
C              6 ) TUKEY LAMBDA
C              7 ) LOGNORMAL
C              8 ) HALFNORMAL
C              9 ) T
C              10) CHI-SQUARED
C              11) F
C              12) EXPONENTIAL
C              13) GAMMA
C              14) BETA
C              15) WEIBULL---MIN & MAX                       MAY 1993
C              16) EXTREME VALUE TYPE 1 (GUMBEL)--MIN & MAX  MAY 1993
C              17) EXTREME VALUE TYPE 2 (FRECHET)--MIN & MAX MAY 1993
C              18) PARETO
C              19) BINOMIAL
C              20) GEOMETRIC
C              21) POISSON
C              22) NEGATIVE BINOMIAL
C              23) SEMI-CIRCULAR
C              24) TRIANGULAR
C              25) INVERSE GAUUSIAN
C              26) WALD
C              27) RECIPROCAL INVERSE GAUUSIAN
C              28) FAILURE TIME
C              29) GENERALIZED PARETO
C              30) DISCRETE UNIFORM
C              31) NON-CENTRAL T
C              32) NON-CENTRAL F
C              33) NON-CENTRAL CHI-SQUARE
C              34) NON-CENTRAL BETA
C              35) DOUBLY NON-CENTRAL T
C              36) DOUBLY NON-CENTRAL F
C              36) HYPER-GEOMETRIC
C              37) VON-MISES
C              38) POWER NORMAL
C              39) POWER LOGNORMAL
C              40) COSINE
C              41) ALPHA
C              42) POWER FUNCTION
C              43) CHI
C              44) LOGARITMIC SERIES
C              45) LOG LOGISTIC
C              46) GENERALIZED GAMMA
C              47) WARING
C              48) ANGLIT
C              49) ARCSIN
C              50) FOLDED NORMAL
C              51) TRUNCATED NORMAL
C              52) LOG GAMMA
C              53) HYPERBOLIC SECANT
C              54) GOMPERTZ
C              55) PARETO SECOND KIND
C              56) DOUBLE WEIBULL
C              57) WRAPPED-UP CAUCHY
C              58) EXPONENTIAL WEIBULL
C              59) TRUNCATED EXPONENTIAL
C              60) GENERALIZED LOGISTIC
C              61) EXPONENTIAL POWER
C              62) DOUBLE GAMMA
C              63) MIELKE'S BETA-KAPPA
C              64) FOLDED CAUCHY
C              65) BETA BINOMIAL
C              66) BETA PASCAL
C              67) GENERALIZED EXPONENTIAL CHI-SQUARE GOODNESS OF FIT
C              68) RECIPROCAL CHI-SQUARE GOODNESS OF FIT
C              69) NORMAL MIXTURE
C              70) INVERTED GAMMA
C              71) INVERTED WEIBULL
C              72) LOG DOUBLE EXPONENTIAL
C              73) GENERALIZED TUKEY-LAMBDA
C              74) JOHNSON SU
C              75) JOHNSON SB
C              76) GEOMETRIC EXTREME EXPONENTIAL
C              77) TWO-SIDED POWER
C              78) BIWEIBULL
C              79) LANDAU
C              80) ERROR (= EXPONENTIAL POWER = SUBBOTIN)
C              81) TRAPEZOID
C              82) GENERALIZED TRAPEZOID
C              83) FOLDED T
C              83) SLASH
C              84) SKEWED NORMAL
C              85) SKEWED T
C              86) INVERTED BETA
C              87) GOMPERTZ-MAKEHAM
C              88) GENERALIZED INVERSE GAUSSIAN
C              89) GENERALIZED F
C              90) G-H
C              91) LOG SKEW NORMAL
C              92) LOG SKEW T
C              93) GENERALIZED HALF-LOGISTIC
C              94) POLYA
C              95) HERMITE
C              96) SKEWED DOUBLE EXPONENTIAL
C              97) ASYMMETRIC DOUBLE EXPONENTIAL
C              98) MAXWELL
C              99) RAYLEIGH
C             100) GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL
C             101) MCLEISH
C             102) BESSEL I-FUNCTION
C             103) BESSEL K-FUNCTION
C             104) GENERALIZED MCLEISH
C             105) GENERALIZED LOGISTIC TYPE 5
C             106) WAKEBY
C             107) BETA-NORMAL
C             108) GENERALIZED LOGISTIC TYPE 2
C             109) GENERALIZED LOGISTIC TYPE 3
C             110) GENERALIZED LOGISTIC TYPE 4
C             111) ASYMMETRIC LOG DOUBLE EXPONENTIAL
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/11
C     ORIGINAL VERSION--NOVEMBER  1998.
C     UPDATED         --OCTOBER   2001.
C     UPDATED         --NOVEMBER  2001.
C     UPDATED         --MAY       2002. TWO-SIDED POWER
C     UPDATED         --MAY       2002. BIWEIBULL
C     UPDATED         --MAY       2003. LANDAU
C     UPDATED         --MAY       2003. ERROR (= EXPONENTIAL POWER)
C     UPDATED         --JUNE      2003. TRAPEZOID
C     UPDATED         --JUNE      2003. GENERALIZED TRAPEZOID
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C     UPDATED         --NOVEMBER  2003. FOLDED T
C     UPDATED         --DECEMBER  2003. SUPPORT FOR MU PARAMETER FOR
C                                       INVERSE GAUSSIAN, RECIPROCAL
C                                       INVERSE GAUSSIAN
C     UPDATED         --DECEMBER  2003. SLASH, SKEW NORMAL,
C                                       SKEW T, INVERTED BETA,
C                                       GOMPERTZ-MAKEHAM, G-H
C     UPDATED         --MARCH     2004. LOG-SKEW-NORMAL
C     UPDATED         --MARCH     2004. LOG-SKEW-T
C     UPDATED         --MARCH     2004. POLYA
C     UPDATED         --APRIL     2004. HERMITE
C     UPDATED         --JUNE      2004. SKEW DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. ASYMMETRIC DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. MAXWELL, RAYLEIGH
C     UPDATED         --AUGUST    2004. GENERALIZED ASYMMETRIC
C                                       DOUBLE EXPONENTIAL
C     UPDATED         --AUGUST    2004. MCLEISH
C     UPDATED         --AUGUST    2004. BESSEL I-FUNCTION
C     UPDATED         --AUGUST    2004. BESSEL K-FUNCTION
C     UPDATED         --SEPTEMBER 2004. GENERALIZED MCLEISH
C     UPDATED         --DECEMBER  2004. CLARIFY SHAPE PARAMETERS FOR
C                                       PARETO PARETO SECOND KIND
C     UPDATED         --FEBRUARY  2006. GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006. WAKEBY
C     UPDATED         --FEBRUARY  2006. FMKL PARAMETERIZATION FOR
C                                       GENERALZIED TUKEY LAMBDA
C     UPDATED         --MARCH     2006. SUPPORT FOR DIFFERENT
C                                       DEFAULT BINNING ALGORITHMS
C     UPDATED         --MARCH     2006. BETA-BINOMIAL
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 2
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 3
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 4
C     UPDATED         --MARCH     2006. ASYMMETRIC LOG DOUBLE
C                                       EXPONENTIAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAPSW
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IDATSW
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHTHIR
      CHARACTER*4 IHTHI2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 LOWLTY
      CHARACTER*4 UPPLTY
      CHARACTER*30 IDIST
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      REAL LOC2
C
      PARAMETER (NUMCHS=201)
      CHARACTER*4 INAME(NUMCHS,4)
      CHARACTER*4 INCASE(NUMCHS)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
      DIMENSION XTEMP(MAXOBV)
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      DIMENSION YOBS(MAXOBV)
      DIMENSION YEXP(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),XTEMP(1))
      EQUIVALENCE (GARBAG(IGARB2),YOBS(1))
      EQUIVALENCE (GARBAG(IGARB3),YEXP(1))
      EQUIVALENCE (GARBAG(IGARB4),XTEMP2(1))
      EQUIVALENCE (GARBAG(IGARB5),XTEMP3(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOS2.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C  AUGUST 1998.  MAKE SEARCH TABLE DRIVEN
C
      DATA INCASE(1)/'UNPP'/
      DATA (INAME(1,J),J=1,4)/'UNIF','    ','    ','    '/
      DATA INCASE(2)/'UNPP'/
      DATA (INAME(2,J),J=1,4)/'RECT','    ','    ','    '/
      DATA INCASE(3)/'NMPP'/
      DATA (INAME(3,J),J=1,4)/'NORM','MIXT','    ','    '/
      DATA INCASE(4)/'NMPP'/
      DATA (INAME(4,J),J=1,4)/'GAUS','MIXT','    ','    '/
      DATA INCASE(5)/'NOPP'/
      DATA (INAME(5,J),J=1,4)/'NORM','    ','    ','    '/
      DATA INCASE(6)/'NOPP'/
      DATA (INAME(6,J),J=1,4)/'GAUS','    ','    ','    '/
      DATA INCASE(7)/'LOPP'/
      DATA (INAME(7,J),J=1,4)/'LOGI','    ','    ','    '/
      DATA INCASE(8)/'DEPP'/
      DATA (INAME(8,J),J=1,4)/'DOUB','EXPO','    ','    '/
      DATA INCASE(9)/'DEPP'/
      DATA (INAME(9,J),J=1,4)/'LAPL','    ','    ','    '/
      DATA INCASE(10)/'CAPP'/
      DATA (INAME(10,J),J=1,4)/'CAUC','    ','    ','    '/
      DATA INCASE(11)/'LAPP'/
      DATA (INAME(11,J),J=1,4)/'TUKE','LAMB','    ','    '/
      DATA INCASE(12)/'LAPP'/
      DATA (INAME(12,J),J=1,4)/'TUKE','    ','    ','    '/
      DATA INCASE(13)/'LAPP'/
      DATA (INAME(13,J),J=1,4)/'LAMB','    ','    ','    '/
      DATA INCASE(14)/'LNPP'/
      DATA (INAME(14,J),J=1,4)/'LOG ','NORM','    ','    '/
      DATA INCASE(15)/'LNPP'/
      DATA (INAME(15,J),J=1,4)/'LOGN','    ','    ','    '/
      DATA INCASE(16)/'HNPP'/
      DATA (INAME(16,J),J=1,4)/'HALF','NORM','    ','    '/
      DATA INCASE(17)/'HNPP'/
      DATA (INAME(17,J),J=1,4)/'HALF','    ','    ','    '/
      DATA INCASE(18)/'TPP'/
      DATA (INAME(18,J),J=1,4)/'T   ','    ','    ','    '/
      DATA INCASE(19)/'TPP'/
      DATA (INAME(19,J),J=1,4)/'STUD','T   ','    ','    '/
      DATA INCASE(20)/'CSPP'/
      DATA (INAME(20,J),J=1,4)/'CHIS','    ','    ','    '/
      DATA INCASE(21)/'CSPP'/
      DATA (INAME(21,J),J=1,4)/'CHI ','SQUA','    ','    '/
      DATA INCASE(22)/'FPP'/
      DATA (INAME(22,J),J=1,4)/'F   ','    ','    ','    '/
      DATA INCASE(23)/'FPP'/
      DATA (INAME(23,J),J=1,4)/'SNED','F   ','    ','    '/
      DATA INCASE(24)/'EXPP'/
      DATA (INAME(24,J),J=1,4)/'EXPO','    ','    ','    '/
      DATA INCASE(25)/'EXPP'/
      DATA (INAME(25,J),J=1,4)/'NEGA','EXPO','    ','    '/
      DATA INCASE(26)/'GAPP'/
      DATA (INAME(26,J),J=1,4)/'GAMM','    ','    ','    '/
      DATA INCASE(27)/'BNPP'/
      DATA (INAME(27,J),J=1,4)/'BETA','NORM','    ','    '/
      DATA INCASE(28)/'WEPP'/
      DATA (INAME(28,J),J=1,4)/'WEIB','    ','    ','    '/
      DATA INCASE(29)/'E1PP'/
      DATA (INAME(29,J),J=1,4)/'EXTR','VALU','TYPE','1   '/
      DATA INCASE(30)/'E1PP'/
      DATA (INAME(30,J),J=1,4)/'EXTR','VALU','TYPE','I   '/
      DATA INCASE(31)/'E1PP'/
      DATA (INAME(31,J),J=1,4)/'EV1 ','    ','    ','    '/
      DATA INCASE(32)/'E1PP'/
      DATA (INAME(32,J),J=1,4)/'EVI ','    ','    ','    '/
      DATA INCASE(33)/'E1PP'/
      DATA (INAME(33,J),J=1,4)/'GUMB','    ','    ','    '/
      DATA INCASE(34)/'E2PP'/
      DATA (INAME(34,J),J=1,4)/'EXTR','VALU','TYPE','2   '/
      DATA INCASE(35)/'E2PP'/
      DATA (INAME(35,J),J=1,4)/'EXTR','VALU','TYPE','II  '/
      DATA INCASE(36)/'E2PP'/
      DATA (INAME(36,J),J=1,4)/'EVII','    ','    ','    '/
      DATA INCASE(37)/'E2PP'/
      DATA (INAME(37,J),J=1,4)/'EV2 ','    ','    ','    '/
      DATA INCASE(38)/'E2PP'/
      DATA (INAME(38,J),J=1,4)/'FREC','    ','    ','    '/
      DATA INCASE(39)/'PAPP'/
      DATA (INAME(39,J),J=1,4)/'PARE','    ','    ','    '/
      DATA INCASE(40)/'BIPP'/
      DATA (INAME(40,J),J=1,4)/'BINO','    ','    ','    '/
      DATA INCASE(41)/'GEPP'/
      DATA (INAME(41,J),J=1,4)/'GEOM','    ','    ','    '/
      DATA INCASE(42)/'POPP'/
      DATA (INAME(42,J),J=1,4)/'POIS','    ','    ','    '/
      DATA INCASE(43)/'NBPP'/
      DATA (INAME(43,J),J=1,4)/'NEGA','BINO','    ','    '/
      DATA INCASE(44)/'SEPP'/
      DATA (INAME(44,J),J=1,4)/'SEMI','CIRC','    ','    '/
      DATA INCASE(45)/'SEPP'/
      DATA (INAME(45,J),J=1,4)/'SEMI','    ','    ','    '/
      DATA INCASE(46)/'TRPP'/
      DATA (INAME(46,J),J=1,4)/'TRIA','    ','    ','    '/
      DATA INCASE(47)/'IGPP'/
      DATA (INAME(47,J),J=1,4)/'INVE','GAUS','    ','    '/
      DATA INCASE(48)/'IGPP'/
      DATA (INAME(48,J),J=1,4)/'IG  ','    ','    ','    '/
      DATA INCASE(49)/'WAPP'/
      DATA (INAME(49,J),J=1,4)/'WALD','    ','    ','    '/
      DATA INCASE(50)/'RIPP'/
      DATA (INAME(50,J),J=1,4)/'RIG ','    ','    ','    '/
      DATA INCASE(51)/'RIPP'/
      DATA (INAME(51,J),J=1,4)/'TWEE','    ','    ','    '/
      DATA INCASE(52)/'RIPP'/
      DATA (INAME(52,J),J=1,4)/'RECI','INVE','GAUS','    '/
      DATA INCASE(53)/'FLPP'/
      DATA (INAME(53,J),J=1,4)/'FATI','LIFE','    ','    '/
      DATA INCASE(54)/'FLPP'/
      DATA (INAME(54,J),J=1,4)/'FL  ','    ','    ','    '/
      DATA INCASE(55)/'FLPP'/
      DATA (INAME(55,J),J=1,4)/'BIRN','SAUN','    ','    '/
      DATA INCASE(56)/'FLPP'/
      DATA (INAME(56,J),J=1,4)/'SAUN','BIRN','    ','    '/
      DATA INCASE(57)/'GPPP'/
      DATA (INAME(57,J),J=1,4)/'GENE','PARE','    ','    '/
      DATA INCASE(58)/'GPPP'/
      DATA (INAME(58,J),J=1,4)/'GEP ','    ','    ','    '/
      DATA INCASE(59)/'GPPP'/
      DATA (INAME(59,J),J=1,4)/'GP  ','    ','    ','    '/
      DATA INCASE(60)/'DUPP'/
      DATA (INAME(60,J),J=1,4)/'DISC','UNIF','    ','    '/
      DATA INCASE(61)/'NTPP'/
      DATA (INAME(61,J),J=1,4)/'NONC','T   ','    ','    '/
      DATA INCASE(62)/'NTPP'/
      DATA (INAME(62,J),J=1,4)/'NON-','T   ','    ','    '/
      DATA INCASE(63)/'NTPP'/
      DATA (INAME(63,J),J=1,4)/'NON ','CENT','T   ','    '/
      DATA INCASE(64)/'NFPP'/
      DATA (INAME(64,J),J=1,4)/'NONC','F   ','    ','    '/
      DATA INCASE(65)/'NFPP'/
      DATA (INAME(65,J),J=1,4)/'NON-','F   ','    ','    '/
      DATA INCASE(66)/'NFPP'/
      DATA (INAME(66,J),J=1,4)/'NON ','CENT','F   ','    '/
      DATA INCASE(67)/'NCBP'/
      DATA (INAME(67,J),J=1,4)/'NONC','BETA','    ','    '/
      DATA INCASE(68)/'NCBP'/
      DATA (INAME(68,J),J=1,4)/'NON-','BETA','    ','    '/
      DATA INCASE(69)/'NCBP'/
      DATA (INAME(69,J),J=1,4)/'NON ','CENT','BETA','    '/
      DATA INCASE(70)/'NCPP'/
      DATA (INAME(70,J),J=1,4)/'NON ','CENT','CHIS','    '/
      DATA INCASE(71)/'NCPP'/
      DATA (INAME(71,J),J=1,4)/'NON ','CENT','CHI-','    '/
      DATA INCASE(72)/'NCPP'/
      DATA (INAME(72,J),J=1,4)/'NONC','CHI ','SQUA','    '/
      DATA INCASE(73)/'NCPP'/
      DATA (INAME(73,J),J=1,4)/'NON-','CHI ','SQUA','    '/
      DATA INCASE(74)/'NCPP'/
      DATA (INAME(74,J),J=1,4)/'NONC','CHI-','    ','    '/
      DATA INCASE(75)/'NCPP'/
      DATA (INAME(75,J),J=1,4)/'NON-','CHI-','    ','    '/
      DATA INCASE(76)/'NCPP'/
      DATA (INAME(76,J),J=1,4)/'NONC','CHIS','    ','    '/
      DATA INCASE(77)/'NCPP'/
      DATA (INAME(77,J),J=1,4)/'NON-','CHIS','CHIS','    '/
      DATA INCASE(78)/'DNCF'/
      DATA (INAME(78,J),J=1,4)/'DOUB','NONC','F   ','    '/
      DATA INCASE(79)/'DNCF'/
      DATA (INAME(79,J),J=1,4)/'DOUB','NON-','F   ','    '/
      DATA INCASE(80)/'DNCT'/
      DATA (INAME(80,J),J=1,4)/'DOUB','NONC','T   ','    '/
      DATA INCASE(81)/'DNCT'/
      DATA (INAME(81,J),J=1,4)/'DOUB','NON-','T   ','    '/
      DATA INCASE(82)/'HYPP'/
      DATA (INAME(82,J),J=1,4)/'HYPE','    ','    ','    '/
      DATA INCASE(83)/'HYPP'/
      DATA (INAME(83,J),J=1,4)/'HYPE','GEO ','    ','    '/
      DATA INCASE(84)/'VMPP'/
      DATA (INAME(84,J),J=1,4)/'VON ','MISE','    ','    '/
      DATA INCASE(85)/'VMPP'/
      DATA (INAME(85,J),J=1,4)/'VONM','    ','    ','    '/
      DATA INCASE(86)/'VMPP'/
      DATA (INAME(86,J),J=1,4)/'VON-','    ','    ','    '/
      DATA INCASE(87)/'PNPP'/
      DATA (INAME(87,J),J=1,4)/'POWE','NORM','    ','    '/
      DATA INCASE(88)/'PLPP'/
      DATA (INAME(88,J),J=1,4)/'POWE','LOGN','    ','    '/
      DATA INCASE(89)/'PLPP'/
      DATA (INAME(89,J),J=1,4)/'POWE','LGNO','    ','    '/
      DATA INCASE(90)/'PLPP'/
      DATA (INAME(90,J),J=1,4)/'POWE','LOG-','    ','    '/
      DATA INCASE(91)/'COPP'/
      DATA (INAME(91,J),J=1,4)/'COSI','    ','    ','    '/
      DATA INCASE(92)/'ALPP'/
      DATA (INAME(92,J),J=1,4)/'ALPH','    ','    ','    '/
      DATA INCASE(93)/'PEPP'/
      DATA (INAME(93,J),J=1,4)/'POWE','EXPO','    ','    '/
      DATA INCASE(94)/'PFPP'/
      DATA (INAME(94,J),J=1,4)/'POWE','FUNC','    ','    '/
      DATA INCASE(95)/'CHPP'/
      DATA (INAME(95,J),J=1,4)/'CHI ','    ','    ','    '/
      DATA INCASE(96)/'DLPP'/
      DATA (INAME(96,J),J=1,4)/'LOGA','SERI','    ','    '/
      DATA INCASE(97)/'LLPP'/
      DATA (INAME(97,J),J=1,4)/'LOG ','LOGI','    ','    '/
      DATA INCASE(98)/'LLPP'/
      DATA (INAME(98,J),J=1,4)/'LOG-','LOGI','    ','    '/
      DATA INCASE(99)/'LLPP'/
      DATA (INAME(99,J),J=1,4)/'LOGL','    ','    ','    '/
      DATA INCASE(100)/'GGPP'/
      DATA (INAME(100,J),J=1,4)/'GENE','GAMM','    ','    '/
      DATA INCASE(101)/'GIPP'/
      DATA (INAME(101,J),J=1,4)/'INVE','GAMM','    ','    '/
      DATA INCASE(102)/'WRPP'/
      DATA (INAME(102,J),J=1,4)/'WARI','    ','    ','    '/
      DATA INCASE(103)/'YUPP'/
      DATA (INAME(103,J),J=1,4)/'YULE','    ','    ','    '/
      DATA INCASE(104)/'ANPP'/
      DATA (INAME(104,J),J=1,4)/'ANGL','    ','    ','    '/
      DATA INCASE(105)/'ARPP'/
      DATA (INAME(105,J),J=1,4)/'ARSE','    ','    ','    '/
      DATA INCASE(106)/'FNPP'/
      DATA (INAME(106,J),J=1,4)/'FOLD','NORM','    ','    '/
      DATA INCASE(107)/'TNPP'/
      DATA (INAME(107,J),J=1,4)/'TRUN','NORM','    ','    '/
      DATA INCASE(108)/'LGPP'/
      DATA (INAME(108,J),J=1,4)/'LOG ','GAMM','    ','    '/
      DATA INCASE(109)/'HSPP'/
      DATA (INAME(109,J),J=1,4)/'HYPE','SECA','    ','    '/
      DATA INCASE(110)/'GOPP'/
      DATA (INAME(110,J),J=1,4)/'GOMP','    ','    ','    '/
      DATA INCASE(111)/'HLPP'/
      DATA (INAME(111,J),J=1,4)/'HALF','LOGI','    ','    '/
      DATA INCASE(112)/'GVPP'/
      DATA (INAME(112,J),J=1,4)/'GENE','EXTR','VALU','    '/
      DATA INCASE(113)/'GVPP'/
      DATA (INAME(113,J),J=1,4)/'GEV ','    ','    ','    '/
      DATA INCASE(114)/'HCPP'/
      DATA (INAME(114,J),J=1,4)/'HALF','CAUC','    ','    '/
      DATA INCASE(115)/'P2PP'/
      DATA (INAME(115,J),J=1,4)/'PARE','SECO','KIND','    '/
      DATA INCASE(116)/'P2PP'/
      DATA (INAME(116,J),J=1,4)/'PARE','TYPE','2   ','    '/
      DATA INCASE(117)/'P2PP'/
      DATA (INAME(117,J),J=1,4)/'PARE','TYPE','II  ','    '/
      DATA INCASE(118)/'DWPP'/
      DATA (INAME(118,J),J=1,4)/'DOUB','WEIB','    ','    '/
      DATA INCASE(119)/'EWPP'/
      DATA (INAME(119,J),J=1,4)/'EXPO','WEIB','    ','    '/
      DATA INCASE(120)/'TEPP'/
      DATA (INAME(120,J),J=1,4)/'TRUN','EXPO','    ','    '/
      DATA INCASE(121)/'WCPP'/
      DATA (INAME(121,J),J=1,4)/'WRAP','CAUC','    ','    '/
      DATA INCASE(122)/'WKPP'/
      DATA (INAME(122,J),J=1,4)/'WAKE','    ','    ','    '/
      DATA INCASE(123)/'PEPP'/
      DATA (INAME(123,J),J=1,4)/'EXPO','POWE','    ','    '/
      DATA INCASE(124)/'DGPP'/
      DATA (INAME(124,J),J=1,4)/'DOUB','GAMM','    ','    '/
      DATA INCASE(125)/'KAPP'/
      DATA (INAME(125,J),J=1,4)/'BETA','KAPP','    ','    '/
      DATA INCASE(126)/'KAPP'/
      DATA (INAME(126,J),J=1,4)/'MIEL','BETA','KAPP','    '/
      DATA INCASE(127)/'FCPP'/
      DATA (INAME(127,J),J=1,4)/'FOLD','CAUC','    ','    '/
      DATA INCASE(128)/'BBPP'/
      DATA (INAME(128,J),J=1,4)/'BETA','BINO','    ','    '/
      DATA INCASE(129)/'BRPP'/
      DATA (INAME(129,J),J=1,4)/'BRAD','    ','    ','    '/
      DATA INCASE(130)/'GXPP'/
      DATA (INAME(130,J),J=1,4)/'GENE','EXPO','    ','    '/
      DATA INCASE(131)/'REPP'/
      DATA (INAME(131,J),J=1,4)/'RECI','    ','    ','    '/
      DATA INCASE(132)/'IWPP'/
      DATA (INAME(132,J),J=1,4)/'INVE','WEIB','    ','    '/
      DATA INCASE(133)/'LXPP'/
      DATA (INAME(133,J),J=1,4)/'LOG ','DOUB','EXPO','    '/
      DATA INCASE(134)/'LDPP'/
      DATA (INAME(134,J),J=1,4)/'GENE','TUKE','LAMB','    '/
      DATA INCASE(135)/'JBPP'/
      DATA (INAME(135,J),J=1,4)/'JOHN','SB  ','    ','    '/
      DATA INCASE(136)/'JUPP'/
      DATA (INAME(136,J),J=1,4)/'JOHN','SU  ','    ','    '/
      DATA INCASE(137)/'EEPP'/
      DATA (INAME(137,J),J=1,4)/'GEOM','EXTR','EXPO','    '/
      DATA INCASE(138)/'TSPP'/
      DATA (INAME(138,J),J=1,4)/'TWO ','SIDE','POWE','    '/
      DATA INCASE(139)/'BWPP'/
      DATA (INAME(139,J),J=1,4)/'BI  ','WEIB','    ','    '/
      DATA INCASE(140)/'BWPP'/
      DATA (INAME(140,J),J=1,4)/'BIWE','    ','    ','    '/
      DATA INCASE(141)/'LUPP'/
      DATA (INAME(141,J),J=1,4)/'LAND','    ','    ','    '/
      DATA INCASE(142)/'ERPP'/
      DATA (INAME(142,J),J=1,4)/'ERRO','    ','    ','    '/
      DATA INCASE(143)/'ERPP'/
      DATA (INAME(143,J),J=1,4)/'SUBB','    ','    ','    '/
      DATA INCASE(144)/'PFPP'/
      DATA (INAME(144,J),J=1,4)/'POWE','    ','    ','    '/
      DATA INCASE(145)/'TZPP'/
      DATA (INAME(145,J),J=1,4)/'TRAP','    ','    ','    '/
      DATA INCASE(146)/'GTPP'/
      DATA (INAME(146,J),J=1,4)/'GENE','TRAP','    ','    '/
      DATA INCASE(147)/'FTPP'/
      DATA (INAME(147,J),J=1,4)/'FOLD','T   ','    ','    '/
      DATA INCASE(148)/'SNPP'/
      DATA (INAME(148,J),J=1,4)/'SKEW','NORM','    ','    '/
      DATA INCASE(149)/'STPP'/
      DATA (INAME(149,J),J=1,4)/'SKEW','T   ','    ','    '/
      DATA INCASE(150)/'SLPP'/
      DATA (INAME(150,J),J=1,4)/'SLAS','    ','    ','    '/
      DATA INCASE(151)/'IBPP'/
      DATA (INAME(151,J),J=1,4)/'INVE','BETA','    ','    '/
      DATA INCASE(152)/'GMPP'/
      DATA (INAME(152,J),J=1,4)/'GOMP','MAKE','    ','    '/
      DATA INCASE(153)/'GIGP'/
      DATA (INAME(153,J),J=1,4)/'GENE','INVE','GAUS','    '/
      DATA INCASE(154)/'GFPP'/
      DATA (INAME(154,J),J=1,4)/'GENE','F   ','    ','    '/
      DATA INCASE(155)/'GHPP'/
      DATA (INAME(155,J),J=1,4)/'G-H ','    ','    ','    '/
      DATA INCASE(156)/'GHPP'/
      DATA (INAME(156,J),J=1,4)/'GH  ','    ','    ','    '/
      DATA INCASE(157)/'GHPP'/
      DATA (INAME(157,J),J=1,4)/'G   ','H   ','    ','    '/
      DATA INCASE(158)/'GHPP'/
      DATA (INAME(158,J),J=1,4)/'G   ','AND ','H   ','    '/
      DATA INCASE(159)/'LZPP'/
      DATA (INAME(159,J),J=1,4)/'LOG ','SKEW','NORM','    '/
      DATA INCASE(160)/'LTPP'/
      DATA (INAME(160,J),J=1,4)/'LOG ','SKEW','T   ','    '/
      DATA INCASE(161)/'GZPP'/
      DATA (INAME(161,J),J=1,4)/'GENE','HALF','LOGI','    '/
      DATA INCASE(162)/'ASPP'/
      DATA (INAME(162,J),J=1,4)/'ARCS','    ','    ','    '/
      DATA INCASE(163)/'PZPP'/
      DATA (INAME(163,J),J=1,4)/'POLY','    ','    ','    '/
      DATA INCASE(164)/'HEPP'/
      DATA (INAME(164,J),J=1,4)/'HERM','    ','    ','    '/
      DATA (INAME(165,J),J=1,4)/'SKEW','DOUB','EXPO','    '/
      DATA INCASE(165)/'SDPP'/
      DATA (INAME(166,J),J=1,4)/'SKEW','LAPL','    ','    '/
      DATA INCASE(166)/'SDPP'/
      DATA (INAME(167,J),J=1,4)/'ASYM','DOUB','EXPO','    '/
      DATA INCASE(167)/'ADPP'/
      DATA (INAME(168,J),J=1,4)/'ASYM','LAPL','    ','    '/
      DATA INCASE(168)/'ADPP'/
      DATA (INAME(169,J),J=1,4)/'MAXW','    ','    ','    '/
      DATA INCASE(169)/'MXPP'/
      DATA (INAME(170,J),J=1,4)/'RAYL','    ','    ','    '/
      DATA INCASE(170)/'RAPP'/
      DATA (INAME(171,J),J=1,4)/'GENE','ASYM','DOUB','EXPO'/
      DATA INCASE(171)/'GALP'/
      DATA (INAME(172,J),J=1,4)/'GENE','ASYM','LAPL','    '/
      DATA INCASE(172)/'GALP'/
      DATA (INAME(173,J),J=1,4)/'MCLE','    ','    ','    '/
      DATA INCASE(173)/'MCLP'/
      DATA (INAME(174,J),J=1,4)/'BESS','I   ','FUNC','    '/
      DATA INCASE(174)/'BEIP'/
      DATA (INAME(175,J),J=1,4)/'BESS','I   ','    ','    '/
      DATA INCASE(175)/'BEIP'/
      DATA (INAME(176,J),J=1,4)/'BESS','K   ','FUNC','    '/
      DATA INCASE(176)/'BEKP'/
      DATA (INAME(177,J),J=1,4)/'BESS','K   ','    ','    '/
      DATA INCASE(177)/'BEKP'/
      DATA INCASE(178)/'GMCP'/
      DATA (INAME(178,J),J=1,4)/'GENE','MCLE','    ','    '/
      DATA INCASE(179)/'G5PP'/
      DATA (INAME(179,J),J=1,4)/'GENE','LOGI','TYPE','5   '/
      DATA INCASE(180)/'G5PP'/
      DATA (INAME(180,J),J=1,4)/'GENE','LOGI','TYPE','V   '/
      DATA INCASE(181)/'G5PP'/
      DATA (INAME(181,J),J=1,4)/'GENE','LOGI','HOSK','    '/
      DATA INCASE(182)/'G5PP'/
      DATA (INAME(182,J),J=1,4)/'HOSK','GENE','LOGI','    '/
      DATA INCASE(183)/'G5PP'/
      DATA (INAME(183,J),J=1,4)/'TYPE','5   ','GENE','LOGI'/
      DATA INCASE(184)/'G5PP'/
      DATA (INAME(184,J),J=1,4)/'TYPE','V   ','GENE','LOGI'/
      DATA INCASE(185)/'G2PP'/
      DATA (INAME(185,J),J=1,4)/'GENE','LOGI','TYPE','2   '/
      DATA INCASE(186)/'G2PP'/
      DATA (INAME(186,J),J=1,4)/'GENE','LOGI','TYPE','II  '/
      DATA INCASE(187)/'G2PP'/
      DATA (INAME(187,J),J=1,4)/'TYPE','2   ','GENE','LOGI'/
      DATA INCASE(188)/'G2PP'/
      DATA (INAME(188,J),J=1,4)/'TYPE','II  ','GENE','LOGI'/
      DATA INCASE(189)/'G3PP'/
      DATA (INAME(189,J),J=1,4)/'GENE','LOGI','TYPE','3   '/
      DATA INCASE(190)/'G3PP'/
      DATA (INAME(190,J),J=1,4)/'GENE','LOGI','TYPE','III '/
      DATA INCASE(191)/'G3PP'/
      DATA (INAME(191,J),J=1,4)/'TYPE','3   ','GENE','LOGI'/
      DATA INCASE(192)/'G3PP'/
      DATA (INAME(192,J),J=1,4)/'TYPE','III ','GENE','LOGI'/
      DATA INCASE(193)/'G4PP'/
      DATA (INAME(193,J),J=1,4)/'GENE','LOGI','TYPE','4   '/
      DATA INCASE(194)/'G4PP'/
      DATA (INAME(194,J),J=1,4)/'GENE','LOGI','TYPE','IV  '/
      DATA INCASE(195)/'G4PP'/
      DATA (INAME(195,J),J=1,4)/'TYPE','4   ','GENE','LOGI'/
      DATA INCASE(196)/'G4PP'/
      DATA (INAME(196,J),J=1,4)/'TYPE','IV  ','GENE','LOGI'/
      DATA INCASE(197)/'GLPP'/
      DATA (INAME(197,J),J=1,4)/'GENE','LOGI','    ','    '/
      DATA INCASE(198)/'BEPP'/
      DATA (INAME(198,J),J=1,4)/'BETA','    ','    ','    '/
      DATA INCASE(199)/'LXPP'/
      DATA (INAME(199,J),J=1,4)/'LOG ','LAPL','    ','    '/
      DATA INCASE(200)/'AXPP'/
      DATA (INAME(200,J),J=1,4)/'ASYM','LOG ','DOUB','EXPO'/
      DATA INCASE(201)/'AXPP'/
      DATA (INAME(201,J),J=1,4)/'ASYM','LOG ','LAPL','    '/
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPCH'
      ISUBN2='SQ  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=3
C
      ICOLR=0
C
C               ***************************************
C               **  TREAT THE CHI-SQUARE GOODNESS OF FIT CASE  **
C               ***************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CHSQ')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCHSQ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL
   52 FORMAT('ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ
   53 FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
 
      DO100I=1,NUMCHS
        IROW=I
        IF(INAME(I,1).NE.ICOM)GOTO100
        DO102J=1,4
          IF(INAME(I,J).NE.'    ')GOTO102
          ITEMP=J-1
          GOTO104
  102   CONTINUE
        ITEMP=4
  104   CONTINUE
        ILASTC=0
        IF(ITEMP.GT.1)THEN
          DO108J=2,ITEMP
            IF(INAME(I,J).NE.IHARG(J-1))GOTO100
  108     CONTINUE
          ILASTC=ITEMP-1
        ENDIF
        I1=ILASTC+1
        I2=ILASTC+2
        I3=ILASTC+3
        I4=ILASTC+4
        I5=ILASTC+5
        I6=ILASTC+6
        IF(IHARG(I1).EQ.'CHI '.AND.IHARG(I2).EQ.'SQUA'.AND.
     1     IHARG(I3).EQ.'GOOD'.AND.IHARG(I4).EQ.'OF  '.AND.
     1     IHARG(I5).EQ.'FIT '.AND.IHARG(I6).EQ.'TEST')THEN
           ILASTC=I6
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'CHI '.AND.IHARG(I2).EQ.'SQUA'.AND.
     1     IHARG(I3).EQ.'GOOD'.AND.IHARG(I4).EQ.'OF  '.AND.
     1     IHARG(I5).EQ.'FIT ')THEN
           ILASTC=I5
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'CHI '.AND.IHARG(I2).EQ.'GOOD'.AND.
     1     IHARG(I3).EQ.'OF  '.AND.IHARG(I4).EQ.'FIT '.AND.
     1     IHARG(I5).EQ.'TEST')THEN
           ILASTC=I5
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'CHI '.AND.IHARG(I2).EQ.'GOOD'.AND.
     1     IHARG(I3).EQ.'OF  '.AND.IHARG(I4).EQ.'FIT ')THEN
           ILASTC=I4
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'CHIS'.AND.IHARG(I2).EQ.'GOOD'.AND.
     1     IHARG(I3).EQ.'OF  '.AND.IHARG(I4).EQ.'FIT '.AND.
     1     IHARG(I5).EQ.'TEST')THEN
           ILASTC=I5
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'CHIS'.AND.IHARG(I2).EQ.'GOOD'.AND.
     1     IHARG(I3).EQ.'OF  '.AND.IHARG(I4).EQ.'FIT ')THEN
           ILASTC=I4
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'CHI '.AND.IHARG(I2).EQ.'TEST')THEN
           ILASTC=I2
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'CHIS'.AND.IHARG(I2).EQ.'TEST')THEN
           ILASTC=I2
           GOTO112
        END IF
C
CCCCC   ICASPL='    '
CCCCC   IFOUND='NO'
CCCCC   GOTO9000
  100 CONTINUE
C
C ----------NO MATCH FOUND----------
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  112 CONTINUE
      ICASPL=INCASE(IROW)
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGA2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,A4,I8,I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               *******************************************************
C               **  STEP 4--                                         **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.           **
C               *******************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPCHSQ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A CHI-SQUARE GOODNESS OF FIT TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPCHSQ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ******************************************************
C               **  STEP 6--                                        **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS          **
C               **  INDICATES THAT THE VALUES IN THE                **
C               **  FIRST  VARIABLE ARE NOT DATA POINTS             **
C               **  BUT ALREADY-COMPUTED FREQUENCIES,               **
C               **  AND THE VALUES IN THE SECOND VARIABLE           **
C               **  ARE THE CORRESPONDING X VALUES FOR EACH         **
C               **  FREQUENCY.  IF WE HAVE THE 2-VARIABLE CASE,     **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.  **
C               ******************************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IDATSW='RAW'
      IF(NUMV2.EQ.1)IDATSW='RAW'
      IF(NUMV2.EQ.1)GOTO590
      IF(NUMV2.EQ.2)IDATSW='FREQ'
      IF(NUMV2.EQ.2)GOTO509
      IF(NUMV2.EQ.3)IDATSW='CLAS'
      IF(NUMV2.EQ.3)GOTO509
      GOTO550
C
  509 CONTINUE
      IHRIGH=IHARG(2)
      IHRIG2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLR=IVALUE(ILOCV)
      NRIGHT=IN(ILOCV)
      IF(IBUGA2.EQ.'ON')WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT
  511 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NRIGHT.NE.NLEFT)GOTO570
      IF(NUMV2.GT.2)GOTO519
      GOTO590
C
  519 CONTINUE
      IHTHIR=IHARG(3)
      IHTHI2=IHARG2(3)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHTHIR,IHTHI2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOL3=IVALUE(ILOCV)
      NRIGH2=IN(ILOCV)
      IF(IBUGA2.EQ.'ON')WRITE(ICOUT,521)IHTHIR,IHTHI2,ICOL3,NRIGH2
  521 FORMAT('IHTHIR,IHTHI2,ICOL3,NRIGH2 = ',A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  530 CONTINUE
C
      IF(NRIGH2.NE.NLEFT)GOTO570
      GOTO590
C
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPCHSQ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A ... CHI-SQUARE GOODNESS OF FIT TEST, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,559)
  559 FORMAT('      MUST BE EITHER 1, 2, OR 3  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  560 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,561)
  561 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)NUMV2
  562 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,564)(IANS(I),I=1,MIN(IWIDTH,80))
  564 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPCHSQ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A ... CHI-SQUARE GOODNESS OF FIT TEST, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)
  578 FORMAT('      WHEN HAVE 2 (OR 3) VARIABLES SPECIFIED, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,580)
  580 FORMAT('      IN THE 2 (OR 3) VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      THE FIRST  VARIABLE  (FREQUENCIES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,IHLEF2,NLEFT
  584 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)
  585 FORMAT('      THE SECOND VARIABLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHRIGH,IHRIG2,NRIGHT
  586 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.GE.3)THEN
      WRITE(ICOUT,1585)
 1585 FORMAT('      THE THIRD VARIABLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1586)IHTHIR,IHTHI2,NRIGH2
 1586 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  (BASED ON THE QUALIFIER)           **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IF(NUMV2.GE.1)THEN
        IJ=MAXN*(ICOLL-1)+I
        IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
        IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
        IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
        IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
        IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
        IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
        IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
      ENDIF
C
      IF(NUMV2.GE.2)THEN
        IJ=MAXN*(ICOLR-1)+I
        IF(ICOLR.LE.MAXCOL)X1(J)=V(IJ)
        IF(ICOLR.EQ.MAXCP1)X1(J)=PRED(I)
        IF(ICOLR.EQ.MAXCP2)X1(J)=RES(I)
        IF(ICOLR.EQ.MAXCP3)X1(J)=YPLOT(I)
        IF(ICOLR.EQ.MAXCP4)X1(J)=XPLOT(I)
        IF(ICOLR.EQ.MAXCP5)X1(J)=X2PLOT(I)
        IF(ICOLR.EQ.MAXCP6)X1(J)=TAGPLO(I)
      ENDIF
C
      IF(NUMV2.GE.3)THEN
        IJ=MAXN*(ICOL3-1)+I
        IF(ICOL3.LE.MAXCOL)X2(J)=V(IJ)
        IF(ICOL3.EQ.MAXCP1)X2(J)=PRED(I)
        IF(ICOL3.EQ.MAXCP2)X2(J)=RES(I)
        IF(ICOL3.EQ.MAXCP3)X2(J)=YPLOT(I)
        IF(ICOL3.EQ.MAXCP4)X2(J)=XPLOT(I)
        IF(ICOL3.EQ.MAXCP5)X2(J)=X2PLOT(I)
        IF(ICOL3.EQ.MAXCP6)X2(J)=TAGPLO(I)
      ENDIF
C
  660 CONTINUE
      NLOCAL=J
C
C               ***********************************************
C               **  STEP 8--                                 **
C               **  FOR THOSE DISTRIBUTIONS REQUIRING THEM,  **
C               **  DETERMINE IF THE ANALYST                 **
C               **  HAS SPECIFIED PARAMETER VALUES           **
C               ***********************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'LAPP')THEN
        IHP='LAMB'
        IHP2='DA  '
        IDIST='LAMBDA'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TPP')THEN
        IHP='NU  '
        IHP2='    '
        IDIST='T'
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'CSPP')THEN
        IHP='NU  '
        IHP2='    '
        IDIST='CHI-SQUARED'
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'FPP')THEN
        IHP='NU1 '
        IHP2='    '
        IDIST='F     '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU1,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='NU2 '
        IHP2='    '
        CALL PARCHI(IHP,IHP2,IDIST,NU2,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GAPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='GAMMA'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BEPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='BETA'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BNPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='BETA'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'WEPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='WEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'E2PP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='EXTREME VALUE TYPE 2'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PAPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='PARETO'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          A=1.0
        ELSE
          A=VALUE(ILOCP)
        ENDIF
C
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BIPP')THEN
        IHP='N   '
        IHP2='    '
        IDIST='BINOMIAL'
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NPAR,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='P   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GEPP')THEN
        IHP='P   '
        IHP2='    '
        IDIST='GEOMETRIC'
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'POPP')THEN
        IHP='LAMB'
        IHP2='DA  '
        IDIST='POISSON'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NBPP')THEN
        IDIST='NEGATIVE BINOMIAL'
        IHP='K   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='P   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'IGPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='INVERSE GAUSSIAN'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='MU  '
        IHP2='    '
        IDIST='INVERSE GAUSSIAN'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AMU=1.0
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'WAPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='WALD'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'RIPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='RECIRPOCAL INVERSE GAUSSIAN'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='MU  '
        IHP2='    '
        IDIST='RECIPROCAL INVERSE GAUSSIAN'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AMU=1.0
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'FLPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='FATIGUE LIFE'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GPPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='GENERALIZED PARETO'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TRPP')THEN
        IHP='C   '
        IHP2='    '
        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
          C=0.0
        ELSE
          C=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DUPP')THEN
        IHP='N   '
        IHP2='    '
        IDIST='T'
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NDUN,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NCBP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='NON-CENTRAL BETA'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NCPP')THEN
        IHP='NU  '
        IHP2='    '
        IDIST='NON-CENTRAL CHI-SQUARED'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NFPP')THEN
        IHP='NU1 '
        IHP2='    '
        IDIST='NON-CENTRAL F'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='NU2 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NTPP')THEN
        IHP='NU  '
        IHP2='    '
        IDIST='NON-CENTRAL T'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DNCF')THEN
        IHP='NU1 '
        IHP2='    '
        IDIST='DOUBLY NON-CENTRAL F'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='NU2 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA2 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DNCT')THEN
        IHP='NU  '
        IHP2='    '
        IDIST='DOUBLY NON-CENTRAL T'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA2 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'HYPP')THEN
        IHP='M   '
        IHP2='    '
        IDIST='HYPERGEOMETRIC'
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,MPAR,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='N   '
        IHP2='    '
        ILOWLM=1
        IUPPLM=MPAR
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NPAR,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='K   '
        IHP2='    '
        ILOWLM=1
        IUPPLM=MPAR
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,K,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'VMPP')THEN
        IHP='B   '
        IHP2='    '
        IDIST='VON MISES'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PNPP')THEN
        IHP='P   '
        IHP2='    '
        IDIST='POWER NORMAL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PLPP')THEN
        IHP='P   '
        IHP2='    '
        IDIST='POWER LOG-NORMAL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'ALPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='ALPHA'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LNPP')THEN
        IHP='SIGM'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SIGMA=1.0
        ELSE
          SIGMA=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PFPP')THEN
        IDIST='POWER FUNCTION'
        IHP='C   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'CHPP')THEN
        IDIST='CHI'
        IHP='NU  '
        IHP2='    '
        IDIST='CHI'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DLPP')THEN
        IDIST='LOGARITMIC SERIES'
        IHP='THET'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LLPP')THEN
        IHP='DELT'
        IHP2='A   '
        IDIST='LOG-LOGISTIC'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,DELTA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GGPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='GENERALIZED GAMMA'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='C   '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IF(C.NE.0.0)GOTO4829
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4821)
 4821     FORMAT('***** ERROR IN DPCHSQ--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4822)
 4822     FORMAT('      THE SPECIFIED SHAPE PARAMETER C')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4823)
 4823     FORMAT('      FOR THE GENERALIZED GAMMA DISTRIBUTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4824)
 4824     FORMAT('      CANNOT BE EQUAL TO 0;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4825)
 4825     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4826)C
 4826     FORMAT('      THE SPECIFIED VALUE OF C = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 4829   CONTINUE
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'YUPP')THEN
        IDIST='YULE'
        IHP='P   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'WRPP')THEN
        IHP='C   '
        IHP2='    '
        IDIST='WARING'
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          A=1.0
        ELSE
          A=VALUE(ILOCP)
        ENDIF
C
        IF(A.LT.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4911)
 4911 FORMAT('***** ERROR IN DPCHSQ--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4912)
 4912 FORMAT('      THE SPECIFIED SHAPE PARAMETER A FOR THE WARING ',
     1'DISTRIBUTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4913)
 4913 FORMAT('      MUST BE GREATER THAN OR EQUAL TO 1 ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4914)
 4914 FORMAT('      FOR THE CHI-SQUARE GOODNESS OF FIT;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4915)
 4915 FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4916)A
 4916 FORMAT('      THE SPECIFIED VALUE OF A = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'FNPP')THEN
        IHP='MU  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AM=0.0
        ELSE
          AM=VALUE(ILOCP)
        ENDIF
C
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TNPP')THEN
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          A=-99.9
        ELSE
          A=VALUE(ILOCP)
        ENDIF
C
        IHP='B   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          B=-99.9
        ELSE
          B=VALUE(ILOCP)
        ENDIF
C
        IHP='M   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AM=0.0
        ELSE
          AM=VALUE(ILOCP)
        ENDIF
C
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LGPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='LOG-GAMMA'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GOPP')THEN
        IHP='C   '
        IHP2='    '
        IDIST='GOMPERTZ'
        ALOWLM=1.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='B   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GVPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='GENERALIZED EXTREME VALUE'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
CCCCC MAY 2005.  FOLLOWING SHOULD BE FOR GENERALIZED HALF-LOGISTIC,
CCCCC            NOT REGULAR HALF-LOGISITC.
C
CCCCC IF(ICASPL.EQ.'HLPP')THEN
      IF(ICASPL.EQ.'GZPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='GENERALIZED HALF-LOGISTIC'
        ALOWLM=0.0
        AUPPLM=5.0
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'P2PP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='PARETO TYPE 2'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          A=1.0
        ELSE
          A=VALUE(ILOCP)
        ENDIF
C
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DWPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='DOUBLE WEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'WCPP')THEN
        IHP='P   '
        IHP2='    '
        IDIST='WRAPPED CAUCHY'
        ALOWLM=0.
        AUPPLM=1.
        LOWLTY='>=  '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'EWPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='EXPONENTIATED WEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='THET'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TEPP')THEN
        IHP='X0  '
        IHP2='    '
        IDIST='TRUNCATED EXPONENTIAL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,X0,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='M   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AM=0.0
        ELSE
          AM=VALUE(ILOCP)
        ENDIF
C
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GLPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='GENERALIZED LOGISTIC'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'G2PP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='GENERALIZED LOGISTIC TYPE 2'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'G3PP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='GENERALIZED LOGISTIC TYPE 3'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'G4PP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 4'
        IHP='P   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='Q   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,Q,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'G5PP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 5 (HOSKING)'
C
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'WAKE')THEN
        IDIST='WAKEBY'
C
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='DELT'
        IHP2='A   '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,DELTA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PEPP')THEN
        IDIST='EXPONENTIAL POWER'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DGPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='DOUBLE GAMMA'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'KAPP')THEN
        IHP='BETA'
        IHP2='    '
        IDIST='MIELKE BETA-KAPPA'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='THET'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='K   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'FCPP')THEN
        IHP='LOC '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AM=0.0
        ELSE
          AM=VALUE(ILOCP)
        ENDIF
C
        IHP='SCAL'
        IHP2='E   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BBPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='BETA-BINOMIAL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='N   '
        IHP2='    '
        ILOWLM=0
        IUPPLM=I1MACH(9)
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PZPP')THEN
        IDIST='POLYA'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='N   '
        IHP2='    '
        ILOWLM=0
        IUPPLM=I1MACH(9)
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BRPP')THEN
        IHP='BETA'
        IHP2='    '
        IDIST='BRADFORD'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GXPP')THEN
        IHP='LAMB'
        IHP2='DA1 '
        IDIST='GENERALIZED EXPONENTIAL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA2 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='S   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'REPP')THEN
        IHP='B   '
        IHP2='    '
        IDIST='RECIPROCAL'
        ALOWLM=1.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NMPP')THEN
        IHP='U1  '
        IHP2='    '
        IDIST='NORMAL MIXTURE'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,U1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='U2  '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,U2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='SD1 '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,SD1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='SD2 '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,SD2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='P   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GIPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='INVERTED GAMMA'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'IWPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='INVERTED WEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LXPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='LOG DOUBLE EXPONENTIAL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'AXPP')THEN
        IDIST='ASYMMETRIC LOG DOUBLE EXPONENTIAL'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'JUPP')THEN
        IHP='ALPH'
        IHP2='A1  '
        IDIST='JOHNSON SU'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='ALPH'
        IHP2='A2  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'JBPP')THEN
        IHP='ALPH'
        IHP2='A1  '
        IDIST='JOHNSON SB'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='ALPH'
        IHP2='A2  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LDPP')THEN
        IHP='LAMB'
        IHP2='DA3 '
        IDIST='GENERALIZED TUKEY-LAMBDA'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALAMB3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA4 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALAMB4,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
CCCCC   IWRITE='OFF'
CCCCC   ZSCALE=1.0
CCCCC   CALL GLDCHK(ALAMB3,ALAMB4,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC   IF(ISIGN.LT.0)ZSCALE=-1.0
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'EEPP')THEN
        IHP='GAMM'
        IHP2='A   '
        IDIST='GEOMETRIC EXTREME EXPONENTIAL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'ERPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='ERROR (EXPONENTIAL POWER)'
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'TSPP')THEN
        IHP='THET'
        IHP2='A   '
        IDIST='TWO-SIDED POWER'
        ALOWLM=0.
        AUPPLM=1.0
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='N   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BWPP')THEN
        IHP='SCAL'
        IHP2='E1  '
        IDIST='BIWEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,SCALE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='SCAL'
        IHP2='E2  '
        IDIST='BIWEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,SCALE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='GAMM'
        IHP2='A1  '
        IDIST='BIWEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='GAMM'
        IHP2='A2  '
        IDIST='BIWEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LOC2'
        IHP2='    '
        IDIST='BIWEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,LOC2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'TZPP')THEN
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        A=VALUE(ILOCP)
C
        IHP='B   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        B=VALUE(ILOCP)
C
        IHP='C   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        C=VALUE(ILOCP)
C
        IHP='D   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        DZ=VALUE(ILOCP)
C
        IF(A.GE.B .OR. B.GE.C .OR. C.GE.DZ)THEN
          WRITE(ICOUT,7312)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7313)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7314)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7316)A,B,C,DZ
          CALL DPWRST('XXX','BUG ')
          PDF=0.0
          GOTO9000
        ENDIF
 7312   FORMAT(
     1'***** FATAL ERROR--FOR THE TRAPEZOID DISTRIBUTION, THE FOUR')
 7313   FORMAT(
     1'      SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
 7314   FORMAT(
     1'         A < B < C < D')
 7316   FORMAT(
     1'      A, B, C, D = ',4E15.7)
C
      ENDIF
C
      IF(ICASPL.EQ.'GTPP')THEN
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        A=VALUE(ILOCP)
C
        IHP='B   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        B=VALUE(ILOCP)
C
        IHP='C   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        C=VALUE(ILOCP)
C
        IHP='D   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        DZ=VALUE(ILOCP)
C
        IHP='ALPH'
        IHP2='A   '
        IDIST='GENERALIZED TRAPEZOID'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU1 '
        IHP2='    '
        IDIST='GENERALIZED TRAPEZOID'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU3 '
        IHP2='    '
        IDIST='GENERALIZED TRAPEZOID'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IF(A.GE.B .OR. B.GE.C .OR. C.GE.DZ)THEN
          WRITE(ICOUT,7322)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7323)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7324)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7326)A,B,C,DZ
          CALL DPWRST('XXX','BUG ')
          PDF=0.0
          GOTO9000
        ENDIF
 7322   FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALZIED TRAPEZOID DISTRIBUTION,')
 7323   FORMAT(
     1'      THE FOUR SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
 7324   FORMAT(
     1'         A < B < C < D')
 7326   FORMAT(
     1'      A, B, C, D = ',4E15.7)
C
      ENDIF
C
      IF(ICASPL.EQ.'FTPP')THEN
        IHP='NU  '
        IHP2='    '
        IDIST='FOLDED T'
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        NU=INT(ANU+0.5)
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'SNPP')THEN
        IHP='LAMB'
        IHP2='DA  '
        IDIST='SKEWED NORMAL'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'STPP')THEN
        IHP='NU  '
        IHP2='    '
        IDIST='SKEWED T'
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        NU=INT(ANU+0.5)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA  '
        IDIST='SKEWED NORMAL'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'IBPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='INVERTED BETA'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GMPP')THEN
        IF(IMAKDF.EQ.'DLMF')THEN
          IDIST='GOMPERTZ-MAKEHAM'
          IHP='XI  '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,XI,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          IHP='LAMB'
          IHP2='DA  '
          CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          LOWLTY='>=  '
          IHP='THET'
          IHP2='A   '
          CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
        ELSEIF(IMAKDF.EQ.'MEEK')THEN
          IDIST='GOMPERTZ-MAKEHAM'
          IHP='GAMM'
          IHP2='A   '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          LOWLTY='>=  '
          IHP='LAMB'
          IHP2='DA  '
          CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          LOWLTY='>   '
          IHP='K   '
          IHP2='    '
          CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
        ELSEIF(IMAKDF.EQ.'REPA')THEN
          IDIST='GOMPERTZ-MAKEHAM'
          IHP='ETA '
          IHP2='    '
          ALOWLM=CPUMIN
          AUPPLM=CPUMAX
          LOWLTY='>=  '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,ETA,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>=  '
          UPPLTY='<=  '
          IHP='ZETA'
          IHP2='    '
          CALL PARCHR(IHP,IHP2,IDIST,ZETA,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
        ENDIF
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GIGP')THEN
        IHP='CHI '
        IHP2='    '
        IDIST='GOMPERTZ-MAKEHAM'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,CHI,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        IHP='THET'
        IHP2='A   '
        LOWLTY='>=  '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GHPP')THEN
        IHP='G   '
        IHP2='    '
        IDIST='G-H'
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,G,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ALOWLM=0.0
        IHP='H   '
        IHP2='    '
        CALL PARCHR(IHP,IHP2,IDIST,H,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'HEPP')THEN
        IHP='ALPH'
        IHP2='A   '
        IDIST='HERMITE'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'SDPP')THEN
        IDIST='SKEWED DOUBLE EXPONENTIAL'
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'ADPP')THEN
        IDIST='ASYMMETRIC DOUBLE EXPONENTIAL'
        IF(IADEDF.EQ.'K')THEN
          IHP='K   '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO4999
        ELSE
          IHP='MU  '
          IHP2='    '
          ALOWLM=CPUMIN
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO4999
        ENDIF
      ENDIF
C
      IF(ICASPL.EQ.'MXPP')THEN
        IDIST='MAXWELL'
        IHP='SIGM'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,SIGMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GALP')THEN
        IDIST='GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL'
        IF(IADEDF.EQ.'K')THEN
          IHP='K   '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          IHP='TAU '
          IHP2='    '
          CALL PARCHR(IHP,IHP2,IDIST,TAU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ELSE
          IHP='MU  '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ENDIF
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'MCPP')THEN
        IDIST='MCLEISH'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GMCP')THEN
        IDIST='GENERALIZED MCLEISH'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='A   '
        IHP2='    '
        ALOWLM=-1.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,A,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'BEIP' .OR. ICASPL.EQ.'BEKP')THEN
        IDIST='BESSEL I-FUNCTION'
        IF(ICASPL.EQ.'BEKP')IDIST='BESSEL K-FUNCTION'
        IF(IBEIDF.EQ.'1')THEN
          IHP='SIGM'
          IHP2='A1SQ'
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,SD1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='SIGM'
          IHP2='A2SQ'
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,SD2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='NU  '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO4999
        ELSE
          IHP='B   '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='C   '
          IHP2='    '
          ALOWLM=1.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='M   '
          IHP2='    '
          ALOWLM=0.5
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,AM,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO4999
        ENDIF
      ENDIF
C
 4999 CONTINUE
C
C  LOCATION AND SCALE FOR ALL DISTRIBUTIONS
C
      IHP='CHSL'
      IHP2='OC  '
      IHWUSE='P'
      MESSAG='NO '
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        CHSLOC=0.0
      ELSE
        CHSLOC=VALUE(ILOCP)
      ENDIF
C
      IHP='CHSS'
      IHP2='CALE'
      IHWUSE='P'
      MESSAG='NO '
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        CHSCAL=1.0
      ELSE
        CHSCAL=VALUE(ILOCP)
      ENDIF
      IF(CHSCAL.LE.0.0)CHSCAL=1.0
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  COMPUTE THE CHI-SQUARE GOODNESS OF FIT         **
C               **  TEST                                           **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5111)
 5111 FORMAT('***** FROM THE MIDDLE  OF DPCHSQ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5112)ICASPL,NUMV2,NLOCAL,IDATSW
 5112 FORMAT('ICASPL,NUMV2,NLOCAL,IDATSW = ',A4,I8,2X,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5113)ALAMBA,NU,NU1,NU2
 5113 FORMAT('ALAMBA,NU,NU1,NU2 = ',E15.7,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5114)GAMMA,ALPHA,BETA,NPAR,P,K
 5114 FORMAT('GAMMA,ALPHA,BETA,NPAR,P,K = ',3E15.7,I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      DO5116I=1,NLOCAL
      WRITE(ICOUT,5117)I,X1(I),Y1(I)
 5117 FORMAT('I,X1(I),Y1(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5116 CONTINUE
 5190 CONTINUE
C
      CLWID=CLWIDT(1)
      XSTART=CLLIMI(1)
      XSTOP=CLLIMI(2)
      IWRITE='ON'
C
      CALL DPCHS2(Y1,X1,X2,NLOCAL,ICASPL,IDATSW,IRHSTG,
     1ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,NPAR,P,K,MINMAX,
     1ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,MPAR,B,SD,THETA,DELTA,A,AM,X0,
     1U1,SD1,U2,SD2,DZ,ANU3,
     1ALAMB3,ALAMB4,ALPHA1,ALPHA2,
CCCCC MAY 2002: ADD FOLLOWING LINE
     1SCALE1,GAMMA1,LOC2,SCALE2,GAMMA2,
     1AMU,XI,CHI,G,H,AK,SIGMA,
     1ETA,ZETA,TAU,Q,
     1CLWID,XSTART,XSTOP,
     1XTEMP3,IHSTCW,MAXOBV,
     1CHSLOC,CHSCAL,
     1STATVA,STATCD,STATNU,CUTU90,CUTU95,CUTU99,
     1ICAPSW,ICAPTY,IWRITE,IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1ILGADF,ISKNDF,IGLDDF,
     1YOBS,XTEMP,XTEMP2,YEXP,NFREQ,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  WRITE INFO TO FILE               **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='FIT2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IF(NUMV2.LE.2)THEN
      DO6101I=1,NFREQ
      WRITE(IOUNI1,6109)I,XTEMP(I),YOBS(I),YEXP(I)
 6101 CONTINUE
 6109 FORMAT(I6,1X,3E15.7)
      ELSEIF(NUMV2.EQ.3)THEN
      DO6111I=1,NFREQ
      WRITE(IOUNI1,6112)I,XTEMP(I),XTEMP2(I),YOBS(I),YEXP(I)
 6111 CONTINUE
 6112 FORMAT(I6,1X,4E15.7)
      ENDIF
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(IPRINT.EQ.'OFF')GOTO6119
      IF(NUMV2.LE.2)THEN
      WRITE(ICOUT,6120)
 6120 FORMAT(6X,'CELL NUMBER, BIN MIDPOINT, OBSERVED FREQUENCY, ',
     1'AND EXPECTED FREQUENCY ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6121)
 6121 FORMAT(6X,'WRITTEN TO FILE DPST1F.DAT')
      CALL DPWRST('XXX','BUG ')
      ELSEIF(NUMV2.EQ.3)THEN
      WRITE(ICOUT,6122)
 6122 FORMAT(6X,'CELL NUMBER, LOWER BIN POINT, UPPER BIN POINT, ',
     1'OBSERVED FREQUENCY, AND EXPECTED FREQUENCY ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6123)
 6123 FORMAT(6X,'WRITTEN TO FILE DPST1F.DAT')
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
 6119 CONTINUE
C
C               ***************************************
C               **  STEP 7--                         **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPCH'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='NU  '
      VALUE0=STATNU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP90'
      VALUE0=CUTU90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP95'
      VALUE0=CUTU95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP99'
      VALUE0=CUTU99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCHSQ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NS,ICASPL
 9013 FORMAT('NS,ICASPL = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ALAMBA,NU,NU1,NU2
 9014 FORMAT('ALAMBA,NU,NU1,NU2 = ',E15.7,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)GAMMA,ALPHA,BETA,NPAR,P,K
 9015 FORMAT('GAMMA,ALPHA,BETA,NPAR,P,K = ',3E15.7,I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)MINMAX
 9016 FORMAT('MINMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)ALPHA,BETA
 9017 FORMAT('ALPHA,BETA = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCHS2(Y,X,Z,N,ICASPL,IDATSW,IRHSTG,
     1ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,NPAR,P,K,MINMAX,
     1ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,MPAR,B,SD,THETA,DELTA,A,AM,X0,
     1U1,SD1,U2,SD2,DZ,ANU3,
     1ALAMB3,ALAMB4,ALPHA1,ALPHA2,
CCCCC MAY 2002: ADD FOLLOWING LINE
     1ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,
     1AMU,XI,CHI,G,H,AK,SIGMA,
     1ETA,ZETA,TAU,Q,
     1CLWID,XSTART,XSTOP,
     1XTEMP3,IHSTCW,MAXOBV,
     1CHSLOC,CHSCAL,
     1STATVA,STATCD,STATNU,CUTU90,CUTU95,CUTU99,
     1ICAPSW,ICAPTY,IWRIT2,IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1ILGADF,ISKNDF,IGLDDF,
     1Y2,X2,Z2,D2,N2,IBUGA3,IERROR)
C
C     PURPOSE--COMPUTE A CHI-SQUARE GOODNESS OF FIT TEST
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/11
C     ORIGINAL VERSION--NOVEMBER  1998.
C     UPDATED         --OCTOBER   2001.
C     UPDATED         --NOVEMBER  2001.  GEOMETRIC EXTREME EXPONENTIAL
C     UPDATED         --MAY       2003.  LANDAU
C     UPDATED         --MAY       2003.  ERROR (=EXPONENTIAL POWER)
C     UPDATED         --JUNE      2003.  TRAPEZOID
C     UPDATED         --JUNE      2003.  GENERALIZED TRAPEZOID
C     UPDATED         --OCTOBER   2003.  ADD SUPPORT FOR HTML, LATEX
C     UPDATED         --NOVEMBER  2003.  FOLDED T
C     UPDATED         --DECEMBER  2003.  SUPPORT FOR MU PARAMETER FOR
C                                        INVERSE GAUSSIAN
C     UPDATED         --DECEMBER  2003.  SKEWED NORMAL, SKEWED T,
C                                        SLASH, INVERTED BETA,
C                                        GOMPERTZ-MAKEHAM, G-H
C     UPDATED         --MARCH     2004.  LOG SKEWED NORMAL
C                                        LOG SKEWED T
C     UPDATED         --APRIL     2004.  HERMITE, YULE
C     UPDATED         --JUNE      2004.  SKEWED DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004.  ASYMMETRIC DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004.  MAXWELL, RAYLEIGH
C     UPDATED         --JULY      2004.  FOR DISCRETE DISTRIBUTIONS
C                                        WHERE CDF COMPUTED BY
C                                        SUMMING PDF, KEEP RUNNING
C                                        TO COMPUTE CDF FOR BETTER
C                                        EFFICIENCY
C     UPDATED         --JULY      2004.  ALTERNATE DEFINITION FOR
C                                        GOMPERTZ-MAKEHAM
C     UPDATED         --AUGUST    2004.  MCLEISH
C     UPDATED         --AUGUST    2004.  BESSEL I-FUNCTION
C     UPDATED         --SEPTEMBER 2004.  GENERALIZED MCLEISH
C     UPDATED         --DECEMBER  2004.  FOR A FEW DISCRETE
C                                        DISTRIBUTIONS WHERE THE CDF
C                                        IS COMPUTED BY BRUTE FORCE
C                                        (YULE, WARING, BETA-BINOMIAL,
C                                        POLYA), USE DIFFERENT METHOD
C                                        FOR COMPUTING CDF FUNCTION
C     UPDATED         --JULY      2005.  CALL LIST TO LCACDF AND SNCDF
C     UPDATED         --FEBRUARY  2006. GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006. WAKEBY
C     UPDATED         --FEBRUARY  2006. FMKL PARAMETERIZATION OF
C                                       GENERALIZED TUKEY LAMBDA
C     UPDATED         --MARCH     2006. SUPPORT FOR DIFFERENT DEFAULT
C                                       BINNING ALGORITHMS
C     UPDATED         --MARCH     2006. BETA-NORMAL
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 2
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 3
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 4
C     UPDATED         --MARCH     2006. ASYMMETRIC LOG DOUBLE
C                                       EXPONENTIAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      LOGICAL POINT
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IDATSW
      CHARACTER*4 IHSTCW
      CHARACTER*4 IRHSTG
      CHARACTER*4 IBUGA3
      CHARACTER*4 IWRITE
      CHARACTER*4 IWRIT2
      CHARACTER*4 IADEDF
      CHARACTER*4 IGEPDF
      CHARACTER*4 IMAKDF
      CHARACTER*4 IBEIDF
      CHARACTER*4 ILGADF
      CHARACTER*4 ISKNDF
      CHARACTER*4 IGLDDF
      CHARACTER*4 IERROR
C
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IRELAT
      CHARACTER*4 IDISFL
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
      CHARACTER*50 IDIST
C
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DTEMP1
      DOUBLE PRECISION DTEMP2
      DOUBLE PRECISION DOUT1
      DOUBLE PRECISION DOUT2
      DOUBLE PRECISION DCDFL
      DOUBLE PRECISION DCDFU
      DOUBLE PRECISION CDFGLO
      DOUBLE PRECISION CDFWAK
      DOUBLE PRECISION XPAR(5)
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Z(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
      DIMENSION Z2(*)
      DIMENSION XTEMP3(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA PI/3.141593/
C
C-----START POINT-----------------------------------------------------
C
C
      ISUBN1='DPCH'
      ISUBN2='S2  '
C
      IRELAT='OFF'
      IERROR='NO'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPCHS2--')
      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 DPCHS2--')
      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 DPCHS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL INPUT VERTICAL AXIS ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPCHS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,IDATSW,N
   72 FORMAT('ICASPL,IDATSW,N, = ',A4,2X,A4,2X,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)ALAMBA,NU,NU1,NU2
   73 FORMAT('ALAMBA,NU,NU1,NU2 = ',E15.7,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)GAMMA,ALPHA,BETA,NPAR,P,K
   74 FORMAT('GAMMA,ALPHA,BETA,NPAR,P,K = ',3E15.7,I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1993
      WRITE(ICOUT,75)MINMAX
   75 FORMAT('MINMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO80
      DO85I=1,N
      WRITE(ICOUT,86)I,Y(I),X(I)
   86 FORMAT('I,Y(I),X(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   85 CONTINUE
   80 CONTINUE
C
C               **************************************
C               **  STEP 4--                        **
C               **  IF DATA NOT ALREADY BINNED, THEN**
C               **  BIN THE DATA                    **
C               **************************************
C
      IDISFL='CONT'
      ILOWLM=0
      IF(ICASPL.EQ.'BIPP' .OR. ICASPL.EQ.'GEPP' .OR.
     1   ICASPL.EQ.'POPP' .OR. ICASPL.EQ.'NBPP '.OR.
     1   ICASPL.EQ.'DUPP' .OR. ICASPL.EQ.'HYPP' .OR.
     1   ICASPL.EQ.'BBPP' .OR. ICASPL.EQ.'PZPP' .OR.
     1   ICASPL.EQ.'HEPP' .OR. ICASPL.EQ.'YUPP' .OR.
     1   ICASPL.EQ.'DLPP' .OR. ICASPL.EQ.'WRPP')THEN
        IDISFL='DISC'
        IF(ICASPL.EQ.'DLPP')ILOWLM=1
      ENDIF
C
      IF(IDATSW.EQ.'RAW')THEN
        AN=REAL(N)
        IF(IDISFL.EQ.'CONT')THEN
          CALL DPBIN(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1               XTEMP3,MAXOBV,IHSTCW,
     1               Y2,X2,N2,IBUGA3,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ELSE
          CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1               Y2,X2,N2,IBUGA3,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ENDIF
        CALL SORTC(X2,Y2,N2,X2,Y2)
      ELSEIF(IDATSW.EQ.'FREQ')THEN
        AN=0.0
        DO1009I=1,N
          AN=AN+Y(I)
          Y2(I)=Y(I)
          X2(I)=X(I)
 1009   CONTINUE
        N2=N
      ELSEIF(IDATSW.EQ.'CLAS')THEN
        AN=0.0
        DO1019I=1,N
          AN=AN+Y(I)
          Y2(I)=Y(I)
          X2(I)=X(I)
          Z2(I)=Z(I)
 1019   CONTINUE
        N2=N
        DO1029I=1,N2
          IF(X2(I).GT.Z2(I))THEN
            AJUNK=X2(I)
            X2(I)=Z2(I)
            Z2(I)=AJUNK
          ENDIF
 1029   CONTINUE
        CALL SORTC(X,X2,N2,D2,X2)
        CALL SORTC(X,Y2,N2,D2,Y2)
        CALL SORTC(X,Z2,N2,D2,Z2)
      ELSE
        AN=REAL(N)
        CALL DPBIN(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1               XTEMP3,MAXOBV,IHSTCW,
     1             Y2,X2,N2,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        CALL SORTC(X2,Y2,N2,X2,Y2)
      ENDIF
C
C               ****************************************
C               **  STEP 4.1--                        **
C               **  COMPUTE CHI-SQUARE OBSERVED AND   **
C               **  EXPECTED                          **
C               ****************************************
C
 1100 CONTINUE
C
      DSUM1=0.0D0
      CLWIDT=X2(2)-X2(1)
      NUMPAR=0
      NEMPTY=0
C
C  NOTE: HANDLE DISCRETE DISTRIBUTIONS DIFFERENTLY.  FOR DISCRETE,
C        BIN MID-POINTS SHOULD BE AT INTEGER VALUES!
C  NOTE: A FEW DISCRETE DISTRIBUTIONS ARE COMPUTED BY BRUTE
C        FORCE.  FOR THESE (ESPECIALLY WHEN THE TAILS CAN BE
C        LONG), INSTEAD OF COMPUTING CDF FUNCTION, KEEP RUNNING
C        TALLY BASED ON CDF FUNCTION.  THIS AVOIDS EXCESIVE
C        REDUNDANT COMPUTATION.
C
      DCDFL=0.0D0
      DCDFU=0.0D0
      IXLPV=-1
      IXUPV=-1
C
      IF(IDISFL.EQ.'DISC')THEN
        IF(IDATSW.EQ.'CLAS')THEN
          IDIFF=0
        ELSE
          ADIFF=X2(2) - X2(1)
          IDIFF=INT(ADIFF+0.1)
        ENDIF
      ENDIF
C
      DO1199I=1,N2
C
        IF(IDISFL.EQ.'DISC')THEN
          IF(IDATSW.EQ.'CLAS')THEN
            IXL=CEILDP(X2(I))
CCCCC       IXU=FLOOR(Z2(I))
C
            ARG1=Z2(I)
            IF(ARG1.LE.0.0)THEN
              IARG2=INT(ARG1)
              ARG3=REAL(IARG2)
              ARG4=ARG1-ARG3
              TERM=ARG3
              IF(ARG4.NE.0.0)TERM=TERM-1.0
            ELSE
              IARG2=INT(ARG1)
              TERM=REAL(IARG2)
            ENDIF
            IXU=INT(TERM)
C
          ELSE
            IXU=INT(X2(I) + 0.5)
            IXL=IXU-IDIFF
          ENDIF
        ELSE
          IF(IDATSW.EQ.'CLAS')THEN
            XL=X2(I)
            XU=Z2(I)
          ELSE
            XL=X2(I) - CLWIDT/2.0
            XU=X2(I) + CLWIDT/2.0
          ENDIF
        ENDIF
        XMIN=X2(1) - CLWIDT/2.0
C
C  FOLLOWING ARE DISCRETE DISTRIBUTIONS
C
        IF(ICASPL.EQ.'BIPP')GOTO1290
        IF(ICASPL.EQ.'GEPP')GOTO1300
        IF(ICASPL.EQ.'POPP')GOTO1310
        IF(ICASPL.EQ.'NBPP')GOTO1320
        IF(ICASPL.EQ.'DUPP')GOTO1400
        IF(ICASPL.EQ.'HYPP')GOTO1470
        IF(ICASPL.EQ.'DLPP')GOTO1550
        IF(ICASPL.EQ.'WRPP')GOTO1580
        IF(ICASPL.EQ.'YUPP')GOTO1585
        IF(ICASPL.EQ.'BBPP')GOTO1790
        IF(ICASPL.EQ.'PZPP')GOTO2090
        IF(ICASPL.EQ.'HEPP')GOTO2100
C
C  FOLLOWING ARE CONTINUOUS DISTRIBUTIONS
C
        IF(ICASPL.EQ.'UNPP')GOTO1110
        IF(ICASPL.EQ.'NOPP')GOTO1120
        IF(ICASPL.EQ.'LOPP')GOTO1130
        IF(ICASPL.EQ.'DEPP')GOTO1140
        IF(ICASPL.EQ.'CAPP')GOTO1150
        IF(ICASPL.EQ.'LAPP')GOTO1160
        IF(ICASPL.EQ.'LNPP')GOTO1170
        IF(ICASPL.EQ.'HNPP')GOTO1180
        IF(ICASPL.EQ.'TPP')GOTO1190
        IF(ICASPL.EQ.'CSPP')GOTO1200
        IF(ICASPL.EQ.'FPP')GOTO1210
        IF(ICASPL.EQ.'EXPP')GOTO1220
        IF(ICASPL.EQ.'GAPP')GOTO1230
        IF(ICASPL.EQ.'BEPP')GOTO1240
        IF(ICASPL.EQ.'WEPP')GOTO1250
        IF(ICASPL.EQ.'E1PP')GOTO1260
        IF(ICASPL.EQ.'E2PP')GOTO1270
        IF(ICASPL.EQ.'PAPP')GOTO1280
        IF(ICASPL.EQ.'SEPP')GOTO1330
        IF(ICASPL.EQ.'TRPP')GOTO1340
        IF(ICASPL.EQ.'IGPP')GOTO1350
        IF(ICASPL.EQ.'WAPP')GOTO1360
        IF(ICASPL.EQ.'RIPP')GOTO1370
        IF(ICASPL.EQ.'FLPP')GOTO1380
        IF(ICASPL.EQ.'GPPP')GOTO1390
        IF(ICASPL.EQ.'NTPP')GOTO1410
        IF(ICASPL.EQ.'NFPP')GOTO1420
        IF(ICASPL.EQ.'NCPP')GOTO1430
        IF(ICASPL.EQ.'NCBP')GOTO1440
        IF(ICASPL.EQ.'DNCT')GOTO1450
        IF(ICASPL.EQ.'DNCF')GOTO1460
        IF(ICASPL.EQ.'VMPP')GOTO1480
        IF(ICASPL.EQ.'PNPP')GOTO1490
        IF(ICASPL.EQ.'PLPP')GOTO1500
        IF(ICASPL.EQ.'ALPP')GOTO1510
        IF(ICASPL.EQ.'COPP')GOTO1520
        IF(ICASPL.EQ.'PFPP')GOTO1530
        IF(ICASPL.EQ.'CHPP')GOTO1540
        IF(ICASPL.EQ.'LLPP')GOTO1560
        IF(ICASPL.EQ.'GGPP')GOTO1570
        IF(ICASPL.EQ.'ANPP')GOTO1590
        IF(ICASPL.EQ.'ARPP')GOTO1600
        IF(ICASPL.EQ.'FNPP')GOTO1610
        IF(ICASPL.EQ.'TNPP')GOTO1620
        IF(ICASPL.EQ.'LGPP')GOTO1630
        IF(ICASPL.EQ.'HSPP')GOTO1640
        IF(ICASPL.EQ.'GOPP')GOTO1650
        IF(ICASPL.EQ.'HCPP')GOTO1660
        IF(ICASPL.EQ.'HLPP')THEN
          IDIST='HALF LOGISTIC'
          GAMMA=-1.0
          GOTO1670
        ENDIF
        IF(ICASPL.EQ.'GZPP')THEN
          IDIST='GENERALIZED HALF LOGISTIC'
          GOTO1670
        ENDIF
        IF(ICASPL.EQ.'GVPP')GOTO1680
        IF(ICASPL.EQ.'P2PP')GOTO1690
        IF(ICASPL.EQ.'DWPP')GOTO1700
        IF(ICASPL.EQ.'WCPP')GOTO1710
        IF(ICASPL.EQ.'EWPP')GOTO1720
        IF(ICASPL.EQ.'TEPP')GOTO1730
        IF(ICASPL.EQ.'GLPP')GOTO1740
        IF(ICASPL.EQ.'PEPP')GOTO1750
        IF(ICASPL.EQ.'DGPP')GOTO1760
        IF(ICASPL.EQ.'KAPP')GOTO1770
        IF(ICASPL.EQ.'FCPP')GOTO1780
        IF(ICASPL.EQ.'BRPP')GOTO1800
        IF(ICASPL.EQ.'GXPP')GOTO1810
        IF(ICASPL.EQ.'REPP')GOTO1820
        IF(ICASPL.EQ.'NMPP')GOTO1830
        IF(ICASPL.EQ.'GIPP')GOTO1840
        IF(ICASPL.EQ.'IWPP')GOTO1850
        IF(ICASPL.EQ.'LXPP')GOTO1860
        IF(ICASPL.EQ.'LDPP')GOTO1870
        IF(ICASPL.EQ.'JBPP')GOTO1880
        IF(ICASPL.EQ.'JUPP')GOTO1890
        IF(ICASPL.EQ.'EEPP')GOTO1900
        IF(ICASPL.EQ.'TSPP')GOTO1910
        IF(ICASPL.EQ.'BWPP')GOTO1920
        IF(ICASPL.EQ.'LUPP')GOTO1930
        IF(ICASPL.EQ.'ERPP')GOTO1940
        IF(ICASPL.EQ.'TZPP')GOTO1950
        IF(ICASPL.EQ.'GTPP')GOTO1960
        IF(ICASPL.EQ.'FTPP')GOTO1970
        IF(ICASPL.EQ.'SLPP')GOTO1980
        IF(ICASPL.EQ.'SNPP')GOTO1990
        IF(ICASPL.EQ.'STPP')GOTO2000
        IF(ICASPL.EQ.'IBPP')GOTO2010
        IF(ICASPL.EQ.'GMPP')GOTO2020
        IF(ICASPL.EQ.'GIGP')GOTO2030
        IF(ICASPL.EQ.'GFPP')GOTO2040
        IF(ICASPL.EQ.'GHPP')GOTO2050
        IF(ICASPL.EQ.'LZPP')GOTO2060
        IF(ICASPL.EQ.'LTPP')GOTO2070
        IF(ICASPL.EQ.'ASPP')GOTO2080
        IF(ICASPL.EQ.'SDPP')GOTO2110
        IF(ICASPL.EQ.'ADPP')GOTO2120
        IF(ICASPL.EQ.'MXPP')GOTO2130
        IF(ICASPL.EQ.'RAPP')GOTO2140
        IF(ICASPL.EQ.'GALP')GOTO2150
        IF(ICASPL.EQ.'MCPP')GOTO2160
        IF(ICASPL.EQ.'BEIP')GOTO2170
        IF(ICASPL.EQ.'BEKP')GOTO2180
        IF(ICASPL.EQ.'GMCP')GOTO2190
        IF(ICASPL.EQ.'G5PP')GOTO2200
        IF(ICASPL.EQ.'WKPP')GOTO2210
        IF(ICASPL.EQ.'BNPP')GOTO2220
        IF(ICASPL.EQ.'G2PP')GOTO2230
        IF(ICASPL.EQ.'G3PP')GOTO2240
        IF(ICASPL.EQ.'G4PP')GOTO2250
        IF(ICASPL.EQ.'AXPP')GOTO2260
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1011)
 1011   FORMAT('***** ERROR DPCHS2--UNKNOWN DISTRIBUTION')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
C
 1110   CONTINUE
        IDIST='UNIFORM'
        ZSCALE=CHSCAL-CHSLOC
        XL=(XL-CHSLOC)/ZSCALE
        XU=(XU-CHSLOC)/ZSCALE
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.1.0)XU=1.0
        CALL UNICDF(XL,XOUT1)
        CALL UNICDF(XU,XOUT2)
        GOTO2990
C
 1120   CONTINUE
        IDIST='NORMAL'
        NUMPAR=2
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        CALL NORCDF(XL,XOUT1)
        CALL NORCDF(XU,XOUT2)
        GOTO2990
C
 1130   CONTINUE
        IDIST='LOGISTIC'
        NUMPAR=2
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        CALL LOGCDF(XL,XOUT1)
        CALL LOGCDF(XU,XOUT2)
        GOTO2990
C
 1140   CONTINUE
        IDIST='DOUBLE EXPONENTIAL'
        NUMPAR=2
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        CALL DEXCDF(XL,XOUT1)
        CALL DEXCDF(XU,XOUT2)
        GOTO2990
C
 1150   CONTINUE
        IDIST='CAUCHY'
        NUMPAR=2
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        CALL CAUCDF(XL,XOUT1)
        CALL CAUCDF(XU,XOUT2)
        GOTO2990
C
 1160   CONTINUE
        IDIST='TUKEY-LAMBDA'
        NUMPAR=3
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(ALAMBA.GT.0.0)THEN
          XMAX=1.0/ALAMBA
          XMIN=-XMAX
          IF(XL.LT.XMIN)XL=XMIN
          IF(XU.LT.XMIN)XU=XMIN
          IF(XL.GT.XMAX)XL=XMAX
          IF(XU.GT.XMAX)XU=XMAX
        ENDIF
        CALL LAMCDF(XL,ALAMBA,XOUT1)
        CALL LAMCDF(XU,ALAMBA,XOUT2)
        GOTO2990
C
 1170   CONTINUE
        IDIST='LOG-NORMAL'
        NUMPAR=3
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL LGNCDF(XL,SIGMA,XOUT1)
        CALL LGNCDF(XU,SIGMA,XOUT2)
        GOTO2990
C
 1180   CONTINUE
        IDIST='HALF-NORMAL'
        NUMPAR=2
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL HFNCDF(XL,XOUT1)
        CALL HFNCDF(XU,XOUT2)
        GOTO2990
C
 1190   CONTINUE
        IDIST='T'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL TCDF(XL,NU,XOUT1)
        CALL TCDF(XU,NU,XOUT2)
        GOTO2990
C
 1200   CONTINUE
        IDIST='CHI-SQUARE'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL CHSCDF(XL,NU,XOUT1)
        CALL CHSCDF(XU,NU,XOUT2)
        GOTO2990
C
 1210   CONTINUE
        IDIST='F'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL FCDF(XL,NU1,NU2,XOUT1)
        CALL FCDF(XU,NU1,NU2,XOUT2)
        GOTO2990
C
 1220   CONTINUE
        IDIST='EXPONENTIAL'
        NUMPAR=2
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL EXPCDF(XL,XOUT1)
        CALL EXPCDF(XU,XOUT2)
        GOTO2990
C
 1230   CONTINUE
        IDIST='GAMMA'
        NUMPAR=3
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL GAMCDF(XL,GAMMA,XOUT1)
        CALL GAMCDF(XU,GAMMA,XOUT2)
        GOTO2990
C
 1240   CONTINUE
        IDIST='BETA'
        NUMPAR=4
        ZSCALE=CHSCAL-CHSLOC
        XL=(XL-CHSLOC)/ZSCALE
        XU=(XU-CHSLOC)/ZSCALE
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.1.0)XU=1.0
        CALL BETCDF(XL,ALPHA,BETA,XOUT1)
        CALL BETCDF(XU,ALPHA,BETA,XOUT2)
        GOTO2990
C
 1250   CONTINUE
        IDIST='WEIBULL'
        NUMPAR=3
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL WEICDF(XL,GAMMA,MINMAX,XOUT1)
        CALL WEICDF(XU,GAMMA,MINMAX,XOUT2)
        GOTO2990
C
 1260   CONTINUE
        IDIST='EXTREME VALUE TYPE 1'
        NUMPAR=2
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        CALL EV1CDF(XL,MINMAX,XOUT1)
        CALL EV1CDF(XU,MINMAX,XOUT2)
        GOTO2990
C
 1270   CONTINUE
        IDIST='EXTREME VALUE TYPE 2'
        NUMPAR=3
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(MINMAX.EQ.1)THEN
          IF(XL.GT.0.0)XL=0.0
          IF(XU.GT.0.0)XU=0.0
        ELSEIF(MINMAX.EQ.2)THEN
          IF(XL.LT.0.0)XL=0.0
          IF(XU.LT.0.0)XU=0.0
        ENDIF
        CALL EV2CDF(XL,GAMMA,MINMAX,XOUT1)
        CALL EV2CDF(XU,GAMMA,MINMAX,XOUT2)
        GOTO2990
C
 1280   CONTINUE
        IDIST='PARETO'
        NUMPAR=4
        ZLOC=A
        IF(ZLOC.GT.XMIN)ZLOC=XMIN
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        CALL PARCDF(XL,GAMMA,ZLOC,XOUT1)
        CALL PARCDF(XU,GAMMA,ZLOC,XOUT2)
        GOTO2990
C
 1290   CONTINUE
        IDIST='BINOMIAL'
        NUMPAR=2
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTOP.GT.NPAR)ISTOP=NPAR
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1291ITEMP=ISTRT,ISTOP
C
            CALL BINCDF(REAL(ITEMP),P,NPAR,ATEMP1)
            ATEMP2=0.0
            IF(ITEMP-1.GE.ILOWLM)
     1        CALL BINCDF(REAL(ITEMP-1),P,NPAR,ATEMP2)
            ATEMP=ATEMP1-ATEMP2
C
            DCDFL=DCDFL + DBLE(ATEMP)
 1291     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   IF(IXL.GT.NPAR)THEN
CCCCC     XOUT2=0.0
CCCCC     XOUT2=0.0
CCCCC     GOTO2990
CCCCC   ENDIF
CCCCC   IF(IXH.GT.NPAR)THEN
CCCCC     IXH=NPAR
CCCCC     IF(IXL.GE.NPAR)IXL=IXH-1
CCCCC   ENDIF
CCCCC   XOUT2=0.0
CCCCC   CALL BINCDF(REAL(IXU),P,NPAR,XOUT2)
CCCCC   IF(IXL.GE.0) CALL BINCDF(REAL(IXL),P,NPAR,XOUT2)
        GOTO2990
C
 1300   CONTINUE
        IDIST='GEOMETRIC'
        NUMPAR=1
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1301ITEMP=ISTRT,ISTOP
            CALL GEOPDF(REAL(ITEMP),P,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 1301     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   XOUT2=0.0
CCCCC   CALL GEOCDF(REAL(IXU),P,XOUT2)
CCCCC   IF(IXL.GE.0) CALL GEOCDF(REAL(IXL),P,XOUT2)
        GOTO2990
C
 1310   CONTINUE
        IDIST='POISSON'
        NUMPAR=1
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1311ITEMP=ISTRT,ISTOP
C
            CALL POICDF(REAL(ITEMP),ALAMBA,ATEMP1)
            ATEMP2=0.0
            IF(ITEMP-1.GE.ILOWLM)
     1        CALL POICDF(REAL(ITEMP-1),ALAMBA,ATEMP2)
            ATEMP=ATEMP1-ATEMP2
C
            DCDFL=DCDFL + DBLE(ATEMP)
 1311     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   XOUT2=0.0
CCCCC   IF(ALAMBA.LE.60.0)THEN
CCCCC     CALL POICDF(REAL(IXU),ALAMBA,XOUT2)
CCCCC     IF(IXL.GE.0) CALL POICDF(REAL(IXL),ALAMBA,XOUT2)
CCCCC   ELSE
CCCCC     SQRTAL=SQRT(ALAMBA)
CCCCC     CALL NORCDF(REAL(IXU),XOUT2)
CCCCC     XOUT2=ALAMBA+SQRTAL*XOUT2
CCCCC     IF(IXL.GE.0)THEN
CCCCC       CALL NORCDF(REAL(IXL),XOUT2)
CCCCC       XOUT2=ALAMBA+SQRTAL*XOUT1
CCCCC     ENDIF
CCCCC   ENDIF
        GOTO2990
C
 1320   CONTINUE
        IDIST='NEGATIVE BINOMIAL'
        NUMPAR=2
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1321ITEMP=ISTRT,ISTOP
            CALL NBPDF(REAL(ITEMP),P,AK,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 1321     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   XOUT2=0.0
CCCCC   CALL NBCDF(REAL(IXU),P,AK,XOUT2)
CCCCC   IF(IXL.GE.0) CALL NBCDF(REAL(IXL),P,AK,XOUT2)
        GOTO2990
C
 1330   CONTINUE
        IDIST='SEMI-CIRCULAR'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.-1.0)XL=-1.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.-1.0)XU=-1.0
        IF(XU.GT.1.0)XU=1.0
        CALL SEMCDF(XL,XOUT1)
        CALL SEMCDF(XU,XOUT2)
        GOTO2990
C
 1340   CONTINUE
        IDIST='TRIANGULAR'
        NUMPAR=3
C
        IF(CHSLOC.EQ.0.0 .AND. CHSCAL.EQ.1.0)THEN
          ZLOWLM=-1.0
          ZUPPLM=1.0
        ELSE
          ZLOWLM=CHSLOC
          ZUPPLM=CHSCAL
        ENDIF
C
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        IF(XL.LT.ZLOWLM)XL=ZLOWLM
        IF(XL.GT.ZUPPLM)XL=ZUPPLM
        IF(XU.LT.ZLOWLM)XU=ZLOWLM
        IF(XU.GT.ZUPPLM)XU=ZUPPLM
        CALL TRICDF(XL,C,ZLOWLM,ZUPPLM,XOUT1)
        CALL TRICDF(XU,C,ZLOWLM,ZUPPLM,XOUT2)
        GOTO2990
C
 1350   CONTINUE
        IDIST='INVERSE GAUSSIAN'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL IGCDF(XL,GAMMA,AMU,XOUT1)
        CALL IGCDF(XU,GAMMA,AMU,XOUT2)
        GOTO2990
C
 1360   CONTINUE
        IDIST='WALD'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL WALCDF(XL,GAMMA,XOUT1)
        CALL WALCDF(XU,GAMMA,XOUT2)
        GOTO2990
C
 1370   CONTINUE
        IDIST='RECIPROCAL INVERSE GAUSSIAN'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL RIGCDF(XL,GAMMA,AMU,XOUT1)
        CALL RIGCDF(XU,GAMMA,AMU,XOUT2)
        GOTO2990
C
 1380   CONTINUE
        IDIST='FATIGUE LIFE'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL FLCDF(XL,GAMMA,XOUT1)
        CALL FLCDF(XU,GAMMA,XOUT2)
        GOTO2990
C
 1390   CONTINUE
        IDIST='GENERALIZED PARETO'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL GEPCDF(XL,GAMMA,MINMAX,IGEPDF,XOUT1)
        CALL GEPCDF(XU,GAMMA,MINMAX,IGEPDF,XOUT2)
        GOTO2990
C
 1400   CONTINUE
        IDIST='DISCRETE UNIFORM'
        NUMPAR=1
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTOP.GT.NDUN)ISTOP=NDUN
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1401ITEMP=ISTRT,ISTOP
            CALL DISPDF(REAL(ITEMP),NDUN,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 1401     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   IF(IXL.GT.NDUN)THEN
CCCCC     XOUT2=0.0
CCCCC     XOUT2=0.0
CCCCC     GOTO2990
CCCCC   ENDIF
CCCCC   IF(IXH.GT.NDUN)THEN
CCCCC     IXH=NPAR
CCCCC     IF(IXL.GE.NDUN)IXL=IXH-1
CCCCC   ENDIF
CCCCC   XOUT2=0.0
CCCCC   IF(IXL.LT.0)IXL=0
CCCCC   IF(IXU.LT.0)IXU=0
CCCCC   CALL DISCDF(REAL(IXU),NDUN,XOUT2)
CCCCC   IF(IXL.GE.0) CALL DISCDF(REAL(IXL),NDUN,XOUT2)
        GOTO2990
C
 1410   CONTINUE
        IDIST='NON-CENTRAL T'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL NCTCDF(XL,ANU,ALAMBA,XOUT1)
        CALL NCTCDF(XU,ANU,ALAMBA,XOUT2)
        GOTO2990
C
 1420   CONTINUE
        IDIST='NON-CENTRAL F'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL NCFCDF(XL,ANU1,ANU2,ALAMBA,XOUT1)
        CALL NCFCDF(XU,ANU1,ANU2,ALAMBA,XOUT2)
        GOTO2990
C
 1430   CONTINUE
        IDIST='NON-CENTRAL CHI-SQUARE'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL NCCCDF(XL,ANU,ALAMBA,XOUT1)
        CALL NCCCDF(XU,ANU,ALAMBA,XOUT2)
        GOTO2990
C
 1440   CONTINUE
        IDIST='NON-CENTRAL BETA'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.1.0)XU=1.0
        CALL NCBCDF(XL,ALPHA,BETA,ALAMBA,XOUT1)
        CALL NCBCDF(XU,ALPHA,BETA,ALAMBA,XOUT2)
        GOTO2990
C
 1450   CONTINUE
        IDIST='DOUBLY NON-CENTRAL T'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL DNTCDF(XL,ANU,ALAMB1,ALAMB2,XOUT1)
        CALL DNTCDF(XU,ANU,ALAMB1,ALAMB2,XOUT2)
        GOTO2990
C
 1460   CONTINUE
        IDIST='DOUBLY NON-CENTRAL F'
        NUMPAR=6
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL DNFCDF(XL,ANU1,ANU2,ALAMB1,ALAMB2,XOUT1)
        CALL DNFCDF(XU,ANU1,ANU2,ALAMB1,ALAMB2,XOUT2)
        GOTO2990
C
 1470   CONTINUE
        IDIST='HYPERGEOMETRIC'
        NUMPAR=3
        POINT=.TRUE.
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1471ITEMP=ISTRT,ISTOP
            CALL HYPCDF(REAL(ITEMP),K,NPAR,MPAR,POINT,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 1471     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   POINT=.FALSE.
CCCCC   IF(IXL.GT.K)THEN
CCCCC     XOUT2=0.0
CCCCC     XOUT2=0.0
CCCCC     GOTO2990
CCCCC   ENDIF
CCCCC   IF(IXH.GT.K)THEN
CCCCC     IXH=K
CCCCC     IF(IXL.GE.K)IXL=IXH-1
CCCCC   ENDIF
CCCCC   XOUT2=0.0
CCCCC   CALL HYPCDF(IXU,K,NPAR,MPAR,POINT,XOUT2)
CCCCC   IF(IXL.GE.0) CALL HYPCDF(IXL,K,NPAR,MPAR,POINT,XOUT2)
        GOTO2990
C
 1480   CONTINUE
        IDIST='VON MISES'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        XL=XL-CHSLOC
        XU=XU-CHSLOC
        CALL VONCDF(XL,B,XOUT1)
        CALL VONCDF(XU,B,XOUT2)
        GOTO2990
C
 1490   CONTINUE
        IDIST='POWER NORMAL'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
CCCCC   CALL PNRCDF(XL,P,SD,XOUT2)
        CALL PNRCDF(XL,P,XOUT1)
CCCCC   CALL PNRCDF(XU,P,SD,XOUT2)
        CALL PNRCDF(XU,P,XOUT2)
        GOTO2990
C
 1500   CONTINUE
        IDIST='POWER LOG-NORMAL'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL PLNCDF(XL,P,SD,XOUT1)
        CALL PLNCDF(XU,P,SD,XOUT2)
        GOTO2990
C
 1510   CONTINUE
        IDIST='ALPHA'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL ALPCDF(XL,ALPHA,BETA,XOUT1)
        CALL ALPCDF(XU,ALPHA,BETA,XOUT2)
        GOTO2990
C
 1520   CONTINUE
        IDIST='COSINE'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL COSCDF(XL,XOUT1)
        CALL COSCDF(XU,XOUT2)
        GOTO2990
C
 1530   CONTINUE
        IDIST='POWER'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.1.0)XU=1.0
        CALL POWCDF(XL,C,XOUT1)
        CALL POWCDF(XU,C,XOUT2)
        GOTO2990
C
 1540   CONTINUE
        IDIST='CHI'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL CHCDF(XL,ANU,XOUT1)
        CALL CHCDF(XU,ANU,XOUT2)
        GOTO2990
C
 1550   CONTINUE
        IDIST='LOGARITHMIC SERIES'
        NUMPAR=1
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1551ITEMP=ISTRT,ISTOP
            CALL DLGPDF(REAL(ITEMP),THETA,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 1551     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   XOUT2=0.0
CCCCC   CALL DLGCDF(REAL(IXU),THETA,XOUT2)
CCCCC   IF(IXL.GE.1) CALL DLGCDF(REAL(IXL),THETA,XOUT2)
        GOTO2990
C
 1560   CONTINUE
        IDIST='LOG LOGISTIC'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL LLGCDF(XL,DELTA,XOUT1)
        CALL LLGCDF(XU,DELTA,XOUT2)
        GOTO2990
C
 1570   CONTINUE
        IDIST='GENERALIZED GAMMA'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL GGDCDF(XL,ALPHA,C,XOUT1)
        CALL GGDCDF(XU,ALPHA,C,XOUT2)
        GOTO2990
C
 1580   CONTINUE
        IDIST='WARING'
        NUMPAR=2
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1581ITEMP=ISTRT,ISTOP
            CALL WARPDF(REAL(ITEMP),C,A,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 1581     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   XOUT2=0.0
CCCCC   CALL WARCDF(REAL(IXU),C,A,XOUT2,'NOTR')
CCCCC   IF(IXL.GE.0) CALL WARCDF(REAL(IXL),C,A,XOUT2,'NOTR')
        GOTO2990
C
 1585   CONTINUE
        IDIST='YULE'
        NUMPAR=1
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1586ITEMP=ISTRT,ISTOP
            CALL YULPDF(REAL(ITEMP),P,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 1586     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   CALL YULCDF(REAL(IXU),P,XOUT2)
CCCCC   IF(IXL.GE.0) CALL YULCDF(REAL(IXL),P,XOUT1)
        GOTO2990
C
 1590   CONTINUE
        IDIST='ANGLIT'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL ANGCDF(XL,XOUT1)
        CALL ANGCDF(XU,XOUT2)
        GOTO2990
C
 1600   CONTINUE
        IDIST='ARCSINE'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.1.0)XU=1.0
        CALL ARSCDF(XL,XOUT1)
        CALL ARSCDF(XU,XOUT2)
        GOTO2990
C
 1610   CONTINUE
        IDIST='FOLDED NORMAL'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL FNRCDF(XL,AM,SD,XOUT1)
        CALL FNRCDF(UL,AM,SD,XOUT2)
        GOTO2990
C
 1620   CONTINUE
        IDIST='TRUNCATED NORMAL'
        NUMPAR=6
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.A)XL=A
        IF(XL.GT.B)XL=B
        IF(XU.LT.A)XU=A
        IF(XU.GT.B)XU=B
        CALL TNRCDF(XL,A,B,AM,SD,XOUT1)
        CALL TNRCDF(XU,A,B,AM,SD,XOUT2)
        GOTO2990
C
 1630   CONTINUE
        IDIST='LOG GAMMA'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL LGACDF(XL,GAMMA,ILGADF,XOUT1)
        CALL LGACDF(XU,GAMMA,ILGADF,XOUT2)
        GOTO2990
C
 1640   CONTINUE
        IDIST='HYPERBOLIC SECANT'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL HSECDF(XL,XOUT1)
        CALL HSECDF(XU,XOUT2)
        GOTO2990
C
 1650   CONTINUE
        IDIST='GOMPERTZ'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL GOMCDF(XL,C,B,XOUT1)
        CALL GOMCDF(XU,C,B,XOUT2)
        GOTO2990
C
 1660   CONTINUE
        IDIST='HALF CAUCHY'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL HFCCDF(XL,XOUT1)
        CALL HFCCDF(XU,XOUT2)
        GOTO2990
C
 1670   CONTINUE
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL HFLCDF(XL,GAMMA,XOUT1)
        CALL HFLCDF(XU,GAMMA,XOUT2)
        GOTO2990
C
 1680   CONTINUE
        IDIST='GENERALIZED EXTREME VALUE'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GEVCDF(XL,GAMMA,MINMAX,XOUT1)
        CALL GEVCDF(XU,GAMMA,MINMAX,XOUT2)
        GOTO2990
C
 1690   CONTINUE
        IDIST='PARETO OF THE SECOND KIND'
        NUMPAR=4
        ZLOC=A
        IF(ZLOC.LE.XMIN)ZLOC=XMIN
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        CALL PA2CDF(XL,GAMMA,ZLOC,XOUT1)
        CALL PA2CDF(XU,GAMMA,ZLOC,XOUT2)
        GOTO2990
C
 1700   CONTINUE
        IDIST='DOUBLE WEIBULL'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL DWECDF(XL,GAMMA,XOUT1)
        CALL DWECDF(XU,GAMMA,XOUT2)
        GOTO2990
C
 1710   CONTINUE
        IDIST='WRAPPED CAUCHY'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CONST=2.0*PI
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.CONST)XL=CONST
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.CONST)XU=CONST
        CALL WCACDF(XL,P,XOUT1)
        CALL WCACDF(XU,P,XOUT2)
        GOTO2990
C
 1720   CONTINUE
        IDIST='EXPONENTIATED WEIBULL'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        IARG1=1
        CALL EWECDF(XL,GAMMA,THETA,IARG1,XOUT1)
        CALL EWECDF(XU,GAMMA,THETA,IARG1,XOUT2)
        GOTO2990
C
 1730   CONTINUE
        IDIST='TRUNCATED EXPONENTIAL'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.AM)XL=AM
        IF(XU.LT.AM)XU=AM
        IF(XL.GT.X0)XL=X0
        IF(XU.GT.X0)XU=X0
        CALL TNECDF(XL,X0,AM,SD,XOUT1)
        CALL TNECDF(XU,X0,AM,SD,XOUT2)
        GOTO2990
C
 1740   CONTINUE
        IDIST='GENERALIZED LOGISTIC'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GLOCDF(XL,ALPHA,XOUT1)
        CALL GLOCDF(XU,ALPHA,XOUT2)
        GOTO2990
C
 1750   CONTINUE
        IDIST='POWER EXPONENTIAL'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL PEXCDF(XL,ALPHA,BETA,XOUT1)
        CALL PEXCDF(XU,ALPHA,BETA,XOUT2)
        GOTO2990
C
 1760   CONTINUE
        IDIST='DOUBLE GAMMA'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL DGACDF(XL,GAMMA,XOUT1)
        CALL DGACDF(XU,GAMMA,XOUT2)
        GOTO2990
C
 1770   CONTINUE
        IDIST='MEILKE BETA-KAPPA'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL KAPCDF(XL,ANU,BETA,THETA,XOUT1)
        CALL KAPCDF(XU,ANU,BETA,THETA,XOUT2)
        GOTO2990
C
 1780   CONTINUE
        IDIST='FOLDED CAUCHY'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL FCACDF(XL,AM,SD,XOUT1)
        CALL FCACDF(XU,AM,SD,XOUT2)
        GOTO2990
C
 1790   CONTINUE
        IDIST='BETA BINOMIAL'
        NUMPAR=3
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO1791ITEMP=ISTRT,ISTOP
            CALL BBNPDF(REAL(ITEMP),ALPHA,BETA,NU,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 1791     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   XOUT1=0.0
CCCCC   CALL BBNCDF(REAL(IXU),ALPHA,BETA,NU,XOUT2)
CCCCC   IF(IXL.GE.0) CALL BBNCDF(REAL(IXL),ALPHA,BETA,NU,XOUT1)
        GOTO2990
C
 1800   CONTINUE
        IDIST='BRADFORD'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.1.0)XU=1.0
        CALL BRACDF(XL,BETA,XOUT1)
        CALL BRACDF(XU,BETA,XOUT2)
        GOTO2990
C
 1810   CONTINUE
        IDIST='GENERALIZED EXPONENTIAL'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL GEXCDF(XL,ALAMB1,ALAMB2,GAMMA,XOUT1)
        CALL GEXCDF(XU,ALAMB1,ALAMB2,GAMMA,XOUT2)
        GOTO2990
C
 1820   CONTINUE
        IDIST='RECIPROCAL'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL RECCDF(XL,B,XOUT1)
        CALL RECCDF(XU,B,XOUT2)
        GOTO2990
C
 1830   CONTINUE
        IDIST='MIXTURE OF 2 NORMALS'
        NUMPAR=7
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL NMXCDF(XL,U1,SD1,U2,SD2,P,XOUT1)
        CALL NMXCDF(XU,U1,SD1,U2,SD2,P,XOUT2)
        GOTO2990
C
 1840   CONTINUE
        IDIST='INVERTED GAMMA'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL IGACDF(XL,GAMMA,XOUT1)
        CALL IGACDF(XU,GAMMA,XOUT2)
        GOTO2990
C
 1850   CONTINUE
        IDIST='INVERTED WEIBULL'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL IWECDF(XL,GAMMA,XOUT1)
        CALL IWECDF(XU,GAMMA,XOUT2)
        GOTO2990
C
 1860   CONTINUE
        IDIST='LOG DOUBLE EXPONENTIAL'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL LDECDF(XL,ALPHA,XOUT1)
        CALL LDECDF(XU,ALPHA,XOUT2)
        GOTO2990
C
 1870   CONTINUE
        IDIST='GENERALIZED TUKEY-LAMBDA'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GLDCDF(DBLE(XL),DBLE(ALAMB3),DBLE(ALAMB4),
     1              DOUT1,IGLDDF,IWRITE)
        XOUT1=REAL(DOUT1)
        CALL GLDCDF(DBLE(XU),DBLE(ALAMB3),DBLE(ALAMB4),
     1              DOUT2,IGLDDF,IWRITE)
        XOUT2=REAL(DOUT2)
        GOTO2990
C
 1880   CONTINUE
        IDIST='JOHNSON SB'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.1.0)XU=1.0
        CALL JSBCDF(XL,ALPHA1,ALPHA2,XOUT1)
        CALL JSBCDF(XU,ALPHA1,ALPHA2,XOUT2)
        GOTO2990
C
 1890   CONTINUE
        IDIST='JOHNSON SU'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL JSUCDF(XL,ALPHA1,ALPHA2,XOUT1)
        CALL JSUCDF(XU,ALPHA1,ALPHA2,XOUT2)
        GOTO2990
C
 1900   CONTINUE
        IDIST='GEOMETRIC EXTREME EXPONENTIAL'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL GEECDF(XL,GAMMA,XOUT1)
        CALL GEECDF(XU,GAMMA,XOUT2)
        GOTO2990
C
 1910   CONTINUE
        IDIST='TWO-SIDED POWER'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.1.0)XU=1.0
        CALL TSPCDF(XL,THETA,ANU,XOUT1)
        CALL TSPCDF(XU,THETA,ANU,XOUT2)
        GOTO2990
C
 1920   CONTINUE
        IDIST='BIWEIBULL'
        NUMPAR=7
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL BWECDF(XL,ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,XOUT1,DTEMP1)
        CALL BWECDF(XU,ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,XOUT2,DTEMP1)
        GOTO2990
C
 1930   CONTINUE
        IDIST='LANDAU'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        DTEMP1=LANCDF(XL)
        XOUT1=REAL(DTEMP1)
        DTEMP2=LANCDF(XU)
        XOUT2=REAL(DTEMP1)
        GOTO2990
C
 1940   CONTINUE
        IDIST='ERROR (= EXPONENTIAL POWER)'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL ERRCDF(XL,ALPHA,XOUT1)
        CALL ERRCDF(XU,ALPHA,XOUT2)
        GOTO2990
C
 1950   CONTINUE
        IDIST='TRAPEZOID'
        NUMPAR=6
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL TRACDF(XL,A,B,C,DZ,XOUT1)
        CALL TRACDF(XU,A,B,C,DZ,XOUT2)
        GOTO2990
C
 1960   CONTINUE
        IDIST='GENERALIZED TRAPEZOID'
        NUMPAR=9
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GTRCDF(XL,A,B,C,DZ,ANU1,ANU3,ALPHA,XOUT1)
        CALL GTRCDF(XU,A,B,C,DZ,ANU1,ANU3,ALPHA,XOUT2)
        GOTO2990
C
 1970   CONTINUE
        IDIST='FOLDED T'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL FTCDF(XL,NU,XOUT1)
        CALL FTCDF(XU,NU,XOUT2)
        GOTO2990
C
 1980   CONTINUE
        IDIST='SLASH'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL SLACDF(XL,XOUT1)
        CALL SLACDF(XU,XOUT2)
        GOTO2990
C
 1990   CONTINUE
        IDIST='SKEW NORMAL'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL SNCDF(XL,ALAMBA,ISKNDF,XOUT1)
        CALL SNCDF(XU,ALAMBA,ISKNDF,XOUT2)
        GOTO2990
C
 2000   CONTINUE
        IDIST='SKEW T'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL STCDF(XL,NU,ALAMBA,XOUT1)
        CALL STCDF(XU,NU,ALAMBA,XOUT2)
        GOTO2990
C
 2010   CONTINUE
        IDIST='INVERTED BETA'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL IBCDF(XL,ALPHA,BETA,XOUT1)
        CALL IBCDF(XU,ALPHA,BETA,XOUT2)
        GOTO2990
C
 2020   CONTINUE
        IDIST='GOMPERTZ-MAKEHAM'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        IF(IMAKDF.EQ.'DLMF')THEN
          CALL MAKCDF(XL,XI,ALAMB,THETA,XOUT1)
          CALL MAKCDF(XU,XI,ALAMB,THETA,XOUT2)
        ELSEIF(IMAKDF.EQ.'MEEK')THEN
          XI=GAMMA/AK
          THETA=ALAMB/GAMMA
          ALAMB=AK
          CALL MAKCDF(XL,XI,ALAMB,THETA,XOUT1)
          CALL MAKCDF(XU,XI,ALAMB,THETA,XOUT2)
        ELSEIF(IMAKDF.EQ.'REPA')THEN
          CALL MA2CDF(XL,ZETA,ETA,XOUT1)
          CALL MA2CDF(XU,ZETA,ETA,XOUT2)
        ENDIF
        GOTO2990
C
 2030   CONTINUE
        IDIST='GENERALIZED INVERSE GAUSSIAN'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL GIGCDF(DBLE(XL),DBLE(CHI),DBLE(ALAMBA),DBLE(THETA),DOUT1)
        CALL GIGCDF(DBLE(XU),DBLE(CHI),DBLE(ALAMBA),DBLE(THETA),DOUT2)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2040   CONTINUE
        IDIST='GENERALIZED F'
        NUMPAR=6
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
CCCCC   CALL GFCDF(XL,XI,ALAMB,NU1,NU2,XOUT1)
CCCCC   CALL GFCDF(XU,XI,ALAMB,NU1,NU2,XOUT2)
        GOTO2990
C
 2050   CONTINUE
        IDIST='G-H'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GHCDF(XL,G,H,XOUT1)
        CALL GHCDF(XU,G,H,XOUT2)
        GOTO2990
C
 2060   CONTINUE
        IDIST='LOG SKEW NORMAL'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL LSNCDF(XL,ALAMBA,SD,XOUT1)
        CALL LSNCDF(XU,ALAMBA,SD,XOUT2)
        GOTO2990
C
 2070   CONTINUE
        IDIST='LOG SKEW T'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL LSTCDF(XL,NU,ALAMBA,SD,XOUT1)
        CALL LSTCDF(XU,NU,ALAMBA,SD,XOUT2)
        GOTO2990
C
 2080   CONTINUE
        IDIST='ARCSIN'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XL.GT.1.0)XL=1.0
        IF(XU.LT.0.0)XU=0.0
        IF(XU.GT.1.0)XU=1.0
        CALL ARSCDF(XL,XOUT1)
        CALL ARSCDF(XU,XOUT2)
        GOTO2990
C
 2090   CONTINUE
        IDIST='POLYA'
        NUMPAR=3
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO2091ITEMP=ISTRT,ISTOP
            CALL POLPDF(REAL(ITEMP),W,ALPHA,BETA,NU,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 2091     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   XOUT1=0.0
CCCCC   CALL POLCDF(REAL(IXU),ALPHA,BETA,NU,XOUT2)
CCCCC   IF(IXL.GE.0) CALL POLCDF(REAL(IXL),ALPHA,BETA,NU,XOUT1)
        GOTO2990
C
 2100   CONTINUE
        IDIST='HERMITE'
        NUMPAR=2
        XOUT1=0.0
        XOUT2=0.0
        ISTRT=IXL
        IF(ISTRT.LT.ILOWLM)ISTRT=ILOWLM
        ISTOP=IXU
        IF(ISTRT.LE.ISTOP)THEN
          DCDFL=0.0D0
          DO2101ITEMP=ISTRT,ISTOP
            CALL HERPDF(REAL(ITEMP),ALPHA,BETA,ATEMP)
            DCDFL=DCDFL + DBLE(ATEMP)
 2101     CONTINUE
          XOUT2=REAL(DCDFL)
        ENDIF
CCCCC   XOUT1=0.0
CCCCC   CALL HERCDF(REAL(IXU),ALPHA,BETA,XOUT2)
CCCCC   IF(IXL.GE.0) CALL HERCDF(REAL(IXL),ALPHA,BETA,XOUT1)
        GOTO2990
C
 2110   CONTINUE
        IDIST='SKEW DOUBLE EXPONENTIAL'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL SDECDF(XL,ALAMBA,XOUT1)
        CALL SDECDF(XU,ALAMBA,XOUT2)
        GOTO2990
C
 2120   CONTINUE
        IDIST='ASYMMETRIC DOUBLE EXPONENTIAL'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(IADEDF.EQ.'K')THEN
          CALL ADECDF(XL,AK,IADEDF,XOUT1)
          CALL ADECDF(XU,AK,IADEDF,XOUT2)
        ELSE
          CALL ADECDF(XL,AMU,IADEDF,XOUT1)
          CALL ADECDF(XU,AMU,IADEDF,XOUT2)
        ENDIF
        GOTO2990
C
 2130   CONTINUE
        IDIST='MAXWELL'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL MAXCDF(XL,SIGMA,XOUT1)
        CALL MAXCDF(XU,SIGMA,XOUT2)
        GOTO2990
C
 2140   CONTINUE
        IDIST='RAYLEIGH'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(XL.LT.0.0)XL=0.0
        IF(XU.LT.0.0)XU=0.0
        CALL RAYCDF(XL,XOUT1)
        CALL RAYCDF(XU,XOUT2)
        GOTO2990
C
 2150   CONTINUE
        IDIST='GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GALCDF(DBLE(XL),DBLE(AK),DBLE(TAU),IADEDF,DOUT1)
        CALL GALCDF(DBLE(XU),DBLE(AK),DBLE(TAU),IADEDF,DOUT2)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2160   CONTINUE
        IDIST='MCLEISH'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL MCLCDF(DBLE(XL),DBLE(ALPHA),DOUT1)
        CALL MCLCDF(DBLE(XU),DBLE(ALPHA),DOUT2)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2170   CONTINUE
        IDIST='BESSEL I-FUNCTION'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        IF(IBEIDF.EQ.'1')THEN
          CALL BEICDF(DBLE(XL),DBLE(SD1),DBLE(SD2),DBLE(ANU),IBEIDF,
     1                DOUT1)
          CALL BEICDF(DBLE(XU),DBLE(SD1),DBLE(SD2),DBLE(ANU),IBEIDF,
     1                DOUT2)
        ELSE
          CALL BEICDF(DBLE(XL),DBLE(B),DBLE(C),DBLE(AM),IBEIDF,
     1                DOUT1)
          CALL BEICDF(DBLE(XU),DBLE(B),DBLE(C),DBLE(AM),IBEIDF,
     1                DOUT2)
        ENDIF
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2180   CONTINUE
        IDIST='BESSEL K-FUNCTION'
        NUMPAR=2
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
CCCCC   CALL BEKCDF(DBLE(XL),DBLE(SD1),DBLE(SD2),DBLE(ANU),DOUT1)
CCCCC   CALL BEKCDF(DBLE(XU),DBLE(SD1),DBLE(SD2),DBLE(ANU),DOUT2)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2190   CONTINUE
        IDIST='GENERALIZED MCLEISH'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GMCCDF(DBLE(XL),DBLE(ALPHA),DBLE(A),DOUT1)
        CALL GMCCDF(DBLE(XU),DBLE(ALPHA),DBLE(A),DOUT2)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2200   CONTINUE
        IDIST='GENERALIZED LOGISTIC TYPE 5 (HOSKING)'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        XPAR(1)=DBLE(CHSLOC)
        XPAR(2)=DBLE(CHSCAL)
        XPAR(3)=DBLE(ALPHA)
        DOUT1=CDFGLO(DBLE(XL),XPAR)
        DOUT2=CDFGLO(DBLE(XU),XPAR)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2210   CONTINUE
        IDIST='WAKEBY'
        NUMPAR=5
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        XPAR(1)=DBLE(CHSLOC)
        XPAR(2)=DBLE(CHSCAL)
        XPAR(3)=DBLE(BETA)
        XPAR(4)=DBLE(GAMMA)
        XPAR(5)=DBLE(DELTA)
        DOUT1=CDFGLO(DBLE(XL),XPAR)
        DOUT2=CDFGLO(DBLE(XU),XPAR)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2220   CONTINUE
        IDIST='BETA-NORMAL'
        NUMPAR=4
        ZSCALE=CHSCAL-CHSLOC
        XL=(XL-CHSLOC)/ZSCALE
        XU=(XU-CHSLOC)/ZSCALE
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        CALL BNOCDF(DBLE(XL),DBLE(ALPHA),DBLE(BETA),DOUT1)
        CALL BNOCDF(DBLE(XU),DBLE(ALPHA),DBLE(BETA),DOUT2)
        XOUT1=REAL(DOUT1)
        XOUT2=REAL(DOUT2)
        GOTO2990
C
 2230   CONTINUE
        IDIST='GENERALIZED LOGISTIC TYPE 2'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GL2CDF(DBLE(XL),DBLE(ALPHA),DOUT1)
        CALL GL2CDF(DBLE(XU),DBLE(ALPHA),DOUT2)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2240   CONTINUE
        IDIST='GENERALIZED LOGISTIC TYPE 3'
        NUMPAR=3
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GL3CDF(DBLE(XL),DBLE(ALPHA),DOUT1)
        CALL GL3CDF(DBLE(XU),DBLE(ALPHA),DOUT2)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2250   CONTINUE
        IDIST='GENERALIZED LOGISTIC TYPE 4'
        NUMPAR=4
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        XL=(XL-CHSLOC)/CHSCAL
        XU=(XU-CHSLOC)/CHSCAL
        CALL GL4CDF(DBLE(XL),DBLE(P),DBLE(Q),DOUT1)
        CALL GL4CDF(DBLE(XU),DBLE(P),DBLE(Q),DOUT2)
        XOUT1=DOUT1
        XOUT2=DOUT2
        GOTO2990
C
 2260   CONTINUE
        IDIST='ASYMMETRIC LOG DOUBLE EXPONENTIAL'
        NUMPAR=4
        ZSCALE=CHSCAL-CHSLOC
        XL=(XL-CHSLOC)/ZSCALE
        XU=(XU-CHSLOC)/ZSCALE
        IF(CHSLOC.EQ.0.0)NUMPAR=NUMPAR-1
        IF(CHSCAL.EQ.1.0)NUMPAR=NUMPAR-1
        CALL ALDCDF(DBLE(XL),DBLE(ALPHA),DBLE(BETA),DOUT1)
        CALL ALDCDF(DBLE(XU),DBLE(ALPHA),DBLE(BETA),DOUT2)
        XOUT1=REAL(DOUT1)
        XOUT2=REAL(DOUT2)
        GOTO2990
C
 2990 CONTINUE
C
CCCCC IF(I.EQ.1)THEN
CCCCC   D2(I)=XOUT2
CCCCC ELSEIF(I.EQ.N2)THEN
CCCCC   D2(I)=1.0-XOUT1
CCCCC ELSE
        D2(I)=XOUT2-XOUT1
CCCCC ENDIF
C
      IF(D2(I).EQ.0.0)THEN
        NEMPTY=NEMPTY+1
        GOTO1199
      ENDIF
      D2(I)=D2(I)*AN
C
      DTEMP1=DBLE(Y2(I))
      DTEMP2=DBLE(D2(I))
      IF(DTEMP2.GT.0.0D0)DSUM1=DSUM1 + (DTEMP1-DTEMP2)**2/DTEMP2
C
 1199 CONTINUE
C
      N2=N2-NEMPTY
      STAT=REAL(DSUM1)
      IDF=N2-NUMPAR-1
      IF(IDF.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2011)
 2011   FORMAT('***** ERROR DPCHS2--NON-POSITIVE DEGREES OF FREEDOM')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2013)N2
 2013   FORMAT('      NUMBER OF CELLS       = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2015)NUMPAR
 2015   FORMAT('      NUMBER OF PARAMETERS  = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2017)IDF
 2017   FORMAT('      DEGREES OF FREEDOM    = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL CHSCDF(STAT,IDF,CDF)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      STATVA=STAT
      STATCD=CDF
      STATNU=IDF
      CALL CHSPPF(.90,IDF,CUTU90)
      CALL CHSPPF(.95,IDF,CUTU95)
      CALL CHSPPF(.99,IDF,CUTU99)
C
      IF(STATVA.LE.CUTU90)ICONC1='ACCEPT'
      IF(STATVA.LE.CUTU95)ICONC2='ACCEPT'
      IF(STATVA.LE.CUTU99)ICONC3='ACCEPT'
C
      IF(IWRIT2.EQ.'OFF')GOTO9000
C
C               *******************************
C               **   STEP 32--               **
C               **   WRITE OUT EVERYTHING    **
C               **   FOR A CHI-SQUARED TEST  **
C               *******************************
C
      ISTEPN='32'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5101)
 5101   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
 5107   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('<TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
 5113   FORMAT('   <CAPTION ALIGN=CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
 5115   FORMAT('      <B>CHI-SQUARE GOODNESS-OF-FIT TEST</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
 5119   FORMAT('   </CAPTION>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5141)
 5141   FORMAT('         Null Hypothesis H<SUB>0</SUB>:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)
 5151   FORMAT('         Distribution Fits the Data')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5142)
 5142   FORMAT('         Alternate Hypothesis H<SUB>a</SUB>:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)
 5152   FORMAT('         Distribution Does Not Fit the Data')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5143)
 5143   FORMAT('         Distribution:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5153)IDIST
 5153   FORMAT('         ',A50)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
 5121   FORMAT('   <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
 5123   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5144)
 5144   FORMAT('         Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
 5127   FORMAT('      </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
 5126   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)N
 5154   FORMAT('         ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
 5128   FORMAT('   </TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5184)
 5184   FORMAT('         Number of Non-Empty Cells:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)N2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5186)
 5186   FORMAT('         Number of Parameters:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)NUMPAR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5145)
 5145   FORMAT('         Chi-Square Test Statistic:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)STAT
 5155   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5146)
 5146   FORMAT('         Degrees of Freedom:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)IDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
 5147   FORMAT('         Chi-Square CDF Value:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)CDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5991)
 5991   FORMAT('</TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5993)
 5993   FORMAT('</UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5995)
 5995   FORMAT('<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5307)
 5307   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5311)
 5311   FORMAT('<TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
 5321   FORMAT('   <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
 5323   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5341)
 5341   FORMAT('         Alpha<br>Level')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
 5329   FORMAT('      </TH>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5351)
 5351   FORMAT('         Cutoff')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5353)
 5353   FORMAT('         Conclusion')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
 5328   FORMAT('   </TR>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
 5313   FORMAT('   <TD COLSPAN=3>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
 5319   FORMAT('      <HR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
 5327   FORMAT('      </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
 5440   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5441)
 5441   FORMAT('         10%')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5442)CUTU90
 5442   FORMAT('         ',F10.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5443)ICONC1
 5443   FORMAT('         ',A6,' H<SUB>0</SUB>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5541)
 5541   FORMAT('          5%')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5442)CUTU95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5443)ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5641)
 5641   FORMAT('          1%')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5442)CUTU99
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5443)ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5991)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5993)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5499)
 5499   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
C
CCCCC OCTOBER 2003: ADD LATEX SUPPORT.
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8001 FORMAT('{',A1,'bf CHI-SQUARE GOODNESS-OF-FIT TEST}')
 8002 FORMAT(A1,A1)
 8003 FORMAT(A1,'end{table}')
 8007 FORMAT(A1,'begin{center}')
 8009 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8010 FORMAT(A1,'end{center}')
 8012 FORMAT(A1,'end{verbatim}')
 8013 FORMAT(A1,'begin{table}')
 8014 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8016 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Null Hypothesis $H_0$: & Distribution Fits the Data',
     1       2X,A1,A1)
 8022 FORMAT(5X,'Alternate Hypothesis $H_a$: & Distribution Does Not ',
     1       'Fit the Data',2X,A1,A1)
 8023 FORMAT(5X,'Distribution: & ',A50,2X,A1,A1)
 8024 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8025 FORMAT(5X,'Number of Non-Empty Cells: & ',I8,2X,A1,A1)
 8026 FORMAT(5X,'Number of Parameters: & ',I8,2X,A1,A1)
 8027 FORMAT(5X,'Chi-Square Test Statistic & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Degrees of Freedom: & ',I8,2X,A1,A1)
 8029 FORMAT(5X,'Chi-Square CDF Value & ',G15.7,2X,A1,A1)
 8030 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)IDIST,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)INT(AN+0.1),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)N2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)NUMPAR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)STAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)CDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8040 FORMAT(5X,A1,'begin{tabular} {rrr}')
 8041 FORMAT(5X,'Alpha Level & Cutoff & Conclusion',2X,A1,A1,
     1       2x,A1,'hline')
 8042 FORMAT(5X,'10',A1,'% & ',F10.5,' & ',A6,' $H_0$',2X,A1,A1)
 8043 FORMAT(5X,'5',A1,'% & ',F10.5,' & ',A6,' $H_0$',2X,A1,A1)
 8044 FORMAT(5X,'1',A1,'% & ',F10.5,' & ',A6,' $H_0$',2X,A1,A1)
 8049 FORMAT(A1,'end{table}')
 8050 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8042)IBASLC,CUTU90,ICONC1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC,CUTU95,ICONC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)IBASLC,CUTU99,ICONC3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8092   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8092)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C  JUST A PLACEHOLDER FOR NOW.
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3211)
 3211   FORMAT(
     1'                  CHI-SQUARED GOODNESS-OF-FIT TEST')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3212)
 3212   FORMAT(
     1'NULL HYPOTHESIS H0:      DISTRIBUTION FITS THE DATA')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,13212)
13212   FORMAT(
     1'ALTERNATE HYPOTHESIS HA: DISTRIBUTION DOES NOT FIT THE DATA')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3213)IDIST
 3213   FORMAT(
     1         'DISTRIBUTION:            ',A50)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3220)
 3220   FORMAT('SAMPLE:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3221)INT(AN+0.1)
 3221   FORMAT(3X,'NUMBER OF OBSERVATIONS      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3222)N2
 3222   FORMAT(3X,'NUMBER OF NON-EMPTY CELLS   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3224)NUMPAR
 3224   FORMAT(3X,'NUMBER OF PARAMETERS USED   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3240)
 3240   FORMAT('TEST:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3242)STAT
 3242   FORMAT('CHI-SQUARED TEST STATISTIC     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3243)IDF
 3243   FORMAT(3X,'DEGREES OF FREEDOM          = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3244)CDF
 3244   FORMAT(3X,'CHI-SQUARED CDF VALUE       = ',F11.6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3253)
 3253   FORMAT('   ALPHA LEVEL         CUTOFF              CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3255)CUTU90,ICONC1
 3255   FORMAT('           10%',5X,F10.5,15X,A6,' H0')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3265)CUTU95,ICONC2
 3265   FORMAT('            5%',5X,F10.5,15X,A6,' H0')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3275)CUTU99,ICONC3
 3275   FORMAT('            1%',5X,F10.5,15X,A6,' H0')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCHS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IDATSW,N2,IERROR
 9012 FORMAT('ICASPL,IDATSW,N2,IERROR = ',A4,2X,A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)INT(AN+0.1),NPAR,STATCD
 9014 FORMAT('NTOT,NPAR,STATCD = ',I8,2X,I8,2X,G15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1993
      WRITE(ICOUT,9015)MINMAX
 9015 FORMAT('MINMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N2
      WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I)
 9021 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCHSY(ICHAR2,ICHARN,IBUG,IFOUND)
C
C     PURPOSE--CONVERT A KEYBOARD SYMBOL
C              (. , ; : ETC.) INTO A NUMERIC VALUE
C              (1 TO 23).
C              (1 TO 24).
C     INPUT  ARGUMENTS--ICHAR2 (A HOLLERITH VARIABLE
C                              CONTAINING THE HOLLERITH
C                              CHARACTER(S) OF INTEREST.
C     OUTPUT ARGUMENTS--ICHARN (AN INTEGER VARIABLE
C                              CONTAINING THE NUMERIC
C                              DESIGNATION FOR THE
C                              ALPHABETIC CHARACTER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MAY       1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IBUG
      CHARACTER*4 IFOUND
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHSY')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCHSY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4
   59 FORMAT('IBUGG4,ISUBG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  CONVERT THE CHARACTER       **
C               **********************************
C
      IF(ICHAR2.EQ.'.')GOTO100
      IF(ICHAR2.EQ.',')GOTO200
      IF(ICHAR2.EQ.':')GOTO300
      IF(ICHAR2.EQ.';')GOTO400
      IF(ICHAR2.EQ.'!')GOTO500
      IF(ICHAR2.EQ.'?')GOTO600
      IF(ICHAR2.EQ.'&')GOTO700
      IF(ICHAR2.EQ.'$')GOTO800
      IF(ICHAR2.EQ.'/')GOTO900
      IF(ICHAR2.EQ.'(')GOTO1000
      IF(ICHAR2.EQ.')')GOTO1100
      IF(ICHAR2.EQ.'*')GOTO1200
      IF(ICHAR2.EQ.'-')GOTO1300
      IF(ICHAR2.EQ.'+')GOTO1400
      IF(ICHAR2.EQ.'=')GOTO1500
      IF(ICHAR2.EQ.'''')GOTO1600
      IF(ICHAR2.EQ.'"')GOTO1700
      IF(ICHAR2.EQ.'DEGR')GOTO1800
      IF(ICHAR2.EQ.'NOSP')GOTO1900
      IF(ICHAR2.EQ.'HASP')GOTO2000
      IF(ICHAR2.EQ.' ')GOTO2100
      IF(ICHAR2.EQ.'LAPO')GOTO2200
      IF(ICHAR2.EQ.'RAPO')GOTO2300
      IF(ICHAR2.EQ.'|')GOTO2400
      GOTO7900
C
  100 CONTINUE
      ICHARN=1
      GOTO8000
C
  200 CONTINUE
      ICHARN=2
      GOTO8000
C
  300 CONTINUE
      ICHARN=3
      GOTO8000
C
  400 CONTINUE
      ICHARN=4
      GOTO8000
C
  500 CONTINUE
      ICHARN=5
      GOTO8000
C
  600 CONTINUE
      ICHARN=6
      GOTO8000
C
  700 CONTINUE
      ICHARN=7
      GOTO8000
C
  800 CONTINUE
      ICHARN=8
      GOTO8000
C
  900 CONTINUE
      ICHARN=9
      GOTO8000
C
 1000 CONTINUE
      ICHARN=10
      GOTO8000
C
 1100 CONTINUE
      ICHARN=11
      GOTO8000
C
 1200 CONTINUE
      ICHARN=12
      GOTO8000
C
 1300 CONTINUE
      ICHARN=13
      GOTO8000
C
 1400 CONTINUE
      ICHARN=14
      GOTO8000
C
 1500 CONTINUE
      ICHARN=15
      GOTO8000
C
 1600 CONTINUE
      ICHARN=16
      GOTO8000
C
 1700 CONTINUE
      ICHARN=17
      GOTO8000
C
 1800 CONTINUE
      ICHARN=18
      GOTO8000
C
 1900 CONTINUE
      ICHARN=19
      GOTO8000
C
 2000 CONTINUE
      ICHARN=20
      GOTO8000
C
 2100 CONTINUE
      ICHARN=21
      GOTO8000
C
 2200 CONTINUE
      ICHARN=22
      GOTO8000
C
 2300 CONTINUE
      ICHARN=23
      GOTO8000
C
 2400 CONTINUE
      ICHARN=24
      GOTO8000
C
 7900 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7911)
C7911 FORMAT('***** ERROR IN DPCHSY--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7912)
C7912 FORMAT('      NO MATCH FOUND FOR INPUT CHARACTER.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7913)ICHAR2
C7913 FORMAT('      INPUT CHARACTER = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
      IFOUND='NO'
      GOTO9000
C
 8000 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CHSY')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCHSY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND
 9012 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IFOUND
 9019 FORMAT('IBUGG4,ISUBG4,IFOUND = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCHSZ(PDEFHE,MAXCHA,
     1PCHAHE,PCHAWI,PCHAVG,PCHAHG,
     1IBUGP2,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER SIZES FOR USE IN MULTI-TRACE PLOTS.
C              THE SIZE FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE FLOATING POINT
C              VECTOR PCHAHE(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --PDEFHE
C                     --MAXCHA
C     OUTPUT ARGUMENTS--PCHAHE  (A  FLOATING POINT VECTOR
C                       WHOSE I-TH ELEMENT IS THE SIZE (= HEIGHT)
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --PCHAWI = CHARACTER WIDTH
C                     --PCHAVG = VERTICAL GAP BETWEEN CHARACTERS
C                     --PCHAHG = HORIZONTAL GAP BETWEEN CHARACTERS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1982.
C     UPDATED         --JANUARY   1995. ALLOW ? AS ARGUMENT (FOR HELP)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC CHARACTER*4 IHARG          DECEMBER 1986
CCCCC CHARACTER*4 IARGT          DECEMBER 1986
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ICASEQ
      CHARACTER*4 IWRITE
C
C---------------------------------------------------------------------
C
CCCCC DIMENSION IHARG(*)          DECEMBER 1986
CCCCC DIMENSION IARGT(*)          DECEMBER 1986
CCCCC DIMENSION IARG(*)          DECEMBER 1986
CCCCC DIMENSION ARG(*)          DECEMBER 1986
C
      DIMENSION PCHAHE(*)
      DIMENSION PCHAWI(*)
      DIMENSION PCHAVG(*)
      DIMENSION PCHAHG(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPCH'
      ISUBN2='SZ  '
C
      IFOUND='NO'
      IERROR='NO'
C
 1100 CONTINUE
C
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'SIZE'.AND.
     1IHARG(2).EQ.'BOX'.AND.IHARG(3).EQ.'PLOT')GOTO2110
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'HEIG'.AND.
     1IHARG(2).EQ.'BOX'.AND.IHARG(3).EQ.'PLOT')GOTO2110
      IF(NUMARG.GE.4.AND.IHARG(2).EQ.'SIZE'.AND.
     1IHARG(3).EQ.'BOX'.AND.IHARG(4).EQ.'PLOT')GOTO2110
      IF(NUMARG.GE.4.AND.IHARG(2).EQ.'HEIG'.AND.
     1IHARG(3).EQ.'BOX'.AND.IHARG(4).EQ.'PLOT')GOTO2110
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'SIZE')GOTO1160
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'HEIG')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SIZE')GOTO1105
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'HEIG')GOTO1105
      GOTO9000
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
CCCCC THE FOLLOWING LINE WAS ADDED    JANUARY 1995
      IF(IHARG(NUMARG).EQ.'?')GOTO1200
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'AUTO')GOTO3000
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      PCHAHE(I)=PDEFHE
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHAHE(I)
 1116 FORMAT('ALL CHARACTER SIZES HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO8000
C
 1120 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB')GOTO1180
      PCHAHE(1)=ARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,PCHAHE(I)
 1126 FORMAT('THE SIZE FOR CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO8000
C
 1130 CONTINUE
      I=1
      IF(IARGT(3).NE.'NUMB')GOTO1180
      DO1135I=1,MAXCHA
      PCHAHE(I)=ARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHAHE(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO8000
C
 1140 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB')GOTO1180
      DO1145I=1,MAXCHA
      PCHAHE(I)=ARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHAHE(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO8000
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
      IP1=I+1
      IF(IARGT(IP1).NE.'NUMB')GOTO1180
      PCHAHE(I)=ARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,PCHAHE(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO8000
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      PCHAHE(I)=PDEFHE
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHAHE(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO8000
C
 1180 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('***** ERROR IN DPCHSZ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('CHARACTER SIZES MUST BE NUMERIC;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('HOWEVER, THE SPECIFIED CHARACTER SIZE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)I
 1184 FORMAT('FOR CHARACTER ',I6,' WAS NON-NUMERIC.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED    JANUARY 1995
 1200 CONTINUE
      IFOUND='YES'
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1226)I,PCHAHE(I)
 1226 FORMAT('THE CURRENT SIZE FOR CHARACTER ',I6,' IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1227)I,PDEFHE
 1227 FORMAT('THE DEFAULT SIZE FOR CHARACTER ',I6,' IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO9000
C
 2110 CONTINUE
      IMAX=24
      PCHAHE(1)=2.0
      PCHAHE(2)=2.0
      PCHAHE(3)=2.0
      PCHAHE(4)=2.0
      PCHAHE(5)=2.0
      PCHAHE(6)=2.0
      PCHAHE(7)=2.0
      PCHAHE(8)=2.0
      PCHAHE(9)=2.0
      PCHAHE(10)=2.0
      PCHAHE(11)=2.0
      PCHAHE(12)=2.0
      PCHAHE(13)=2.0
      PCHAHE(14)=2.0
      PCHAHE(15)=2.0
      PCHAHE(16)=2.0
      PCHAHE(17)=2.0
      PCHAHE(18)=2.0
      PCHAHE(19)=2.0
      PCHAHE(20)=2.0
      PCHAHE(21)=3.0
      PCHAHE(22)=2.0
      PCHAHE(23)=2.0
      PCHAHE(24)=3.0
      GOTO2170
C
 2170 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO2179
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO2175I=1,IMAX
      WRITE(ICOUT,2176)I,PCHAHE(I)
 2176 FORMAT('THE SIZE FOR CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 2175 CONTINUE
 2179 CONTINUE
      GOTO8000
C
C               ***********************************************************
C               **  STEP 30--                                            **
C               **  TREAT THE   CHARACTER SIZE AUTOMATIC <VARIABLE>  CASE **
C               ***********************************************************
C
 3000 CONTINUE
C
C               ********************************************
C               **  STEP 31--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 3      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='31'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(3)
      IHLEF2=IHARG2(3)
      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 32--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='32'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO3290
      DO3200J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO3210
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO3210
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO3220
 3200 CONTINUE
      GOTO3290
 3210 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO3290
 3220 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO3290
 3290 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO3295
      WRITE(ICOUT,3291)NUMARG,ILOCQ
 3291 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 3295 CONTINUE
C
C               *********************************************
C               **  STEP 33--                              **
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='33'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO3310
      IF(ICASEQ.EQ.'SUBS')GOTO3320
      IF(ICASEQ.EQ.'FOR')GOTO3330
C
 3310 CONTINUE
      DO3315I=1,NLEFT
      ISUB(I)=1
 3315 CONTINUE
      NQ=NLEFT
      GOTO3350
C
 3320 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3350
C
 3330 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3350
C
 3350 CONTINUE
      MINN2=1
      IF(NQ.GE.MINN2)GOTO3360
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3351)
 3351 FORMAT('***** ERROR IN DPCHSZ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3352)
 3352 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3353)IHLEFT,IHLEF2
 3353 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3354)
 3354 FORMAT('      (FOR WHICH CHARACTER SIZES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3355)
 3355 FORMAT('      ARE TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3356)MINN2
 3356 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3357)
 3357 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3358)
 3358 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3359)(IANS(I),I=1,IWIDTH)
 3359 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3360 CONTINUE
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3370I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3370
      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
 3370 CONTINUE
      NS=J
      NY=J
C
C               *****************************************
C               **  STEP 34--                          **
C               **  EXTRACT THE DISTINCT VALUES        **
C               **  FROM THE TARGET VARIABLE Y(.)   .  **
C               **  STORE THEM IN X(.)   .             **
C               *****************************************
C
      IWRITE='OFF'
      CALL DISTIN(Y,NY,IWRITE,X,NX,IBUGP2,IERROR)
C
C               ***********************************
C               **  STEP 35--                    **
C               **  SORT THESE DISTINCT VALUES   **
C               **  (IN PLACE).                  **
C               ***********************************
C
      CALL SORT(X,NX,X)
C
C               ******************************************
C               **  STEP 36--                           **
C               **  COPY    THE NUMERIC VALUES IN X(.)  **
C               **  INTO INDIVIDUAL ELEMENTS            **
C               **  OF PCHAHE(.)                        **
C               **  NOTE--MAX NUMBER OF VALUES  = 100   **
C               ******************************************
C
      IMAX=NX
      IF(IMAX.GT.MAXCHA)IMAX=MAXCHA
      DO3650I=1,IMAX
      PCHAHE(I)=X(I)
 3650 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO3679
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO3675I=1,IMAX
      WRITE(ICOUT,3676)I,PCHAHE(I)
 3676 FORMAT('CHARACTER SIZE ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 3675 CONTINUE
 3679 CONTINUE
      GOTO8000
C
 8000 CONTINUE
      IFOUND='YES'
      DO8010I=1,MAXCHA
      PCHAWI(I)=PCHAHE(I)*0.5
      PCHAVG(I)=PCHAHE(I)*0.5
      PCHAHG(I)=PCHAWI(I)*0.5
 8010 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCHAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2
 9012 FORMAT('IBUGP2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)PDEFHE,IMAX
 9014 FORMAT('PDEFHE,IMAX = ',E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NY
 9021 FORMAT('NY = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NY.LE.0)GOTO9022
      DO9023I=1,NY
      WRITE(ICOUT,9024)I,Y(I)
 9024 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9023 CONTINUE
 9022 CONTINUE
      WRITE(ICOUT,9031)NX
 9031 FORMAT('NX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NX.LE.0)GOTO9032
      DO9033I=1,NX
      WRITE(ICOUT,9034)I,X(I)
 9034 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9033 CONTINUE
 9032 CONTINUE
      WRITE(ICOUT,9041)MAXCHA
 9041 FORMAT('MAXCHA = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NX.LE.0)GOTO9042
      DO9043I=1,NX
      WRITE(ICOUT,9044)I,PCHAHE(I),PCHAWI(I),PCHAVG(I),PCHAHG(I)
 9044 FORMAT('I,PCHAHE(I),PCHAWI(I),PCHAVG(I),PCHAHG(I) = ',I8,2X,
     14E15.7)
      CALL DPWRST('XXX','BUG ')
 9043 CONTINUE
 9042 CONTINUE
 9090 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHTH(IHARG,ARG,NUMARG,PDEFTH,MAXCHA,PCHATH,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER THICKNESSS FOR USE IN MULTI-TRACE PLOTS.
C              THE THICKNESS FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR PCHATH(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C                     --MAXCHA
C     OUTPUT ARGUMENTS--PCHATH  (A  REAL VECTOR
C                       WHOSE I-TH ELEMENT IS THE THICKNESS
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
      DIMENSION PCHATH(*)
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
 1100 CONTINUE
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'THIC')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'THIC')GOTO1105
      GOTO1199
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      PCHATH(I)=PDEFTH
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHATH(I)
 1116 FORMAT('ALL CHARACTER THICKNESSS HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1190
C
 1120 CONTINUE
      PCHATH(1)=ARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,PCHATH(I)
 1126 FORMAT('THE THICKNESS FOR CHARACTER ',I6,' HAS JUST BEEN ',
     1'SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1190
C
 1130 CONTINUE
      DO1135I=1,MAXCHA
      PCHATH(I)=ARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHATH(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1190
C
 1140 CONTINUE
      DO1145I=1,MAXCHA
      PCHATH(I)=ARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHATH(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1190
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
      IP1=I+1
      PCHATH(I)=ARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,PCHATH(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO1190
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      PCHATH(I)=PDEFTH
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHATH(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCHWI(IHARG,IARGT,IARG,ARG,NUMARG,
     1PDEFWI,
     1MAXCHA,
     1PCHAWI,PCHAHG,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER WIDTHS FOR USE IN MULTI-TRACE PLOTS.
C              THE WIDTH FOR THE CHARACTER FOR THE I-TH TRACE
C              WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE FLOATING POINT
C              VECTOR PCHAWI(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --PDEFWI
C                     --MAXCHA
C     OUTPUT ARGUMENTS--PCHAWI  (A  FLOATING POINT VECTOR
C                       WHOSE I-TH ELEMENT IS THE WIDTH (= WIDTHT)
C                       FOR THE CHARACTER
C                       ASSIGNED TO THE I-TH    TRACE    IN
C                       A MULTI-TRACE PLOT.
C                     --PCHAWI = CHARACTER WIDTH
C                     --PCHAHG = HORIZONTAL GAP BETWEEN CHARACTERS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PCHAWI(*)
      DIMENSION PCHAHG(*)
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
 1100 CONTINUE
C
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'WIDTH'.AND.
     1IHARG(2).EQ.'BOX'.AND.IHARG(3).EQ.'PLOT')GOTO2110
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'WIDT'.AND.
     1IHARG(2).EQ.'BOX'.AND.IHARG(3).EQ.'PLOT')GOTO2110
      IF(NUMARG.GE.4.AND.IHARG(2).EQ.'WIDTH'.AND.
     1IHARG(3).EQ.'BOX'.AND.IHARG(4).EQ.'PLOT')GOTO2110
      IF(NUMARG.GE.4.AND.IHARG(2).EQ.'WIDT'.AND.
     1IHARG(3).EQ.'BOX'.AND.IHARG(4).EQ.'PLOT')GOTO2110
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'WIDTH')GOTO1160
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'WIDT')GOTO1160
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'WIDTH')GOTO1105
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'WIDT')GOTO1105
      GOTO2199
C
 1105 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1110
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
C
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ALL')GOTO1160
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'ALL')GOTO1130
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'ALL')GOTO1140
C
      GOTO1150
C
 1110 CONTINUE
      DO1115I=1,MAXCHA
      PCHAWI(I)=PDEFWI
 1115 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHAWI(I)
 1116 FORMAT('ALL CHARACTER WIDTHS HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO2190
C
 1120 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB')GOTO1180
      PCHAWI(1)=ARG(2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1126)I,PCHAWI(I)
 1126 FORMAT('THE WIDTH FOR CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO2190
C
 1130 CONTINUE
      I=1
      IF(IARGT(3).NE.'NUMB')GOTO1180
      DO1135I=1,MAXCHA
      PCHAWI(I)=ARG(3)
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHAWI(I)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO2190
C
 1140 CONTINUE
      I=1
      IF(IARGT(2).NE.'NUMB')GOTO1180
      DO1145I=1,MAXCHA
      PCHAWI(I)=ARG(2)
 1145 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHAWI(I)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO2190
C
 1150 CONTINUE
      IMAX=NUMARG-1
      IF(MAXCHA.LT.IMAX)IMAX=MAXCHA
      DO1155I=1,IMAX
      IP1=I+1
      IF(IARGT(IP1).NE.'NUMB')GOTO1180
      PCHAWI(I)=ARG(IP1)
 1155 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1156I=1,IMAX
      WRITE(ICOUT,1126)I,PCHAWI(I)
      CALL DPWRST('XXX','BUG ')
 1156 CONTINUE
 1159 CONTINUE
      GOTO2190
C
 1160 CONTINUE
      DO1165I=1,MAXCHA
      PCHAWI(I)=PDEFWI
 1165 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1116)PCHAWI(I)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO2190
C
 1180 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('***** ERROR IN DPCHWI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('CHARACTER WIDTHS MUST BE NUMERIC;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('HOWEVER, THE SPECIFIED CHARACTER WIDTH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)I
 1184 FORMAT('FOR CHARACTER ',I6,' WAS NON-NUMERIC.')
      CALL DPWRST('XXX','BUG ')
      GOTO2199
C
 2110 CONTINUE
      IMAX=24
      PCHAWI(1)=1.0
      PCHAWI(2)=1.0
      PCHAWI(3)=1.0
      PCHAWI(4)=1.0
      PCHAWI(5)=1.0
      PCHAWI(6)=1.0
      PCHAWI(7)=1.0
      PCHAWI(8)=1.0
      PCHAWI(9)=1.0
      PCHAWI(10)=1.0
      PCHAWI(11)=1.0
      PCHAWI(12)=1.0
      PCHAWI(13)=1.0
      PCHAWI(14)=1.0
      PCHAWI(15)=1.0
      PCHAWI(16)=1.0
      PCHAWI(17)=1.0
      PCHAWI(18)=1.0
      PCHAWI(19)=1.0
      PCHAWI(20)=1.0
      PCHAWI(21)=1.5
      PCHAWI(22)=1.0
      PCHAWI(23)=1.0
      PCHAWI(24)=1.5
      GOTO2170
C
 2170 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO2179
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO2175I=1,IMAX
      WRITE(ICOUT,2176)I,PCHAWI(I)
 2176 FORMAT('THE WIDTH FOR CHARACTER ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 2175 CONTINUE
 2179 CONTINUE
      GOTO2180
C
 2180 CONTINUE
      IFOUND='YES'
      GOTO2190
C
 2190 CONTINUE
      IFOUND='YES'
      DO2191I=1,MAXCHA
      PCHAHG(I)=PCHAWI(I)*0.25
 2191 CONTINUE
C
 2199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCMAP(IHARG,NUMARG,IDCMAP,ICHMAP,IFOUND,IERROR)
C
C     PURPOSE--DEFINE PLOT CHARACTER MAPPING
C              (BY RANK    OR    BY EXACT)
C              WHICH LINKS TRACE ID AND CHARACTER
C              (THE CURRENT DEFAULT IS BY RANK).
C     EXAMPLE--IF HAVE DATA: X: 1 1 2 2 3 3
C                            Y: 1 2 3 4 5 6
C                          TAG: 1 1 3 3 5 5
C              AND CHARACTERS 1 2 3 4 5
C              AND DESIRE TO HAVE THE TRACES SHOW 1 3 AND 5
C              THEN CURRENTLY BY DEFAULT WOULD GET
C              TRACES SHOWING 1 2 3 (SINCE MAP VIA RANK)
C              BUT IF ENTER      CHARACTER MAP EXACT
C              THEN WOULD GET TRACES SHOWING 1 3 5 (AS DESIRED)
C     COMMAND EXAMPLE--CHARACTER MAP RANK (= DEFAULT)
C                      CHARACTER MAP EXACT
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDCMAP
C     OUTPUT ARGUMENTS--ICHMAP  (A  CHARACTER VARIABLE
C                       WHICH DEFINES THE MAP
C                       (RANK OR EXAC)
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--94/12
C     ORIGINAL VERSION--DECEMBER  1994.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDCMAP
      CHARACTER*4 ICHMAP
      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.1)THEN
         ICHMAP=IDCMAP
         GOTO1150
      ENDIF
C
      IF(NUMARG.GE.2)THEN
         IF(IHARG(NUMARG).EQ.'ON'.OR.
     1   IHARG(NUMARG).EQ.'OFF'.OR.
     1   IHARG(NUMARG).EQ.'AUTO'.OR.
     1   IHARG(NUMARG).EQ.'DEFA')THEN
            ICHMAP=IDCMAP
            GOTO1150
         ELSE IF(IHARG(NUMARG).EQ.'EXAC'.OR.
     1   IHARG(NUMARG).EQ.'1TO1')THEN
            ICHMAP='EXAC'
            GOTO1150
         ELSE IF(IHARG(NUMARG).EQ.'?')THEN
            GOTO1160
         ELSE
            ICHMAP=IHARG(2)
            GOTO1150
         ENDIF
      ENDIF
C
 1150 CONTINUE
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,999)
  999    FORMAT(1X)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1151)ICHMAP
 1151    FORMAT('THE CHARACTER MAPPING HAS JUST BEEN SET TO ',
     1   A4)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      IFOUND='YES'
      GOTO9000
C
 1160 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1161)
 1161 FORMAT('CHARACTER MAPPING HAS 2 POSSIBLE SETTINGS:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1162)
 1162 FORMAT('   RANK   AND   EXACT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1163)ICHMAP
 1163 FORMAT('THE CURRENT CHARACTER MAPPING IS    ',A4)
      CALL DPWRST('XXX','BUG ')
      IFOUND='YES'
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPCONC(IHARG,NUMARG,
     1IDEFCC,
     1ICONCH,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE CONTINUE CHARACTOR WHICH MAY
C              BE USED TO CONTINUE A COMMAND TO A SECOND
C              LINE (NO MORE THAN 2 LINES ALLOWED)
C              ABOUT THE ONLY PLACE THIS IS NECCESSARY
C              IN DATAPLOT IS IN ENTERING TITLES, ESPECIALLY
C              IF MANY SHIFTS ARE INCLUDED FOR UPPER, LOWER CASE
C              AND SPECIAL SYMBOLS
C
C              THE CONTINUE CHARACTER CAN BE UP TO 4 CHARACTERS LONG
C
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFCC (A  CHARACTER VARIABLE)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--ICONCH (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCC
      CHARACTER*4 ICONCH
      CHARACTER*4 IBUGS2
      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
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCONC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFCC
   53 FORMAT('IDEFCC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1150
      GOTO1110
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFCC
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ICONCH=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ICONCH
 1181 FORMAT('THE CONTINUE CHARACTER HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCONC-')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDEFCC,ICONCH
 9013 FORMAT('IDEFCC,ICONCH = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
