      SUBROUTINE DPFUNC(IBUGA3,IERROR,ISFLAG)
CCCCC APRIL 1996.  ADD ISFLAG ARGUMENT
CCCCC SUBROUTINE DPFUNC(IBUGA3,IERROR)
C
C     PURPOSE--TREAT THE SUBCASE OF THE LET FUNCTION COMMAND
C              IN WHICH A FUNCTION IS DEFINED.
C     EXAMPLE--LET FUNCTION F1 = SIN(2*X)
C            --LET FUNCTION F2 = SIN(A*B*X+2*C)+E*X**4  FOR X=Z
C            --LET FUNCTION F3 = F1 FOR X=7
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --JULY      1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     1996.  ISFLAG TO PRESERVE STRING CASE
C     UPDATED         --JULY      1998.  FOR STRINGS, CHECK FOR
C                                        SP() AND CONVERT TO SPACE.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 IWD1
      CHARACTER*4 IWD2
      CHARACTER*4 IWD12
      CHARACTER*4 IWD22
      CHARACTER*4 ILAB
      CHARACTER*4 IKEY
      CHARACTER*4 IKEY2
      CHARACTER*4 INCLUN
      CHARACTER*4 IFOUND
      CHARACTER*4 IFOUN1
      CHARACTER*4 IFOUN2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IOLD
      CHARACTER*4 IOLD2
      CHARACTER*4 INEW
      CHARACTER*4 INEW2
      CHARACTER*4 IHOUT
      CHARACTER*4 IHOUT2
      CHARACTER*4 IUOUT
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC APRIL 1996.  ADD FOLLOWING LINE
      CHARACTER*10 ISFLAG
CCCCC JULY 1998.  ADD FOLLOWING LINE
      CHARACTER*4 IATEMP
C
C---------------------------------------------------------------------
C
      DIMENSION ILAB(10)
C
      DIMENSION IOLD(10)
      DIMENSION IOLD2(10)
      DIMENSION INEW(10)
      DIMENSION INEW2(10)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPFU'
      ISUBN2='NC  '
C
      IERROR='NO'
C
      ILOC3=0
C
C               *****************************************************
C               **  TREAT THE SUBCASE OF THE LET FUNCTION COMMAND  **
C               **  WHICH DEFINES A FUNCTION                       **
C               *****************************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFUNC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMNAM
   53 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMNAM
      WRITE(ICOUT,56)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
   56 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1I8,2X,A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)NUMCHF,MAXCHF
   57 FORMAT('NUMCHF,MAXCHF = ',2I8)
      CALL DPWRST('XXX','BUG ')
      NMAX=120
      IF(MAXCHF.LT.NMAX)NMAX=MAXCHF
CCCCC WRITE(ICOUT,60)(IFUNC(I),I=1,MAXCHF)
      WRITE(ICOUT,60)(IFUNC(I),I=1,NMAX)
   60 FORMAT('IFUNC(.)  = ',120A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
C
C               ****************************************************************
C               **  STEP 2--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE FUNCTION NAME TO LEFT OF = SIGN                     *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               ****************************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(2)
      IHLEF2=IHARG2(2)
      DO2000I=1,NUMNAM
      I2=I
      IF(IHLEFT.EQ.IHNAME(I).AND.IHLEF2.EQ.IHNAM2(I))GOTO2100
 2000 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO2200
      GOTO2900
 2200 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2201)
 2201 FORMAT('***** ERROR IN DPFUNC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2202)
 2202 FORMAT('      THE NUMBER OF VARIABLE, PARAMETER, & FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2203)MAXNAM
 2203 FORMAT('      NAMES HAS JUST EXCEEDED THE ALLOWABLE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2204)
 2204 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2205)
 2205 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2206)
 2206 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2207)
 2207 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2100 CONTINUE
      ILISTL=I2
 2900 CONTINUE
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  EXTRACT THE RIGHT-SIDE                                   **
C               **  EXPRESSION FROM THE INPUT COMMAND LINE                   **
C               **  (STARTING WITH THE FIRST NON-BLANK LOCATION AFTER THE    **
C               **  EQUAL SIGN AND ENDING WITH THE END OF THE LINE           **
C               **  OR WITH THE LAST NON-BLANK CHARACTER BEWRTE     FOR  .   **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC APRIL 1996.  FOR LET STRING, PRESERVE CASE.  FOR LET FUNCTION,
CCCCC CONVERT TO UPPER CASE.
      IWD1='=   '
      IWD12='    '
      IWD2='FOR '
      IWD22='    '
      IF(ISFLAG.EQ.'FUNCTION')THEN
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      ELSE
      CALL DPEXST(IANSLC,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      ENDIF
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3900
C
      IWD1='=   '
      IWD12='    '
      IWD2='    '
      IWD22='    '
      IF(ISFLAG.EQ.'FUNCTION')THEN
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      ELSE
      CALL DPEXST(IANSLC,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      ENDIF
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3900
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3101)
 3101 FORMAT('***** ERROR IN DPFUNC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3102)
 3102 FORMAT('      INVALID COMMAND FORM FOR FUNCTION DEFINITION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3103)
 3103 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3104)
 3104 FORMAT('      LET FUNCTION ... = ... FOR ... = ... ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3105)
 3105 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3106)(IANS(I),I=1,MIN(IWIDTH,100))
 3106 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3900 CONTINUE
C
C               ***********************************************************
C               **  STEP 4.1--                                            **
C               **  DETERMINE IF THE EXPRESSION HAS ANY FUNCTION NAMES   **
C               **  INBEDDED.  IF SO, REPLACE THE FUNCTION NAMES         **
C               **  BY EACH FUNCTION'S DEFINITION.  DO SO REPEATEDLY     **
C               **  UNTIL ALL FUNCTION REFERENCES HAVE BEEN ANNIHILATED  **
C               **  AND THE EXPRESSION IS LEFT ONLY WITH                 **
C               **  CONSTANTS, PARAMETERS, AND VARIABLES--NO FUNCTIONS.  **
C               **  PLACE THE RESULTING FUNCTIONAL EXPRESSION INTO IFUNC3(.) **
C               ***********************************************************
C
      ISTEPN='4.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
CCCCC JULY 1998.  CHECK FOR "SP()" IN STRINGS AND CONVERT TO SPACE.
      IF(ISFLAG.NE.'FUNCTION'.AND.N3.GE.4)THEN
        DO4100I=N3,4,-1
          IATEMP(1:1)=IFUNC3(I-3)(1:1)
          IATEMP(2:2)=IFUNC3(I-2)(1:1)
          IATEMP(3:3)=IFUNC3(I-1)(1:1)
          IATEMP(4:4)=IFUNC3(I)(1:1)
          IF(
     1       IATEMP(3:4).EQ.'()'.AND.
     1      (IATEMP(2:2).EQ.'P'.OR.IATEMP(2:2).EQ.'p').AND.
     1      (IATEMP(1:1).EQ.'S'.OR.IATEMP(1:1).EQ.'s')
     1    )THEN
            IFUNC3(I-3)=' '
            DO4110J=I-2,N3-3
              J2=J+3
              IFUNC3(J)=IFUNC3(J2)
 4110       CONTINUE
            DO4120J=N3-2,N3
              IFUNC3(J)=' '
 4120       CONTINUE
            N3=N3-3
          ENDIF
 4100   CONTINUE
      ENDIF
C
C               **********************************************
C               **  STEP 4.2--                              **
C               **  PRINT OUT A BRIEF MESSAGE               **
C               **  INDICATING THAT THE FUNCTION            **
C               **  DEFINITION HAS BEEN CARRIED OUT.        **
C               **********************************************
C
      ISTEPN='4.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFEEDB.EQ.'OFF')GOTO5190
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='INPU'
      ILAB(2)='T FU'
      ILAB(3)='NCTI'
      ILAB(4)='ON  '
      ILAB(5)='    '
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC2,N2,IBUGA3)
C
      ILAB(1)='OUTP'
      ILAB(2)='UT F'
      ILAB(3)='UNCT'
      ILAB(4)='ION '
      ILAB(5)='    '
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
 5190 CONTINUE
C
C               *************************************
C               **  STEP 5--                       **
C               **  EXTRACT QUALIFIER INFORMATION. **
C               *************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *************************************
C               **  STEP 5--                       **
C               **  EXTRACT QUALIFIER INFORMATION. **
C               *************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               **********************************************
C               **  STEP 6.3--                              **
C               **  SCAN THE QUALIFIERS FOR VARIABLE,       **
C               **  PARAMETER, FUNCTION, AND VALUE CHANGES  **
C               **  IN THE FUNCTION.                        **
C               **********************************************
C
      ISTEPN='6.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCLM=1
C
      NCHANG=0
      DO6300IFORI=1,10
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=1
      IF(IFORI.EQ.1)ILOCA=ILOCLM
      IF(IFORI.NE.1)ILOCA=ILOC3
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO6380
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO6350
C
      ILOC3=ILOC2+2
      IF(ILOC3.GT.NUMARG)GOTO6380
      NCHANG=NCHANG+1
      IOLD(NCHANG)=IHARG(ILOC2)
      IOLD2(NCHANG)=IHARG2(ILOC2)
      INEW(NCHANG)=IHARG(ILOC3)
      INEW2(NCHANG)=IHARG2(ILOC3)
C
 6300 CONTINUE
 6350 CONTINUE
      GOTO6390
C
 6380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6301)
 6301 FORMAT('***** ERROR IN DPFUNC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6302)
 6302 FORMAT('      INVALID COMMAND FORM FOR LET FUNCTION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6303)
 6303 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6304)
 6304 FORMAT('      LET FUNCTION ... = ...  FOR ... ',
     1'FOR ... = ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6305)
 6305 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,6306)(IANS(I),I=1,MIN(IWIDTH,100))
 6306 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 6390 CONTINUE
C
C               **********************************************
C               **  STEP 6.4--                              **
C               **  CARRY OUT THE VARIABLE,                 **
C               **  PARAMETER, AND FUNCTION CHANGES         **
C               **  AND THEN PRINT OUT A BRIEF MESSAGE      **
C               **  INDICATING THAT THE CHANGES             **
C               **  HAVE BEEN MADE.                         **
C               **********************************************
C
      ISTEPN='6.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFEEDB.EQ.'OFF')GOTO6490
      IF(NCHANG.LE.0)GOTO6490
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='PRE '
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      CALL COMPIC(IFUNC3,N3,IOLD,IOLD2,INEW,INEW2,NCHANG,
     1IFUNC3,N3,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      ILAB(1)='POST'
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
 6490 CONTINUE
C
C               *******************************************************
C               **  STEP 6.5--                                       **
C               **  FOR THE CASE WHEN THE OUTPUT IS A FUNCTION,      **
C               **  DETERMINE IF THE INSERTION  OF THE NEW FUNCTION  **
C               **  INTO THE GENERAL FUNCTION TABLE WOULD OVERFLOW   **
C               **  THE TABLE.  IF NOT, THEN INSERT THE FUNCTION     **
C               **  INTO THE GENERAL FUNCTION TABLE.                 **
C               **  MAKE ADJUSTMENTS TO THE INTERNAL LIST.           **
C               *******************************************************
C
      ISTEPN='6.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPINFU(IFUNC3,N3,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IHLEFT,IHLEF2,ILISTL,NEWNAM,MAXN3,
     1IFUNC,NUMCHF,MAXCHF,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
 6590 CONTINUE
C
C               **********************************************
C               **  STEP 6.6--                              **
C               **  FOR THE CASE WHEN THE OUTPUT            **
C               **  IS A FUNCTION,                          **
C               **  PRINT OUT A BRIEF MESSAGE               **
C               **  INDICATING THAT THE FUNCTION            **
C               **  DEFINITION HAS BEEN CARRIED OUT.        **
C               **********************************************
C
      ISTEPN='6.6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO6690
      IF(IFEEDB.EQ.'OFF')GOTO6690
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6606)IHLEFT,IHLEF2
 6606 FORMAT('THE NAME ',A4,A4,' HAS JUST BEEN EQUIVALENCED ')
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='TO T'
      ILAB(2)='HE F'
      ILAB(3)='UNCT'
      ILAB(4)='ION '
      ILAB(5)='    '
      ILAB(6)=' -- '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
 6690 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 DPFUNC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3
 9012 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMNAM
 9013 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMNAM
      WRITE(ICOUT,9016)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
 9016 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1I8,2X,A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)N2,N3,NUMCHF,MAXN2,MAXN3,MAXCHF
 9017 FORMAT('N2,N3,NUMCHF,MAXN2,MAXN3,MAXCHF = ',6I8)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9018)(IFUNC2(I),I=1,N2)
      NMAX=N2
      IF(NMAX.GT.120)NMAX=120
      WRITE(ICOUT,9018)(IFUNC2(I),I=1,NMAX)
 9018 FORMAT('IFUNC2(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)(IFUNC3(I),I=1,MIN(N3,120))
 9019 FORMAT('IFUNC3(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)(IFUNC(I),I=1,MIN(MAXCHF,120))
 9020 FORMAT('IFUNC(.)  = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IERROR
 9021 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPGCI(NPTS,NLAB,
     1AMEAN,ASD,N,
     1DTEMP1,DTEMP2,
     1XGCI,SEGCI,
     1DLOWGC,DHIGGC,
     1IWRITE,IOUNI5,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--IMPLEMENT IYER-WANG APPROACH OF GENERALIZED CONFIDENCE
C              INTERVALS TO CONSENSUS MEANS.  NOTE THAT THIS
C              ROUTINE DOES NOT RETURN AN ESTIMATE OF THE
C              STANDARD ERROR OF THE CONSENSUS MEAN, JUST CONFIDENCE
C              LIMITS DETERMINED VIA SIMULATION.
C     PRINTING--YES
C     SUBROUTINES NEEDED--GCI1
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IMETH
C
      DOUBLE PRECISION DTEMP1(*)
      DOUBLE PRECISION DTEMP2(*)
C
      REAL AMEAN(*)
      REAL ASD(*)
C
      REAL XGCI
      REAL SEGCI
C
      INTEGER N(*)
C
      DOUBLE PRECISION DALPHA
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      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='DPGC'
      ISUBN2='I   '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PGCI')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPGCI--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB
   52   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      DO100I=1,NLAB
        IINDX1=I
        IINDX2=I+NLAB
        DTEMP1(IINDX1)=DBLE(AMEAN(I))
        DTEMP1(IINDX2)=DBLE(ASD(I))**2
  100 CONTINUE
      IINDX1=1
      IINDX2=1+NLAB
      IINDX3=1+2*NLAB
      IINDX4=1+3*NLAB
C
      DALPHA=0.95
      NRUN=10000
      IERROR='NO'
C
      CALL GCI1(NLAB,N,DTEMP1(IINDX1),DTEMP1(IINDX2),
     1          DALPHA,NRUN,DTERM1,
     1          DLOWGC,DHIGGC,DTERM2,
     1          DTEMP1(IINDX3),DTEMP1(IINDX4),DTEMP2,
     1          IERROR)
      SEGCI=REAL(DTERM2)
      IF(IERROR.EQ.'YES')THEN
         XGCI=0.0
         SEGCI=0.0
         DLOWGC=0.0D0
         DHIGGC=0.0D0
         GOTO9000
      ELSE
         XGCI=REAL(DTERM1)
      ENDIF
C
      DO200I=1,NRUN
        WRITE(IOUNI5,'(E15.7)')DTEMP2(I)
  200 CONTINUE
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5107)
 5107   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('<TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=400>')
 5127   FORMAT('      </TD>')
 5126   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5128   FORMAT('   </TR>')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('         &nbsp;')
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5170)
 5170   FORMAT('         <b>9. Method: Generalized Confidence ',
     1         'Intervals</b>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Estimate of Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XGCI
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
 5172   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Standard Uncertainty (k = 1):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SEGCI
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
 5173   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Expanded Uncertainty (k=2):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)2.0*SEGCI
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5182)
 5182   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Lower 95% (Simulation) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DLOWGC)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5183)
 5183   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Upper 95% (Simulation) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DHIGGC)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5184)
 5184   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Note: Generalized Confidence Interval Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5185)
 5185   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Any Number of Labs')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
C
 8002   FORMAT(A1,'begin{table}')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf 9. Method: Generalized Confidence ',
     1         'Interval:} & ',
     1         2X,A1,A1)
 8012   FORMAT(5X,'Estimate of Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
 8013   FORMAT(5X,'Standard Uncertainty (k = 1): & ',
     1         F15.7,2X,A1,A1)
 8014   FORMAT(5X,'Expanded Uncertainty (k = 2): & ',
     1         F15.7,2X,A1,A1)
C
        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)XGCI,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)SEGCI,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)2.0*SEGCI,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8026   FORMAT(5X,'Lower 95',A1,'% (Simulation) Confidence ',
     1         'Interval: & ',
     1         F15.7,2X,A1,A1)
 8027   FORMAT(5X,'Upper 95',A1,'% (Simulation) Confidence ',
     1         'Interval: & ',
     1         F15.7,2X,A1,A1)
 8028   FORMAT(5X,'Note: Generalized Confidence Interval ',
     1         'Best Usage: & ',
     1         2X,A1,A1)
 8029   FORMAT(5X,'      Any Number of Labs ',
     1         '& ',2X,A1,A1)
        WRITE(ICOUT,8026)IBASLC,REAL(DLOWGC),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,REAL(DHIGGC),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*5500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b 9. Method: Generalized CI'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=28
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=30
        IVALUE(1)='   Estimate of Consensus Mean:'
        AVALUE(2)=XGCI
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Standard Uncertainty (k = 1):'
        AVALUE(2)=SEGCI
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Expanded Uncertainty (k = 2):'
        AVALUE(2)=2.0*SEGCI
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=43
        IVALUE(1)='   Lower 95% (simulation) Confidence Limit:'
        AVALUE(2)=REAL(DLOWGC)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=43
        IVALUE(1)='   Upper 95% (simulation) Confidence Limit:'
        AVALUE(2)=REAL(DHIGGC)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IVALUE(1)='   Note: Generalized CI Best Usage:'
        NCHAR(1)=35
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         Any Number of Labs'
        NCHAR(1)=27
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('9.  Method: Generalized Confidence Intervals')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4002)XGCI
 4002   FORMAT('    Estimate of Consensus Mean:              ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4003)SEGCI
 4003   FORMAT('    Standard Uncertainty (k = 1):            ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4004)2.0*SEGCI
 4004   FORMAT('    Expanded Uncertainty (k = 2):            ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4022)REAL(DLOWGC)
 4022   FORMAT('    Lower 95% (Simulation) Confidence Limit: ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)REAL(DHIGGC)
 4023   FORMAT('    Upper 95% (Simulation) Confidence Limit: ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('    Note: Generalized Confidence Interval ',
     1         'Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)
 4032   FORMAT('          Any Number of Labs, but no ',
     1         'Between Lab Variance')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PGCI')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPGCI--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NLAB
 9013   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)XGCI
 9014   FORMAT('XGCI = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)DLOWGC,DHIGGC
 9015   FORMAT('DLOWGC,DHIGGC = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPGCL(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR GREEK COMPLEX LOWER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPGCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHGR(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.9)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DGCL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(10.LE.ICHARN.AND.ICHARN.LE.20)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DGCL2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(ICHARN.GE.21)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DGCL3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPGCU(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR GREEK COMPLEX UPPER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPGCU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHGR(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.14)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DGCU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.15)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DGCU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGCU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPGENS(INCASE,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE SPECIALIZED MATHEMATICAL NUMBER SEQUENCES--
C                 1) PRIME NUMBERS
C                 2) FIBONACCI SEQUENCES
C                 3) LOGISTIC NUMBERS
C                 4) BERNOULI NUMBERS
C                 5) EULER NUMBERS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/10
C     ORIGINAL VERSION--SEPTEMBER 1987.
C     UPDATED         --APRIL     1989.  LOGISTIC SEQUENCE (CHAOS THEORY)
C     UPDATED         --APRIL     1989.  CANTOR SET (CHAOS THEORY)
C     UPDATED         --JULY      1993.  CANTOR SET (NO ERROR IF P NOT
C                                        PREVIOUSLY DEFINED)
C     UPDATED         --FEBRUARY  1994.  EQUIVALENCE
C     UPDATED         --SEPTEMBER 1997.  BERNOULI NUMBERS
C     UPDATED         --SEPTEMBER 1997.  EULER NUMBERS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 INCASE
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 ICASEQ
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED FOR LOGISTIC   APRIL 1989
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
CCCCC THE FOLLOWING LINE WAS ADDED FOR CANTOR SET    APRIL 1989
      DIMENSION TEMP(MAXOBV)
      DOUBLE PRECISION TEMP2(MAXOBV/2)
CCCCC FOLLOWING LINES ADDED FEBRUARY, 1994
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),TEMP(1))
      EQUIVALENCE (G2RBAG(IGAR12),TEMP2(1))
CCCCC END CHANGE
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='DPGE'
      ISUBN2='NS  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
C
      NS2=0
C
C               ***********************************************
C               **  TREAT THE MATH NUMBER GENERATION CASE    **
C               **       1) FOR A FULL VARIABLE, OR          **
C               **       2) FOR PART OF A VARIABLE.          **
C               ***********************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPGENS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)INCASE,IBUGA3,IBUGQ
   52 FORMAT('INCASE,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
      NEWCOL='NO'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=3
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 3--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN        *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  NOTE THAT     ILEFT      IS THE NAME OF THE VARIABLE       *
C               **  ON THE LEFT.                                               *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               **  NOTE THAT     ICOLL    IS THE DATA COLUMN (1 TO 12)        *
C               **  FOR THE NAME OF THE LEFT.                                  *
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC ILEFT=IHOL(2)
CCCCC ILEFT2=IHOL2(2)
      ILEFT=IHARG(1)
      ILEFT2=IHARG2(1)
      DO310I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO329
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO380
  310 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO320
      GOTO330
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPGENS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)MAXNAM
  323 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  329 CONTINUE
      ILISTL=I2
      GOTO330
C
  330 CONTINUE
      NLEFT=0
      ICOLL=NUMCOL+1
      IF(ICOLL.GT.MAXCOL)GOTO340
      GOTO390
C
  340 CONTINUE
      WRITE(ICOUT,341)
  341 FORMAT('***** ERROR IN DPGENS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,342)
  342 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,343)MAXCOL
  343 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,344)
  344 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,345)
  345 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,346)
  346 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,347)
  347 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,348)
  348 FORMAT('      IF       LET X(I) = 3.14         FAILED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,349)
  349 FORMAT('      THEN ONE MIGHT ENTER     NAME X 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,350)
  350 FORMAT('      (THEREBY EQUATING THE NAME X WITH COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,351)
  351 FORMAT('      FOLLOWED BY              LET X = 3.14')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,352)
  352 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,353)
  353 FORMAT('      WITH THE NUMERIC CONSTANTS 3.14)')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  380 CONTINUE
      ILISTL=I2
      ICOLL=IVALUE(ILISTL)
      NLEFT=IN(ILISTL)
C
  390 CONTINUE
C
C               *****************************************
C               **  STEP 6--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)           **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO670
      DO610J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO620
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO620
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO630
  610 CONTINUE
      GOTO680
C
  620 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO680
C
  630 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO680
C
  670 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,671)
  671 FORMAT('***** INTERNAL ERROR IN DPGENS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,672)
  672 FORMAT('      AT BRANCH POINT 5081--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,673)
  673 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,674)
  674 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,675)NUMARG
  675 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,676)
  676 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,677)(IANS(I),I=1,IWIDTH)
  677 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  680 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO690
      WRITE(ICOUT,681)NUMARG,ILOCQ,ICASEQ
  681 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
  690 CONTINUE
C
C               ******************************************************
C               **  STEP 7--                                        **
C               **  BRANCH TO THE APPROPRIATE SUBCASE               **
C               **  (BASED ON THE QUALIFIER);                       **
C               **  DETERMINE THE NUMBER (= NUMNUM)                 **
C               **  OF NUMBERS TO BE GENERATED.                     **
C               **  NOTE THAT THE VARIABLE NIISUB                   **
C               **  IS THE LENGTH OF THE RESULTING                  **
C               **  VARIABLE ISUB(.).                               **
C               **  NOTE THAT DPFOR AUTOMATICALLY EXTENDS           **
C               **  THE INPUT LENGTH OF ISUB(.) IF NECESSARY.       **
C               **  (HENCE THE REDEFINITION OF NIISUB TO NINEW      **
C               **  AFTER THE CALL TO DPFOR.                        **
C               ******************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO710
      IF(ICASEQ.EQ.'SUBS')GOTO720
      IF(ICASEQ.EQ.'FOR')GOTO730
C
  710 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      DO715I=1,NIISUB
      ISUB(I)=1
  715 CONTINUE
      NUMNUM=NIISUB
      GOTO750
C
  720 CONTINUE
      NIISUB=MAXN
      CALL DPSUBS(NIISUB,ILOCS,NS,IBUGQ,IERROR)
      NUMNUM=NS
      GOTO750
C
  730 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      CALL DPFOR(NIISUB,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIISUB=NINEW
      NUMNUM=NS
      GOTO750
C
  750 CONTINUE
C
CCCCC THE ENTIRE SECTION 8 WAS REVAMPED IN ADDING  LOGISTIC AND CANTOR APRIL 198
C               *******************************************
C               **  STEP 8--                             **
C               **  GENERATE    NUMNUM    NUMBERS        **
C               **  STORE THEM TEMPORARILY IN            **
C               **  THE VECTOR Y(.).                     **
C               *******************************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(INCASE.EQ.'PRIM')GOTO1100
      IF(INCASE.EQ.'FIBO')GOTO1200
      IF(INCASE.EQ.'LOGI')GOTO1300
      IF(INCASE.EQ.'CANT')GOTO1400
      IF(INCASE.EQ.'BERN')GOTO1500
      IF(INCASE.EQ.'EULE')GOTO1600
      IFOUND='NO'
      GOTO9000
C
 1100 CONTINUE
      CALL PRIMES(NUMNUM,Y,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO1900
C
 1200 CONTINUE
      CALL FIBONN(NUMNUM,Y,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO1900
C
 1300 CONTINUE
      IHP='X0  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      Y0=VALUE(ILOCP)
C
      IF(Y0.GE.0.0.AND.Y0.LE.1.0)GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPGENS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE STARTING POINT X0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      FOR THE LOGISTIC SEQUENCE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1314)
 1314 FORMAT('      X(N+1) = K * X(N) * (1 - X(N))')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('      MUST BE BETWEEN 0 AND 1 INCLUSIVE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)Y0
 1317 FORMAT('      THE CURRENT VALUE OF X0 IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1319 CONTINUE
C
      IHP='K   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AK=VALUE(ILOCP)
C
      IF(AK.GE.0.0.AND.AK.LE.4.0)GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('***** ERROR IN DPGENS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1322)
 1322 FORMAT('      THE MULTIPLICATION FACTOR K')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1323)
 1323 FORMAT('      FOR THE LOGISTIC SEQUENCE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1324)
 1324 FORMAT('      X(N+1) = K * X(N) * (1 - X(N))')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('      MUST BE BETWEEN 0 AND 4 INCLUSIVE;.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)
 1326 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1327)AK
 1327 FORMAT('      THE CURRENT VALUE OF K IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1329 CONTINUE
C
      CALL LOGIST(NUMNUM,Y,Y0,AK,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO1900
C
 1400 CONTINUE
CCCCC JULY 1993.  SET P TO 0.33333 IF NOT PROVIDED.
CCCCC DON'T CALL CHECKN (AVOID ERROR MESSAGE)
      IHP='P   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
CCCCC CALL CHECKN(IHP,IHP2,IHWUSE,
CCCCC1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
CCCCC1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
CCCCC IF(IERROR.EQ.'YES')GOTO9000
CCCCC P=VALUE(ILOCP)
      P=0.333333
C
      IF(P.GE.0.0.AND.AK.LE.1.0)GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPGENS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      THE FRACTIONAL HOLE SIZE P')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      FOR THE CANTOR SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
 1414 FORMAT('      MUST BE BETWEEN 0 AND 1 INCLUSIVE;.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)P
 1416 FORMAT('      THE CURRENT VALUE OF P IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1419 CONTINUE
C
      CALL CANTOR(NUMNUM,Y,P,TEMP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO1900
C
 1500 CONTINUE
      CALL BERNOB(NUMNUM,TEMP2(1))
      DO1510I=1,NUMNUM
        IF(TEMP2(I).GE.DBLE(CPUMAX))THEN
          Y(I)=CPUMAX
          WRITE(ICOUT,1515)
          CALL DPWRST('XXX','BUG')
 1515     FORMAT('**** ERROR: COMPUTED BERNOULLI NUMBER RESULTS ',
     1           'IN OVERFLOW, SET TO MACHINE MAXIMUM.')
        ELSE
          Y(I)=SNGL(TEMP2(I))
        ENDIF
 1510 CONTINUE
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO1900
C
 1600 CONTINUE
      CALL EULERB(NUMNUM,TEMP2(1))
      DO1610I=1,NUMNUM
        IF(TEMP2(I).GE.DBLE(CPUMAX))THEN
          Y(I)=CPUMAX
          WRITE(ICOUT,1615)
          CALL DPWRST('XXX','BUG')
 1615     FORMAT('**** ERROR: COMPUTED EULER NUMBER RESULTS ',
     1           'IN OVERFLOW, SET TO MACHINE MAXIMUM.')
        ELSE
          Y(I)=SNGL(TEMP2(I))
        ENDIF
 1610 CONTINUE
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO1900
C
 1900 CONTINUE
C
C               ***********************************************************
C               **  STEP 8--                                             **
C               **  IF CALLED FOR (THAT IS, IF IBUGA3 IS ON),      **
C               **  PRINT OUT THE INTERMEDIATE VARIABLE Y(.).            **
C               **  THIS IS USEFUL FOR DIAGNOSTIC PURPOSES               **
C               **  IN REVIEWING THE OUTPUT FROM THIS SUBROUTINE.        **
C               ***********************************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO2090
      WRITE(ICOUT,2051)
 2051 FORMAT('OUTPUT FROM MIDDLE OF DPGENS AFTER INDIVIDUAL ',
     1'GENERATORS HAVE BEEN CALLED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2052)NUMNUM
 2052 FORMAT('NUMNUM = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMNUM.LE.0)GOTO2090
      DO2054I=1,NUMNUM
      WRITE(ICOUT,2055)I,Y(I)
 2055 FORMAT('I,Y(I) = ',I8,F12.5)
      CALL DPWRST('XXX','BUG ')
 2054 CONTINUE
C
 2090 CONTINUE
C
C               ******************************************************
C               **  STEP 9--                                        **
C               **  COPY THE GENERATED NUMBERS                      **
C               **  FROM THE INTERMEDIATE VECTOR Y(.)               **
C               **  TO THE APPROPRIATE COLUMN                       **
C               **  (BASED ON THE QUALIFIER--FULL, SUBSET, OR FOR)  **
C               **  IN THE INTERNAL DATAPLOT DATA TABLE.            **
C               ******************************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS2=0
      DO2100I=1,NIISUB
      IJ=MAXN*(ICOLL-1)+I
      IF(ISUB(I).EQ.0)GOTO2100
      NS2=NS2+1
      IF(ICOLL.LE.MAXCOL)V(IJ)=Y(NS2)
      IF(ICOLL.EQ.MAXCP1)PRED(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP2)RES(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=Y(NS2)
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 2100 CONTINUE
C
C               *******************************************
C               **  STEP 10--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING.   **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO')NINEW=NLEFT
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'YES')NINEW=MAXN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
C
      IHNAME(ILISTL)=ILEFT
      IHNAM2(ILISTL)=ILEFT2
      IUSE(ILISTL)='V'
      IVALUE(ILISTL)=ICOLL
      VALUE(ILISTL)=ICOLL
      IN(ILISTL)=NINEW
C
CCCCC IUSE(ICOLL)='V'
CCCCC IVALUE(ICOLL)=ICOLL
CCCCC VALUE(ICOLL)=ICOLL
CCCCC IN(ICOLL)=NINEW
C
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM.EQ.'YES')NUMCOL=NUMCOL+1
C
      DO4100J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO4105
      GOTO4100
 4105 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
 4100 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO4059
      IF(IFEEDB.EQ.'OFF')GOTO4059
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4011)ILEFT,ILEFT2,NS2
 4011 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOLL-1)+IROW1
      IF(ICOLL.LE.MAXCOL)WRITE(ICOUT,4021)ILEFT,ILEFT2,V(IJ),IROW1
      IF(ICOLL.LE.MAXCOL)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1)WRITE(ICOUT,4021)ILEFT,ILEFT2,PRED(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2)WRITE(ICOUT,4021)ILEFT,ILEFT2,RES(IROW1),IROW1
      IF(ICOLL.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3)WRITE(ICOUT,4021)ILEFT,ILEFT2,YPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP3)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4)WRITE(ICOUT,4021)ILEFT,ILEFT2,XPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP4)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5)WRITE(ICOUT,4021)ILEFT,ILEFT2,X2PLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP5)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6)WRITE(ICOUT,4021)ILEFT,ILEFT2,TAGPLO(IROW1),
     1IROW1
 4021 FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL.EQ.MAXCP6)CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOLL-1)+IROWN
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,V(IJ),IROWN
 4031 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,PRED(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,RES(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,YPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,XPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,X2PLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,TAGPLO(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(NS2.NE.1)GOTO4090
      WRITE(ICOUT,4041)
 4041 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4042)
 4042 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
 4090 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4112)ILEFT,ILEFT2,ICOLL
 4112 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4113)ILEFT,ILEFT2,NINEW
 4113 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 4059 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGENS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)INCASE,IBUGA3,IBUGQ
 9013 FORMAT('INCASE,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NS2
 9015 FORMAT('NS2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NS,NIISUB,NUMNUM
 9016 FORMAT('NS,NIISUB,NUMNUM = ',I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPGETC(IOUNI0,MAXWID,ITERCH,ICONCH,IANS,IANSLC,IWIDTH,
     1IANSV,IWIDSV,
     1IREPST,IREPPO,IANSSV,IREPMX,IPOINT,
CCCCC ADD FOLLOWING LINE DECEMBER 1997.
     1IPLTST,IPLTPO,IPLTSV,
     1IPROSW,
CCCCC THE FOLLOWING LINE WAS AUGMENTED      AUGUST 1994
CCCCC1IMACRO,IMACNU,IMACCS,
     1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IMALEV,
     1IPROGR,
     1ICONCL,
     1IEOF,
     1IIFSW,
     1ICAPSW,IPRDEF,
     1IATXSW,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,IVARLB,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,ILOOST,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
CCCCC THE ICAPSW AND IPRDEF ARGUMENTS ABOVE WERE ADDED JUNE 1989
C
C     PURPOSE--GET A COMMAND TO BE PROCESSED.
C              SUCH A COMMAND IS GOTTEN IN 2 WAYS--
C                   1) TO READ FROM THE STANDARD
C                      INPUT UNIT (THIS IS DONE
C                      ONLY WHEN NO PREVIOUS COMMANDS
C                      HAVE BEEN SAVED IN A BUFFER);
C                   2) TO EXTRACT THE NEXT COMMAND
C                      STATEMENT IN THE SAVED BUFFER
C                      (THIS IS DONE ONLY WHEN PREVIOUS
C                      COMMANDS HAVE IN FACT BEEN SAVED
C                      IN A BUFFER).
C
C     INPUT  ARGUMENTS--MAXWID (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE MAXIMUM NUMBER
C                              OF CHARACTERS PER LINE
C                              THAT MAY BE READ.
C                     --ITERCH (A HOLLARITH VARIABLE
C                              CONTAINING THE SEPARATOR CHARACTOR
C                              WHICH MAY BE USED FOR SEPARATING
C                              MULTIPLE COMMAND STATEMENTS PER LINE.
C                     --ICONCH (A HOLLERITH VARIABLE
C                              CONTAINING THE CONTINUE CHARACTER
C                              WHICH MAY BE USED FOR EXTENDING COMMANDS
C                              ONTO A SECOND LINE
C                     --IANSV  (A  HOLLARITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              SAVED COMMAND LINE.
C                     --IWIDSV (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE SAVED COMMAND LINE.
C                     --IPOINT THE CURRENT  POINTER POSITION
C                              IN THE SAVE ARRAY WHERE THE CURRENT COMMAND
C                              LINE WILL BE SAVED.
C                     --ISAVPO IF IN REPEAT MODE EXECUTION,
C                              THE CURRENT POINTER POSITION
C                              IN THE SAVE ARRAY WOF THE COMMAND CURRENTLY
C                              BEING EXECUTED.
C     OUTPUT ARGUMENTS--IANS   (A  HOLLARITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              CURRENT COMMAND STATEMENT
C                              (BUT TRANSLATED TO UPPER CASE).
C                     --IANSLC (A  HOLLARITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              CURRENT COMMAND STATEMENT (UNCONVERTED,
C                              AND SO MAY BE LOWER CASE).
C                     --IWIDTH (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE CURRENT COMMAND STATEMENT.
C                     --IBUGS2 (A HOLLARITH VARIABLE
C                              FOR DEBUGGING
C                     --IERROR ('YES' OR 'NO' )
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--NOVEMBER  1980.
C     UPDATED--MAY       1982.
C     UPDATED--JANUARY   1983.
C     UPDATED--DECEMBER  1985.
C     UPDATED--DECEMBER  1988.  SUPPRESS ERROR MESSAGE FOR \ IN FALSE IF
C     UPDATED--FEBRUARY  1989.  CONTINUE CHARACTER (ALAN)
C     UPDATED--JUNE      1989.  SUPPRESS ERROR MESSAGE FOR \ IN COMMENT
C     UPDATED--JUNE      1989.  ADD ARGS AND ADJUST PROMPT FOR CAPTURE
C     UPDATED--JUNE      1991.  READ FROM TURBO-C GUI MENU  JJF
C     UPDATED--JUNE      1991.  CHANGE NUMBERING (15XX TO 16XX)  JJF
C     UPDATED--APRIL     1992.  COMMENT OUT IOFILE
C     UPDATED--FEBRUARY  1993.  POINTER PROBLEMS WITH /
C     UPDATED--FEBRUARY  1993.  POINTER PROBLEMS WITH EOF
C     UPDATED--OCTOBER   1993.  CONVERT NON-PRINTING TO SPACES
C     UPDATED--AUGUST    1994.  EXECUTE SUBSET OF MACRO
C     UPDATED--NOVEMBER  1994.  PROMPT FOR VAX
C     UPDATED--JANUARY   1995.  ALLOW    LIST <FILE>   TO BE SAVED
C     UPDATED--JULY      1996.  FIX PROMPT FOR LAHEY PC IMPLEMENTATION
C     UPDATED--OCTOBER   1996.  FIX PROMPT FOR MICROSOFT PC IMPLEMENTATION
C     UPDATED--NOVEMBER  1997.  DON'T STORE COMMANDS STARTING WITH 
C                               "GUI"
C     UPDATED--DECEMBER  1997.  REPLOT COMMAND
C     UPDATED--OCTOBER   1998.  PROMPT FOR LAHEY GUI
C     UPDATED--JANUARY   2000.  CALL LIST TO DPREP2
C     UPDATED--AUGUST    2002.  IATXSW (IF ON, PREPEND
C                               "TEXT" TO COMMAND LINE)
C     UPDATED--DECEMBER  2004.  DO NOT ALLOW CONTINUATION LINES WHILE
C                               RUNNING THE GUI
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      INCLUDE 'DPCOPA.INC'
C
      CHARACTER*4 ITERCH
      CHARACTER*4 IANS
      CHARACTER*4 IANSLC
      CHARACTER*4 IANSV
      CHARACTER*4 IPROSW
      CHARACTER*4 IMACRO
      CHARACTER*12 IMACCS
C
      CHARACTER*4 IPROGR
      CHARACTER*4 ICONCL
      CHARACTER*4 IEOF
      CHARACTER*4 IIFSW
      CHARACTER*4 IATXSW
C
      CHARACTER*4 IREPST
      CHARACTER*1 IANSSV
CCCCC FOLLOWING 2 LINES ADDED DECEMBER 1997.
      CHARACTER*4 IPLTST
      CHARACTER*1 IPLTSV
C
      CHARACTER*4 ILOOST
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IFUNC
      CHARACTER*40 IVARLB(*)
C
      CHARACTER*1 IREPCH
C
      CHARACTER*1 IC1
      CHARACTER*4 IC4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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 IREWIN
      CHARACTER*4 IENDFI
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
CCCCC CHARACTER*1 IA
CCCCC CHARACTER*4 IA4I
CCCCC THE FOLLOWING LINE WAS ADDED    AUGUST 1994
CCCCC OCTOBER 1994.  FOLLOWING LINE CAUSES ERROR ON SOME MACHINES 
CCCCC (IA IS DECLARED IN DPCOFO INCLUDE FILE).
CCCCC CHARACTER*4 IA
C
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1991
      CHARACTER*80 IB
C
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1989
      CHARACTER*4 ICAPSW
C
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1992
      CHARACTER*80 STRING
C
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993
CCCCC CHARACTER*5 IANS5
C
      DIMENSION IANS(*)
      DIMENSION IANSLC(*)
      DIMENSION IANSV(*)
C
      DIMENSION IANSSV(MAXLIS,MAXCIS)
CCCCC ADD FOLLOWING LINE DECEMBER 1997.
      DIMENSION IPLTSV(MAXLIP,MAXCIS)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IFUNC(*)
C
CCCCC DIMENSION IA(132)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
CCCCC THE FOLLOWING 2 LINES WERE ADDED   JUNE 1991   JJF
      INCLUDE 'DPCOWI.INC'
      INCLUDE 'DPCODV.INC'
CCCCC THE FOLLOWING LINE WAS ADDED   OCTOBER 1998
      INCLUDE 'DPCONP.INC'
CCCCC THE FOLLOWING LINE WAS ADDED   DECEMBER 2004
      INCLUDE 'DPCOST.INC'
C
CCCCC BEGIN FIX
CCCCC ADD A CONTINUE CHARACTER (DEFAULT = ...) (AUGUST 1987 & FEBRUARY 1989)
      CHARACTER*4 ICONCH
      CHARACTER*1 IATEMP
CCCCC END FIX
CCCCC ADD FOLLOWING LINES FEBRUARY 1998.
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      DIMENSION IHARG(1)
      DIMENSION IHARG2(1)
      DIMENSION IARGT(1)
      DIMENSION IARG(1)
      DIMENSION ARG(1)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
CCCCC IBUGS2='ON'
      ISUBN1='DPGE'
      ISUBN2='TC  '
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')THEN
         WRITE(ICOUT,999)
  999    FORMAT(1X)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,51)
   51    FORMAT('***** AT THE BEGINNING OF DPGETC--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,52)IOUNI0,MAXWID,ITERCH
   52    FORMAT('IOUNI0,MAXWID,ITERCH = ',I8,I8,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,53)IHOST1,TCMENU
   53    FORMAT('IHOST1,TCMENU = ',A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,54)IWIDSV
   54    FORMAT('IWIDSV = ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(IWIDSV.GE.1)WRITE(ICOUT,56)(IANSV(I),I=1,IWIDSV)
   56    FORMAT('(IANSV(I),I=1,IWIDSV) = ',100A1)
         IF(IWIDSV.GE.1)   CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,60)IREPST,IREPPO,IREPMX,IPOINT
   60    FORMAT('IREPST,IREPPO,IREPMX,IPOINT = ',A4,3I8)
         CALL DPWRST('XXX','BUG ')
         DO62J=1,IREPMX
            WRITE(ICOUT,63)J,(IANSSV(J,I),I=1,80)
   63       FORMAT('J,(IANSSV(J,I),I=1,80) = ',I8,2X,80A1)
            CALL DPWRST('XXX','BUG ')
   62    CONTINUE
         WRITE(ICOUT,64)ICAPSW,IPR,IPRDEF
   64    FORMAT('ICAPSW,IPR,IPRDEF = ',A4,2I8)
         CALL DPWRST('XXX','BUG ')
C
         WRITE(ICOUT,69)IBUGS2,IFOUND,IERROR
   69    FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,71)IOUNI0,IPROGR
   71    FORMAT(',IOUNI0,IPROGR = ',I8,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,76)NUMCHA
   76    FORMAT('NUMCHA = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,77)(IA(I),I=1,10)
   77    FORMAT('IA(.) = ',10A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,78)IWIDTH
   78    FORMAT('IWIDTH = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,79)(IANS(I),I=1,IWIDTH)
   79    FORMAT('IANS(.) = ',120A1)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,80)(IANSLC(I),I=1,IWIDTH)
   80    FORMAT('IANSLC(.) = ',120A1)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,81)IMACRO,IMACNU,IMACCS
   81    FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,82)IMACL1,IMACL2,IMACLR
   82    FORMAT(1H ,'IMACL1,IMACL2,IMACLR = ',3I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,83)IPROSW
   83    FORMAT('IPROSW = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,84)IPRONU,IPRONA
   84    FORMAT('IPRONU,IPRONA = ',I8,2X,A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,85)ICRENU,ICRENA
   85    FORMAT('ICRENU,IPRONA = ',I8,2X,A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,86)IPROGR,IPRONU
   86    FORMAT('IPROGR,IPRONU = ',A4,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,87)ICONCL,ICONNU
   87    FORMAT('ICONCL,ICONNU = ',A4,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,88)IEOF,IIFSW
   88    FORMAT('IEOF,IIFSW = ',A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,89)IREPCH
   89    FORMAT('IREPCH = ',A1)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,90)ILOOST
   90    FORMAT('ILOOST = ',A4)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C  AUGUST, 1987: DETERMINE THE NUMBER OF CHARACTERS
C  USED IN CONTINUE CHARACTER
      NCCNT=0
      DO91I=4,1,-1
        NCCNT=I
        IF(ICONCH(I:I).NE.' ')GOTO92
   91 CONTINUE
      NCCNT=0
   92 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')THEN
        WRITE(ICOUT,93)NCCNT
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,94)(ICONCH(J:J),J=1,4)
   93   FORMAT('NUMBER OF CHARACTERS IN CONTINUE CHARACTER = ',I4)
        CALL DPWRST('XXX','BUG ')
   94   FORMAT('ICONCH(1:1)=',A1,'ICONCH(2:2)=',A1,'ICONCH(3:3)=',A1,
     1         'ICONCH(4:4)=',A1)
      ENDIF
C  END PATCH
C
C               **************************************
C               **  STEP 1--                        **
C               **  COPY THE INPUT VARIABLE IOUNI0  **
C               **  INTO THE LOCAL VARIABLE IOUNIT  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=IOUNI0
C
C               ************************************************************
C               **  STEP 10--                                             **
C               **  GET A NEW FULL COMMAND LINE INTO IANSLC(.)              AND
C               **  BY EITHER USING THE SAVED LINE (IF ANY) IN IANSV(.),  **
C               **  OR BY READING IN A COMPLETELY NEW LINE                **
C               **  FROM THE STANDARD INPUT UNIT.                         **
C               ************************************************************
C
      ISTEPN='10'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1010I=1,MAXSTR
        IANS(I)=' '
        IANSLC(I)=' '
 1010 CONTINUE
C
      IF(IWIDSV.GT.0)THEN
        DO1020I=1,IWIDSV
          IANSLC(I)=IANSV(I)
 1020   CONTINUE
        IWIDTH=IWIDSV
        CALL DPNONP(IANSLC,IWIDTH,IANSLC,IBUGS2,IERROR)
        CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGS2,IERROR)
        GOTO2100
      ENDIF
C
C               *******************************************
C               **  STEP 11--                            **
C               **  CHECK TO SEE IF REPEATING A COMMAND  **
C               *******************************************
C
      IF(IREPST.EQ.'OFF')GOTO1190
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,MAXWID
        IANS(I)='    '
        IANSLC(I)='    '
        IC1=IANSSV(IREPPO,I)
        IANSLC(I)=IC1
 1110 CONTINUE
C
CCCCC BEGIN FIX
CCCCC CHECK FOR CONTINUE CHARACTER (AUGUST 1987 & FEBRUARY 1989)
      IWIDTH=MAXWID
      IF(NCCNT.EQ.0)GOTO1180
      DO1120I=1,MAXWID-NCCNT+1
        DO1125J=1,NCCNT
          K=I+J-1
          IATEMP=IANSLC(K)
          IF(IATEMP.NE.ICONCH(J:J))GOTO1120
 1125   CONTINUE
C
C  GET NEXT LINE
C
        IF(IGUIFL.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1126)
 1126     FORMAT('****** ERROR: CONTINUATION LINES NOT SUPPORTED ',
     1           'IN GUI.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1127)
 1127     FORMAT('       CURRENT LINE IGNORED.')
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
        IREPPO=IREPPO+1
        IF(IREPPO.GT.MAXLIS)IREPPO=1
        K=0
        IFIRST=I
        IWIDTH=IFIRST+MAXWID-1
        IF(IWIDTH.GT.MAXSTR)IWIDTH=MAXSTR
        DO1130J=IFIRST,IWIDTH
          K=K+1
          IANSLC(J)='    '
          IC1=IANSSV(IREPPO,K)
          IANSLC(J)=IC1
 1130   CONTINUE
        GOTO1180
C
 1120 CONTINUE
C
 1180 CONTINUE
      DO1185I=MAXSTR,1,-1
        IWIDTH=I
        IF(IANSLC(I).NE.'    ')GOTO1189
 1185 CONTINUE
 1189 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')THEN
        WRITE(ICOUT,1181)IWIDTH,IANSLC(IWIDTH)
 1181   FORMAT('FROM 1180, IWIDTH,IANSLC(IWIDTH)=',I4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
CCCCC END FIX
C
      CALL DPNONP(IANSLC,IWIDTH,IANSLC,IBUGS2,IERROR)
      CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGS2,IERROR)
      GOTO2100
 1190 CONTINUE
C
C               *******************************************
C               **  STEP 11B-                            **
C               **  CHECK TO SEE IF HAVE REPLOT COMMAND  **
C               *******************************************
C
      IF(IPLTST.EQ.'OFF')GOTO1290
C
      ISTEPN='11B'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1210I=1,MAXWID
      IANS(I)='    '
      IANSLC(I)='    '
      IC1=IPLTSV(IPLTPO,I)
      IANSLC(I)=IC1
 1210 CONTINUE
C
CCCCC DON'T SUPPORT CONTINUATION CHARACTER FOR THIS COMMAND
CCCCC AT THIS POINT.
C
 1280 CONTINUE
      DO1285I=MAXSTR,1,-1
      IWIDTH=I
      IF(IANSLC(I).NE.'    ')GOTO1289
 1285 CONTINUE
 1289 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1WRITE(ICOUT,1281)IWIDTH,IANSLC(IWIDTH)
 1281 FORMAT('FROM 1180, IWIDTH,IANSLC(IWIDTH)=',I4,2X,A4)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL DPWRST('XXX','BUG ')
C
      CALL DPNONP(IANSLC,IWIDTH,IANSLC,IBUGS2,IERROR)
      CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGS2,IERROR)
      GOTO2100
 1290 CONTINUE
C
C               *****************************************************
C               **  STEP 13--                                      **
C               **  CHECK TO SEE IF READING FROM THE PROGRAM FILE  **
C               *****************************************************
C
      IF(IPROGR.EQ.'EXEC')GOTO1310
      GOTO1390
C
 1310 CONTINUE
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IOUNIT=IPRONU
CCCCC IFILE=IPRONA
CCCCC ISTAT=IPROST
CCCCC IFORM=IPROFO
CCCCC IACCES=IPROAC
CCCCC IPROT=IPROPR
CCCCC ICURST=IPROCS
C
      ISUBN0='GETC'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'GETC')GOTO1329
      WRITE(ICOUT,1323)IOUNIT
 1323 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1324)IFILE
 1324 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)ISTAT,IFORM,IACCES,IPROT,ICURST
 1325 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)ISUBN0,IERRFI
 1326 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1WRITE(ICOUT,1371)
 1371 FORMAT('***** A LINE FROM THE PROGRAM FILE SHOULD BE ',
     1'READ IN AT THIS TIME.')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL DPWRST('XXX','BUG ')
C
CCCCC THE FOLLOWING SECTION WAS UPDATED    AUGUST 1994
CCCCC WRITE(6,777)IMACL1,IMACL2,IMACLR
CC777 FORMAT(1H ,'IMACL1,IMACL2,IMACLR = ',3I8)
C
      IF(IMACLR.LT.IMACL2)THEN
         NUMCHA=-1
         CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1   IA,NUMCHA,
     1   ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
         IMACLR=IMACLR+1
         IF(IERROR.EQ.'YES')GOTO9000
      ELSE
         IA(1)='E'
         IA(2)='O'
         IA(3)='F'
         NUMCHA=3
      ENDIF
C
      IF(NUMCHA.EQ.3.AND.
     1IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F')GOTO1370
      GOTO1379
 1370 CONTINUE
      IF(IOUNIT.EQ.IPRONU)IPROGR='EOF'
      IF(IOUNIT.EQ.ICONNU)ICONCL='EOF'
      IF(IOUNIT.NE.IPRONU.AND.IOUNIT.NE.ICONNU)IMACRO='EOF'
      IEOF='YES'
 1379 CONTINUE
C
      IWIDTH=NUMCHA
      DO1380I=1,NUMCHA
CCCCC IA4I='    '
CCCCC IA4I(1:1)=IA(I)
CCCCC IANS(I)=IA4I
      IANSLC(I)=IA(I)
 1380 CONTINUE
C
CCCCC BEGIN FIX
CCCCC CHECK FOR CONTINUE CHARACTER (AUGUST 1987 & FEBRUARY 1989)
      IF(NCCNT.EQ.0)GOTO1389
      DO1381I=1,IWIDTH-NCCNT+1
      DO1382J=1,NCCNT
      K=I+J-1
      IATEMP=IANSLC(K)
      IF(IATEMP.NE.ICONCH(J:J))GOTO1381
 1382 CONTINUE
C
C  GET NEXT LINE
C
      NUMCHA=-1
      CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IA,NUMCHA,
     1ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(NUMCHA.EQ.3.AND.
     1IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F')GOTO1375
      GOTO1378
 1375 CONTINUE
      IF(IOUNIT.EQ.IPRONU)IPROGR='EOF'
      IF(IOUNIT.EQ.ICONNU)ICONCL='EOF'
      IF(IOUNIT.NE.IPRONU.AND.IOUNIT.NE.ICONNU)IMACRO='EOF'
      IEOF='YES'
 1378 CONTINUE
C
      IFIRST=I
      NTEMP=0
      DO1388J=NUMCHA,1,-1
      NTEMP=J
      IF(IA(J).NE.' ')GOTO1387
 1388 CONTINUE
 1387 CONTINUE
      IWIDTH=IFIRST+NTEMP-1
C     NOTE: IANSLC DIMENSIONED TO 200 IN INCLUDE FILE DPCOHK
      IF(IWIDTH.GT.MAXSTR)IWIDTH=MAXSTR
      K=0
      DO1383J=IFIRST,IWIDTH
      K=K+1
      IANSLC(J)=IA(K)
 1383 CONTINUE
      GOTO1389
 1381 CONTINUE
C
 1389 CONTINUE
CCCCC END FIX
C
      CALL DPNONP(IANSLC,IWIDTH,IANSLC,IBUGS2,IERROR)
      CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGS2,IERROR)
      GOTO2100
C
 1390 CONTINUE
C
C               *****************************************************
C               **  STEP 14--                                      **
C               **  CHECK TO SEE IF READING FROM A   MACRO   FILE  **
C               *****************************************************
C
      IF(IMACRO.EQ.'EXEC')GOTO1410
      GOTO1490
C
 1410 CONTINUE
      ISTEPN='14'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IOUNIT=ICRENU
CCCCC IFILE=ICRENA
CCCCC ISTAT=ICREST
CCCCC IFORM=ICREFO
CCCCC IACCES=ICREAC
CCCCC IPROT=ICREPR
CCCCC ICURST=ICRECS
C
      ISUBN0='GETC'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'GETC')GOTO1429
      WRITE(ICOUT,1423)IOUNIT
 1423 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1424)IFILE
 1424 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)ISTAT,IFORM,IACCES,IPROT,ICURST
 1425 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1426)ISUBN0,IERRFI
 1426 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1WRITE(ICOUT,1451)IOUNIT
 1451 FORMAT('***** A LINE FROM MACRO FILE ',I8,' SHOULD BE ',
     1'READ IN AT THIS TIME.')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL DPWRST('XXX','BUG ')
C
CCCCC THE FOLLOWING SECTION WAS UPDATED    AUGUST 1994
CCCCC WRITE(6,777)IMACL1,IMACL2,IMACLR
      IF(IMACLR.LT.IMACL2)THEN
         NUMCHA=-1
         CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1   IA,NUMCHA,
     1   ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
         IMACLR=IMACLR+1
         IF(IERROR.EQ.'YES')GOTO9000
      ELSE
         IA(1)='E'
         IA(2)='O'
         IA(3)='F'
         NUMCHA=3
      ENDIF
C
      IF(NUMCHA.EQ.3.AND.
     1IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F')GOTO1470
      GOTO1479
 1470 CONTINUE
      IF(IOUNIT.EQ.IPRONU)IPROGR='EOF'
      IF(IOUNIT.EQ.ICONNU)ICONCL='EOF'
      IF(IOUNIT.NE.IPRONU.AND.IOUNIT.NE.ICONNU)IMACRO='EOF'
      IEOF='YES'
 1479 CONTINUE
C
      IWIDTH=NUMCHA
      DO1480I=1,NUMCHA
CCCCC IA4I='    '
CCCCC IA4I(1:1)=IA(I)
CCCCC IANS(I)=IA4I
      IANSLC(I)=IA(I)
 1480 CONTINUE
C
CCCCC BEGIN FIX
CCCCC CHECK FOR CONTINUE CHARACTER (AUGUST 1987 & FEBRUARY 1989)
      IF(NCCNT.EQ.0)GOTO1489
      DO1481I=1,IWIDTH-NCCNT+1
      DO1482J=1,NCCNT
      K=I+J-1
      IATEMP=IANSLC(K)
      IF(IATEMP.NE.ICONCH(J:J))GOTO1481
 1482 CONTINUE
C
C  GET NEXT LINE
C
      NUMCHA=-1
      CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IA,NUMCHA,
     1ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(NUMCHA.EQ.3.AND.
     1IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F')GOTO1475
      GOTO1478
 1475 CONTINUE
      IF(IOUNIT.EQ.IPRONU)IPROGR='EOF'
      IF(IOUNIT.EQ.ICONNU)ICONCL='EOF'
      IF(IOUNIT.NE.IPRONU.AND.IOUNIT.NE.ICONNU)IMACRO='EOF'
      IEOF='YES'
 1478 CONTINUE
C
      IFIRST=I
      NTEMP=0
      DO1488J=NUMCHA,1,-1
      NTEMP=J
      IF(IA(J).NE.' ')GOTO1487
 1488 CONTINUE
 1487 CONTINUE
      IWIDTH=IFIRST+NTEMP-1
C     NOTE: IANSLC DIMENSIONED TO 200 IN INCLUDE FILE DPCOHK
      IF(IWIDTH.GT.MAXSTR)IWIDTH=MAXSTR
      K=0
      DO1483J=IFIRST,IWIDTH
      K=K+1
      IANSLC(J)=IA(K)
 1483 CONTINUE
      GOTO1489
 1481 CONTINUE
C
 1489 CONTINUE
CCCCC END FIX
C
      CALL DPNONP(IANSLC,IWIDTH,IANSLC,IBUGS2,IERROR)
      CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGS2,IERROR)
      GOTO2100
C
 1490 CONTINUE
C
CCCCC THE FOLLOWING SECTION IS NEW    JUNE 1991   JJF
C               *****************************************************
C               **  STEP 15--                                      **
C               **  CHECK TO SEE IF READING FROM THE               **
C               **  FRONT-END GRAPHICAL USER INTERFACE MENU        **
C               *****************************************************
C
      IF(IHOST1.EQ.'IBM-'.AND.TCMENU.EQ.'ON')GOTO1510
      GOTO1590
C
 1510 CONTINUE
      ISTEPN='15'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTEPN='15.1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL TCGECO(IB,NUMCHA,IBUGS2,ISUBRO)
C
      IF(NUMCHA.LE.0)GOTO1590
      ISTEPN='15.2'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWIDTH=NUMCHA
      DO1580I=1,NUMCHA
CCCCC IANSLC(I)=IA(I)
      IC4='    '
      IC4(1:1)=IB(I:I)
      IANSLC(I)=IC4
 1580 CONTINUE
C
CCCCC CHECK FOR CONTINUATION CHARACTER
C
      IF(NCCNT.EQ.0)GOTO1589
      DO1581I=1,IWIDTH-NCCNT+1
      DO1582J=1,NCCNT
      K=I+J-1
      IATEMP=IANSLC(K)
      IF(IATEMP.NE.ICONCH(J:J))GOTO1581
 1582 CONTINUE
C
CCCCC IF HAVE CONTINUATION, THEN GET NEXT LINE.
C
      ISTEPN='15.3'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL TCGECO(IB,NUMCHA,IBUGS2,ISUBRO)
C
      ISTEPN='15.4'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFIRST=I
      NTEMP=0
      DO1588J=NUMCHA,1,-1
      NTEMP=J
CCCCC IF(IA(J).NE.' ')GOTO1587
CCCCC IF(IB(J).NE.'    ')GOTO1587
      IF(IB(J:J).NE.'    ')GOTO1587
 1588 CONTINUE
 1587 CONTINUE
      IWIDTH=IFIRST+NTEMP-15
C     NOTE: IANSLC DIMENSIONED TO 200 IN INCLUDE FILE DPCOHK
      IF(IWIDTH.GT.MAXSTR)IWIDTH=MAXSTR
      K=0
      DO1583J=IFIRST,IWIDTH
      K=K+1
CCCCC IANSLC(J)=IA(K)
      IC4='    '
      IC4(1:1)=IB(K:K)
      IANSLC(J)=IC4
 1583 CONTINUE
      GOTO1589
 1581 CONTINUE
C
 1589 CONTINUE
C
      ISTEPN='15.5'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      CALL DPNONP(IANSLC,IWIDTH,IANSLC,IBUGS2,IERROR)
      CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGS2,IERROR)
      ISTEPN='15.6'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      GOTO2100
C
 1590 CONTINUE
C
CCCCC THE FOLLOWING SECTION HAD NUMBERS CHANGED   JUNE 1991
CCCCC (15XX TO 16XX)    JUNE 1991
C               *****************************************************
C               **  STEP 16--                                      **
C               **  IF NOT READING FROM THE PROGRAM FILE, AND      **
C               **  IF NOT READING FROM A MACRO FILE, AND          **
C               **  IF NOT READING FROM A FRONT-END GUI MENU,      **
C               **  THEN READ FROM THE STANDARD INPUT FILE.        **
C               **  (IF CALLED FOR, WRITE OUT A PROMPT (>) FIRST.  **
C               *****************************************************
C
CCCCC FEBRUARY 1998 UPDATE.  FOR TCL/TK GUI, WINDOWS 95 VERSION
CCCCC NEEDS SPECIAL HANDLING.  THIS IS CONTROLLED BY ENVIRONMENT
CCCCC VARIABLE "DATAPLOT_GUI_IO".  IF EQUAL TO PIPE, DO STANDARD
CCCCC READ AS BEFORE.  HOWEVER, IF "FILE", THEN SPECIAL CODE.
 1600 CONTINUE
C
      ISTEPN='16'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING LINE WAS FIXED JUNE 1989
CCCCC IF(IPROSW.EQ.'ON'.AND.IOUNIT.EQ.IRD)WRITE(ICOUT,1611)
CCCCC IF(IPROSW.EQ.'ON'.AND.IOUNIT.EQ.IRD)CALL DPWRST('XXX','BUG ')
CCCCC FOR VAX, NEED 1X ON FORMAT.  NOVEMBER 1994.
CCCCC IF(IPROSW.EQ.'ON'.AND.IOUNIT.EQ.IRD)WRITE(IPRDEF,1611)
CCCCC ADD SUPPORT FOR IBM/PC LAHEY COMPILER.  JULY 1996.
CCCCC ADD SUPPORT FOR IBM/PC MICROSOFT COMPILER.  OCTOBER 1996.
CCCCC IF(IHOST1.NE.'VAX')THEN
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')THEN
        IF(IPROSW.EQ.'ON'.AND.IOUNIT.EQ.IRD)WRITE(IPRDEF,1612)
     1    ICRC,ILFC
      ELSEIF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')THEN
        IF(IPROSW.EQ.'ON'.AND.IOUNIT.EQ.IRD)WRITE(IPRDEF,1613)
      ELSEIF(IHOST1.NE.'VAX')THEN
        IF(IPROSW.EQ.'ON'.AND.IOUNIT.EQ.IRD)WRITE(IPRDEF,1611)
      ELSE
        IF(IPROSW.EQ.'ON'.AND.IOUNIT.EQ.IRD)WRITE(IPRDEF,1616)
      ENDIF
 1611 FORMAT('>')
 1612 FORMAT(1X,'>',A1,A1)
 1613 FORMAT(1X,'>')
CQWIN 1613 FORMAT(1X,'>',\  )
 1616 FORMAT(1X,'>')
C
CCCCC IOUNIT=IRD
CCCCC JANUARY 1998.  FOR TCL/TK FRONTEND, FLUSH STANDARD OUTPUT.
      CALL DPFLSH(IPR,IBUGS2,ISUBRO,IFOUND,IERROR)
C
      IF(IGUIIO.EQ.'FILE')GOTO16200
C
CCCCC STANDARD CASE
      READ(IOUNIT,1621,END=1630)(IANSLC(I),I=1,MAXWID)
 1621 FORMAT(80A1)
      IWIDTH=MAXWID
C
CCCCC BEGIN FIX
CCCCC CHECK FOR CONTINUE CHARACTER (AUGUST 1987 & FEBRUARY 1989)
      IF(NCCNT.EQ.0)GOTO1640
      DO1641I=1,MAXWID-NCCNT+1
      DO1642J=1,NCCNT
      K=I+J-1
      IATEMP=IANSLC(K)
      IF(IATEMP.NE.ICONCH(J:J))GOTO1641
 1642 CONTINUE
C
C  GET NEXT LINE
C
      IFIRST=I
      IWIDTH=IFIRST+MAXWID-1
      IF(IWIDTH.GT.MAXSTR)IWIDTH=MAXSTR
      READ(IOUNIT,1621,END=1630)(IANSLC(J),J=IFIRST,IWIDTH)
      GOTO1640
 1641 CONTINUE
C
 1640 CONTINUE
      GOTO16900
C
CCCCC SPECIAL CODE FOR WINDOWS 95 VERSION.
16200 CONTINUE
      IOTEMP=10
      DO16210KK=1,1
16290   CONTINUE
        OPEN(UNIT=IOTEMP,FILE='fort.10',FORM='FORMATTED',
     1       STATUS='OLD',ERR=16291)
        REWIND(IOTEMP)
        READ(IOTEMP,1621,END=16210)(IANSLC(I),I=1,MAXWID)
        CLOSE(IOTEMP,STATUS='DELETE')
        IWIDTH=MAXWID
C
        GOTO16210
16291   CONTINUE
        IHARG(1)='1.0'
        IHARG2(1)=' '
        IARGT(1)='NUMB'
        ARG(1)=1.0
        IARG(1)=1
        NUMARG=1
        CALL DPSLEE(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1              IBUGS2,ISUBRO,IFOUND,IERROR)
        GOTO16290
C
16210 CONTINUE
      GOTO16900
C
16900 CONTINUE
C
CCCCC CALL DPUPPE(IANSLC,MAXWID,IANS,IBUGS2,IERROR)
      ISTEPN='16.1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      CALL DPNONP(IANSLC,IWIDTH,IANSLC,IBUGS2,IERROR)
      CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGS2,IERROR)
      ISTEPN='16.2'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
CCCCC END FIX
C
      GOTO1690
C
 1630 CONTINUE
      IF(IHOST1.EQ.'CDC')GOTO1631
      GOTO1690
C
 1631 CONTINUE
CCCCC CLOSE(IRD)
      ICURST='OPEN'
      IENDFI='OFF'
      IREWIN='OFF'
      ISUBN0='GETC'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
CCCCC OPEN(IRD,FILE='INPUT')
      ICURST='CLOSED'
      IREWIN='OFF'
      ISUBN0='GETC'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      GOTO1690
C
 1690 CONTINUE
CCCCC IWIDTH=MAXWID
      GOTO2100
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  DETERMINE IF IANSLC(.) CONSISTS OF MULTIPLE COMMAND  **
C               **  STATEMENTS (AS IS POSSIBLE BY THE               **
C               **  USE OF SEPARATOR CHARACTERS IN THE TEXT),       **
C               **  IF SO, THEN UPDATE IANSLC(.), IWIDTH,             **
C               **  IANSV(.), AND IWIDSV BY TRUNCATING              **
C               **  IANSLC(.) AT THE FIRST SEPARATION CHARACTER,      **
C               **  AND COPYING THE REST OF IANSLC(.) INTO IANSV(.).  **
C               ******************************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPSPLC(IANSLC,IWIDTH,ITERCH,
     1IANSV,IWIDSV,IBUGS2,IERROR)
C
CCCCC           *******************************************************
CCCCC           **  STEP 22--                                        **
CCCCC           **  CONVERT EACH CHARACTER IN IANS(.) TO UPPER CASE  **
CCCCC           **  (UNLESS ALREADY IN UPPER CASE).                  **
CCCCC           *******************************************************
CCCCC
CCCCC ISTEPN='22.2'
CCCCC IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
CCCCC
CCCCC CALL DPUPPE(IANS,IWIDTH,IANS,IBUGS2,IERROR)
CCCCC
C               *******************************************************
C               **  STEP 23--                                        **
C               **  SCAN THE ENTIRE STRING--                         **
C               **  SEARCH FOR THE SUBSTITUTION-VALUE CHARACTER.     **
C               **  IF FOUND (AND IF WE ARE NOT IN THE MIDDLE OF     **
C               **  STORING THE BODY OF A LOOP),
C               **  THEN FORM A NEW STRING BY SUBSTITUTING           **
C               **  THE VALUE OF THE IMMEDIATELY SUCCEEDING VARIABLE **
C               **  IF NOT FOUND (OR IF WE ARE IN THE MIDDLE OF      **
C               **  STORING THE BODY OF A LOOP),                     **
C               **  THEN DO NOTHING.                                 **
C               **  FINALLY (AND IN ALL CASES) CONVERT TO UPPER CASE **
C               *******************************************************
C
      ISTEPN='23'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC CALL DPREP2(IANS,IWIDTH,             NOVEMBER 4, 1986
      IF(ILOOST.EQ.'STOR')GOTO2310
CCCCC THE FOLLOWING IF STATEMENT WAS ADDED         DECEMBER 1988
CCCCC TO SUPPRESS AN EXTRANEOUS ERROR MESSAGE      DECEMBER 1988
CCCCC WHEN HAVE A BACKSLASH IN A FALSE IF          DECEMBER 1988
CCCCC CALL DPREP2(IANSLC,IWIDTH,           DECEMBER 1988
CCCCC IF(IIFSW.EQ.'TRUE')
CCCCC THE FOLLOWING IF STATEMENT WAS ADDED                 JUNE 1989
CCCCC TO CORRECT THE PROBLEM OF ATTEMPTING TO SUBSTITUTE   JUNE 1989
CCCCC WITHIN A COMMENT LINE (UNNEEDED)                     JUNE 1989
      IF(IIFSW.EQ.'TRUE'.AND.IANSLC(1).NE.'.')
     1CALL DPREP2(IANSLC,IWIDTH,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVARLB,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IMALEV,
     1IBUGS2,IERROR)
 2310 CONTINUE
      CALL DPNONP(IANSLC,IWIDTH,IANSLC,IBUGS2,IERROR)
      CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGS2,IERROR)
CCCCC AUGUST 2002.  IF AUTO TEXT ON, THE PREPEND "TEXT" TO COMMAND
CCCCC LINE.  BUT CHECK TO SEE IF "AUTO TEXT" COMMAND IS BEING
CCCCC ENTERED.
      IF(IATXSW.EQ.'ON')THEN
        IF(IANS(1).EQ.'A'.AND.IANS(2).EQ.'U'.AND.IANS(3).EQ.'T'.AND.
     1     IANS(4).EQ.'O'.AND.IANS(5).EQ.' '.AND.IANS(6).EQ.'T'.AND.
     1     IANS(7).EQ.'E'.AND.IANS(8).EQ.'X'.AND.IANS(9).EQ.'T')
     1     GOTO2109
        DO2105I=MIN(IWIDTH,MAXWID-4),1,-1
          IANSLC(I+5)=IANSLC(I)
          IANS(I+5)=IANS(I)
 2105   CONTINUE
        IANSLC(1)='T'
        IANSLC(2)='E'
        IANSLC(3)='X'
        IANSLC(4)='T'
        IANSLC(5)=' '
        IANS(1)='T'
        IANS(2)='E'
        IANS(3)='X'
        IANS(4)='T'
        IANS(5)=' '
        IWIDTH=MIN(MAXWID,IWIDTH+5)
 2109   CONTINUE
      ENDIF
C
C
C               **********************************
C               **  STEP 80--                   **
C               **  STORE THE LINE              **
C               **  IN THE SAVE TABLE,          **
C               **  FOR FUTURE USE BY THE       **
C               **  REPEAT COMMAND.             **
C               **  NOTE--                      **
C               **  CERTAIN COMMANDS ARE NOT TO **
C               **  BE STORED, NAMELY--         **
C               **     LIST (AND L AND RECALL)  **
C               **     REPEAT (AND R)           **
C               **     SAVE (AND S)             **
C               **     SPACE BAR COMMAND (CHANGED TO / TEMPORARILY)        **
C               **     CARRIAGE RETURN ONLY (= NO-OP COMMAND)              **
C               **     NOVEMBER 1997:           **
C               **     GUI STATUS               **
C               **     GUI WRITE/PRINT          **
C               **     BASICALLY, ANY COMMAND   **
C               **     STARTING WITH "GUI"      **
C               **********************************
C
 8000 CONTINUE
C
      ISTEPN='80'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1WRITE(ICOUT,8001)IANS(1),IANS(2),IWIDTH
 8001 FORMAT('IANS(1),IANS(2),IWIDTH = ',A4,2X,A4,I8)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')
     1CALL DPWRST('XXX','BUG ')
C
      IF(IREPST.EQ.'ON')GOTO8190
C
CCCCC THE FOLLOWING 2 LINES WERE ADJUSTED            JANUARY 1995
CCCCC TO ALLOW    LIST <FILE NAME>    TO BE SAVED    JANUARY 1995
CCCCC IF(IANS(1).EQ.'L'.AND.IANS(2).EQ.'I'.AND.
CCCCC1IANS(3).EQ.'S'.AND.IANS(4).EQ.'T')GOTO8190
      IF(IANS(1).EQ.'L'.AND.IANS(2).EQ.'I'.AND.
     1IANS(3).EQ.'S'.AND.IANS(4).EQ.'T'.AND.IWIDTH.LE.5)GOTO8190
      IF(IANS(1).EQ.'L'.AND.IANS(2).EQ.' ')GOTO8190
      IF(IANS(1).EQ.'L'.AND.IWIDTH.LE.1)GOTO8190
      IF(IANS(1).EQ.'R'.AND.IANS(2).EQ.'E'.AND.
     1IANS(3).EQ.'C'.AND.IANS(4).EQ.'A')GOTO8190
C
      IF(IANS(1).EQ.'R'.AND.IANS(2).EQ.'E'.AND.
     1IANS(3).EQ.'P'.AND.IANS(4).EQ.'E')GOTO8190
      IF(IANS(1).EQ.'R'.AND.IANS(2).EQ.' ')GOTO8190
      IF(IANS(1).EQ.'R'.AND.IWIDTH.LE.1)GOTO8190
C
      IF(IANS(1).EQ.'S'.AND.IANS(2).EQ.'A'.AND.
     1IANS(3).EQ.'V'.AND.IANS(4).EQ.'E')GOTO8190
      IF(IANS(1).EQ.'S'.AND.IANS(2).EQ.' ')GOTO8190
      IF(IANS(1).EQ.'S'.AND.IWIDTH.LE.1)GOTO8190
C
CCCCC FOLLOWING LINE TO CHECK FOR "GUI" ADDED.  NOVEMBER 1997.
      IF(IANS(1).EQ.'G'.AND.IANS(2).EQ.'U'.AND.
     1IANS(3).EQ.'I'.AND.IANS(4).EQ.' ')GOTO8190
CCCCC IF(IANS(1).EQ.' '.AND.IWIDTH.LE.1)GOTO8190
CCCCC THE FOLLOWING LINE WAS FIXED FEBRUARY 1993
CCCCC IF(IANS(1).EQ.'/'.AND.IWIDTH.LE.1)GOTO8190
      IF(IANS(1).EQ.'/'.AND.IWIDTH.LE.1)THEN
         IPOINT=IPOINT-1
         IF(IPOINT.LE.0)IPOINT=IREPMX
         GOTO8190
      ENDIF
CCCCC THE FOLLOWING 6 LINES WERE ADDED FEBRUARY 1993
      IF(IANS(1).EQ.'E'.AND.IANS(2).EQ.'O'.AND.
     1IANS(3).EQ.'F')THEN
         IPOINT=IPOINT-1
         IF(IPOINT.LE.0)IPOINT=IREPMX
         GOTO8190
      ENDIF
C
      IF(IWIDTH.LE.0)GOTO8190
C
CCCCC DO8100I=1,IWIDTH    APRIL 22, 1987
C
CCCCC BEGIN FIX
CCCCC CHECK FOR CONTINUE CHARACTER (AUGUST 1987 & FEBRUARY 1989)
CCCCC HANDLE CASE WHERE CONTINUE CHARACTER  (AUGUST 1987 & FEBRUARY 1989)
CCCCC MAKES LINE EXCEED 80 CHARACTERS. (AUGUST 1987 & FEBRUARY 1989)
CCCCC CURRENTLY ASSUME MAXIMUM OF 2 LINES. (AUGUST 1987 & FEBRUARY 1989)
C
C  FOLLOWING 5 LINES CAUSED BUG WITH "LET K=3; READ X1 TO X\K"
CCCCC DO8010I=MAXSTR,1,-1
CCCCC IWIDTH=I
CCCCC IF(IANSLC(I).NE.' ')GOTO8020
C8010 CONTINUE
CC020 CONTINUE
C
      DO8110I=1,MAXCIS
      IANSSV(IPOINT,I)=' '
 8110 CONTINUE
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'GETC')GOTO8025
      WRITE(ICOUT,8030)MAXSTR,IWIDTH,IPOINT
 8030 FORMAT('MAXSTR,IWIDTH,IPOINT=',I4,2X,I4,2X,I4)
      CALL DPWRST('XXX','BUG ')
 8025 CONTINUE
C
      IMAX=IWIDTH
      IF(IWIDTH.GT.MAXCIS)IMAX=MAXCIS-4
      DO8100I=1,IMAX
      IC4=IANSLC(I)
      IANSSV(IPOINT,I)=IC4(1:1)
 8100 CONTINUE
C
C  CASE FOR MORE THAN 80 CHARACTER LINE
C
      IF(IWIDTH.LE.MAXCIS)GOTO8190
      ITEMP=MAXCIS-4
      DO8200I=ITEMP+1,MAXCIS
      IANSSV(IPOINT,I)=ICONCH(I-ITEMP:I-ITEMP)
 8200 CONTINUE
C
      IPOINT=IPOINT+1
      IF(IPOINT.GT.IREPMX)IPOINT=1
      ISTART=IMAX
      IMAX=IWIDTH-IMAX
      IF(IMAX.GT.MAXCIS)IMAX=MAXCIS
C
      DO8210I=1,MAXCIS
      IANSSV(IPOINT,I)=' '
 8210 CONTINUE
C
      DO8220I=1,IMAX
      J=ISTART+I
      IC4=IANSLC(J)
      IANSSV(IPOINT,I)=IC4(1:1)
 8220 CONTINUE
C
 8190 CONTINUE
CCCCC END FIX
C
CCCCC THE FOLLOWING 6 LINES WERE ADDED             JUNE 1992 (JJF)
CCCCC TO ALLOW SCROLLING OF COMPLETE COMMAND LOG   JUNE 1992
CCCCC ON THE C MENU SIDE                           JUNE 1992
      IF(IHOST1.EQ.'IBM-'.AND.TCMENU.EQ.'ON')THEN
         DO8230I=1,80
         STRING(I:I)=IANSSV(IPOINT,I)
 8230    CONTINUE
C
         CALL TCWRCO(STRING,ISUBRO)
C
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'GETC')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9011)
 9011    FORMAT('***** AT THE END       OF DPGETC--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9012)IOUNI0,MAXWID,ITERCH
 9012    FORMAT('IOUNI0,MAXWID,ITERCH = ',I8,I8,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9013)IHOST1,TCMENU,IWIDTH
 9013    FORMAT('IHOST1,TCMENU,IWIDTH = ',A4,2X,A4,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9014)(IANS(I),I=1,IWIDTH)
 9014    FORMAT('(IANS(I),I=1,IWIDTH) = ',100A1)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9015)(IANSLC(I),I=1,IWIDTH)
 9015    FORMAT('(IANSLC(I),I=1,IWIDTH) = ',100A1)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9016)IWIDSV
 9016    FORMAT('IWIDSV = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9017)(IANSV(I),I=1,IWIDSV)
 9017    FORMAT('(IANSV(I),I=1,IWIDSV) = ',100A1)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9018)NUMCHA
 9018    FORMAT('NUMCHA = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9020)IREPST,IREPPO,IREPMX,IPOINT
 9020    FORMAT('IREPST,IREPPO,IREPMX,IPOINT = ',A4,3I8)
         CALL DPWRST('XXX','BUG ')
         DO9022J=1,20
            WRITE(ICOUT,9023)J,(IANSSV(J,I),I=1,80)
 9023       FORMAT('J,(IANSSV(J,I),I=1,80) = ',I8,2X,80A1)
            CALL DPWRST('XXX','BUG ')
 9022    CONTINUE
CCCCC THE FOLLOWING 3 LINES WERE ADDED JUNE 1989
         WRITE(ICOUT,9024)ICAPSW,IPR,IPRDEF
 9024    FORMAT('ICAPSW,IPR,IPRDEF = ',A4,2I8)
         CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 3 LINES WERE ADDED   AUGUST 1994
         WRITE(ICOUT,9030)(IA(I),I=1,10)
 9030    FORMAT('IA(.) = ',10A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9031)IMACRO,IMACNU,IMACCS
 9031    FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12)
         CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 3 LINES WERE ADDED              AUGUST 1994
CCCCC AND OTHER FORMAT NUMBERS CHANGED BEYOND IT    AUGUST 1994
         WRITE(ICOUT,9032)IMACL1,IMACL2,IMACLR
 9032    FORMAT(1H ,'IMACL1,IMACL2,IMACLR = ',3I8)
         CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,9032)IOFILE,IOUNIT
C9032    FORMAT('IOFILE,IOUNIT = ',A4,2X,I8)
CCCCC CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9033)IOUNIT
 9033    FORMAT('IOUNIT = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9034)IPROGR
 9034    FORMAT('IPROGR = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9035)IPROSW
 9035    FORMAT('IPROSW = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9039)IBUGS2,IFOUND,IERROR
 9039    FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9041)IOUNIT
 9041    FORMAT('IOUNIT = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9042)IFILE
 9042    FORMAT('IFILE  = ',A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9043)ISTAT
 9043    FORMAT('ISTAT  = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9044)IFORM
 9044    FORMAT('IFORM  = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9045)IACCES
 9045    FORMAT('IACCES = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9046)IPROT
 9046    FORMAT('IPROT  = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9047)ICURST
 9047    FORMAT('ICURST = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9048)IENDFI
 9048    FORMAT('IENDFI = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9049)IREWIN
 9049    FORMAT('IREWIN = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9051)ISUBN0
 9051    FORMAT('ISUBN0 = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9052)IERRFI
 9052    FORMAT('IERRFI = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9061)IPROGR,IPRONU
 9061    FORMAT('IPROGR,IPRONU = ',A4,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9062)ICONCL,ICONNU
 9062    FORMAT('ICONCL,ICONNU = ',A4,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9063)IEOF,IIFSW
 9063    FORMAT('IEOF,IIFSW = ',A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9064)IREPCH
 9064    FORMAT('IREPCH = ',A1)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9065)ILOOST
 9065    FORMAT('ILOOST = ',A4)
         CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 6 LINES WERE ADDED FEBRUARY 1993
         WRITE(ICOUT,9066)IPOINT
 9066    FORMAT('IPOINT = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9067)IPOINT,(IANSSV(IPOINT,I),I=1,80)
 9067    FORMAT('IPOINT,(IANSSV(IPOINT,I),I=1,80) = ',I8,2X,80A1)
         CALL DPWRST('XXX','BUG ')
CCCCC    WRITE(ICOUT,9068)IANS5
C9068    FORMAT('IANS5 = ',A5)
CCCCC    CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPGMEA(NPTS,NLAB,
     1XGRAND,SDGRAN,SET1,SET1K1,SET1K2,
     1DLOWT2,DHIGT2,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--IMPLEMENT GRAND MEAN APPROACH TO CONSENSUS MEANS
C     PRINTING--YES
C     SUBROUTINES NEEDED--NONE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IMETH
C
      REAL APPF
      REAL XGRAND
      REAL SDGRAN
      REAL SET1
      REAL SET1K1
      REAL SET1K2
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      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='DPGM'
      ISUBN2='EA  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GMEA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPGMEA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB,XGRAND,SDGRAN
   52   FORMAT('NPTS,NLAB,XGRAND,SDGRAN = ',2I8,2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IDF=NPTS-1
      CALL TPPF(0.975,IDF,APPF)
      DLOWT2=DBLE(XGRAND - APPF*SDGRAN/SQRT(REAL(NPTS)))
      DHIGT2=DBLE(XGRAND + APPF*SDGRAN/SQRT(REAL(NPTS)))
      SET1=SDGRAN/SQRT(REAL(NPTS))
      SET1K1=SET1
      SET1K2=2.0*SET1
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5107)
 5107   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('<TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=400>')
 5127   FORMAT('      </TD>')
 5126   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5128   FORMAT('   </TR>')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('         &nbsp;')
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5170)
 5170   FORMAT('         <b>8. Method: Grand Mean (no lab effect)</b>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Mean of All Data')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XGRAND
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
 5172   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Standard Deviation of All Data')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SDGRAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5174)
 5174   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Standard Deviaton of Consensus Mean (sd/sqrt(n)):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SET1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5177)
 5177   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Standard Uncertainty (<i>k</i> = 1):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SET1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5178)
 5178   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Expanded Uncertainty (<i>k</i> = 2):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)2.0*SET1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5179)APPF
 5179   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Expanded Uncertainty (<i>k</i> = ',F10.7,'):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)APPF*SET1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5180)
 5180   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Degrees of Freedom:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)IDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5181)
 5181   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         't Percent Point Value (alpha = 0.05):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)APPF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5182)
 5182   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Lower 95% (t-value) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DLOWT2)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5183)
 5183   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Upper 95% (t-value) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DHIGT2)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5184)
 5184   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Note: Grand Mean Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5185)
 5185   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Any Number of Labs, but no<br>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5186)
 5186   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Lab-to-Lab Differences')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
C
 8002   FORMAT(A1,'begin{table}')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf 8. Method: Grand Mean ',
     1         '(No Lab Effect):} & ',
     1         2X,A1,A1)
 8012   FORMAT(5X,'Mean of All Data: & ',
     1         F15.7,2X,A1,A1)
 8013   FORMAT(5X,'Standard Deviation of All Data: & ',
     1         F15.7,2X,A1,A1)
C
        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)XGRAND,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)SDGRAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8019   FORMAT(5X,'Standard Deviation of Consensus ',
     1         'Mean (sd/sqrt(n)): & ',F15.7,2X,A1,A1)
 8020   FORMAT(5X,'Standard Uncertainty (k = 1): & ',
     1         F15.7,2X,A1,A1)
 8021   FORMAT(5X,'Expanded Uncertainty (k = 2): & ',
     1         F15.7,2X,A1,A1)
 8022   FORMAT(5X,'Expanded Uncertainty (k = ',F10.7,'): & ',
     1         F15.7,2X,A1,A1)
        WRITE(ICOUT,8019)SET1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)SET1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)2.0*SET1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)APPF,APPF*SET1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8024   FORMAT(5X,'Degrees of Freedom: & ',
     1         I8,2X,A1,A1)
 8025   FORMAT(5X,'t Percent Point Value (alpha =  0.05): & ',
     1         F10.7,2X,A1,A1)
 8026   FORMAT(5X,'Lower 95',A1,'% (t-value) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8027   FORMAT(5X,'Upper 95',A1,'% (t-value) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8028   FORMAT(5X,'Note: Mean of Means Best Usage: & ',
     1         2X,A1,A1)
 8029   FORMAT(5X,'      Any Number of Labs, but no Lab-to-Lab ',
     1         'Differences & ',2X,A1,A1)
        WRITE(ICOUT,8024)IDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)APPF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,REAL(DLOWT2),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,REAL(DHIGT2),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*5500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b 8. Method: Grand Mean (No Lab Effect)'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=39
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=19
        IVALUE(1)='   Mean of All Data'
        AVALUE(2)=XGRAND
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=34
        IVALUE(1)='   Standard Deviation of All Data:'
        AVALUE(2)=SDGRAN
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=37
        IVALUE(1)='   SD of Consensus Mean (sd/sqrt(n)):'
        AVALUE(2)=SET1
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Standard Uncertainty (k = 1):'
        AVALUE(2)=SET1
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Expanded Uncertainty (k = 2):'
        AVALUE(2)=2.0*SET1
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=41
        IVALUE(1)(1:29)='   Expanded Uncertainty (k = '
        WRITE(IVALUE(1)(30:39),'(F10.7)')APPF
        IVALUE(1)(40:41)='):'
        AVALUE(2)=APPF*SET1
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=22
        IVALUE(1)='   Degrees of Freedom:'
        AVALUE(2)=REAL(IDF)
        NJUNK=NUMDI2(2)
        NUMDI2(2)=0
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(2)=NJUNK
C
        NCHAR(1)=34
        IVALUE(1)='   t Percent Point Value of 0.975:'
        AVALUE(2)=APPF
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=40
        IVALUE(1)='   Lower 95% (t-value) Confidence Limit:'
        AVALUE(2)=REAL(DLOWT2)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=40
        IVALUE(1)='   Upper 95% (t-value) Confidence Limit:'
        AVALUE(2)=REAL(DHIGT2)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IVALUE(1)='   Note: Grand Mean Best Usage:'
        NCHAR(1)=31
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         Any Number of Labs,'
        NCHAR(1)=28
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         but no Lab-to-Lab Differences'
        NCHAR(1)=38
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('8.  Method: Grand Mean (No Lab Effect)')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4002)XGRAND
 4002   FORMAT('    Mean of All Data:                       ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)SDGRAN
 4003   FORMAT('    Standard Deviation of All Data:         ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4012)SET1
 4012   FORMAT('    SD of Consensus Mean (sd/sqrt(n)):      ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4013)SET1
 4013   FORMAT('    Standard Uncertainty (k = 1):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4014)2.0*SET1
 4014   FORMAT('    Expanded Uncertainty (k = 2):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4015)APPF,APPF*SET1
 4015   FORMAT('    Expanded Uncertainty (k = ',F10.7,'):  ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4020)IDF
 4020   FORMAT('    Degrees of Freedom:                     ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4021)APPF
 4021   FORMAT('    t Percent Point Value (alpha = 0.05):   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4022)REAL(DLOWT2)
 4022   FORMAT('    Lower 95% (t-value) Confidence Limit:   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)REAL(DHIGT2)
 4023   FORMAT('    Upper 95% (t-value) Confidence Limit:   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('    Note: Grand Mean Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)
 4032   FORMAT('          Any Number of Labs, but no Lab-to-Lab ',
     1         'Differences')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GMEA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPGMEA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NLAB
 9013   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)SET1
 9014   FORMAT('SET1 = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)DLOWT2,DHIGT2
 9015   FORMAT('DLOWT2,DHIGT2 = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1XMATN,YMATN,XMITN,YMITN,
     1ISQUAR,
     1IVGMSW,IHGMSW,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1YPLOT,XPLOT,X2PLOT,TAGPLO,
     1IMPSW,IMPNR,IMPNC,IMPCO,
CCCCC ADD FOLLOWING LINE AUGUST 1999.
     1IMPARG,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1MAXCOL,
CCCCC AUGUST 1992.  ADD FOLLOWING LINE
     1DSIZE,DSYMB,DCOLOR,DFILL,
     1ICAPSW,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IERROR)
C
C     PURPOSE--GENERATE A PLOT ON ONE OF THE FOLLOWING--
C                 1) CONTINUOUS DISPLAY TERMINAL
C                 2) NARROW-WIDTH DISCRETE TERMINAL
C                 3) WIDE-CARRIAGE DISCRETE TERMINAL/HIGH-SPEED PRINTER
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  1981.
C     UPDATED         --MARCH     1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --FEBRUARY  1982.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     1987.
C     UPDATED         --MARCH     1988.  TURN OFF FRAME FOR 3D PLOT
C     UPDATED         --FEBRUARY  1989.  YSAVE (ALAN)
C     UPDATED         --FEBRUARY  1989.  DELETE 5 ARRAYS (ALAN)
C     UPDATED         --FEBRUARY  1989.  INITIAL REWRITE FOR NEW 3D
C     UPDATED         --NOVEMBER  1991.  ADJUST FOR MULTIPLOT FREEZE
C     UPDATED         --AUGUST    1992.  ADD PARAMETERS TO PLOTGE
C                                        ADD PARAMETERS TO DPGRAP
C     UPDATED         --SEPTEMBER 1998.  ADD IMPSW2
C     UPDATED         --AUGUST    1999.  MULTIPLOT FIX
C     UPDATED         --AUGUST    2001.  PPCC PLOTS WITH 2 SHAPE
C                                        PARAMETERS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C
      CHARACTER*4 ISQUAR
C
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
C
      CHARACTER*4 IMPSW
CCCCC CHARACTER*4 IERASV
CCCCC CHARACTER*4 IX1TSV
CCCCC CHARACTER*4 IX2TSV
CCCCC CHARACTER*4 IY1TSV
CCCCC CHARACTER*4 IY2TSV
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IFUNC
C
      CHARACTER*1 IREPCH
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGUG
      CHARACTER*4 IBUGU2
      CHARACTER*4 IBUGU3
      CHARACTER*4 IBUGU4
C
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IERROR
C
      CHARACTER*4 IMORE
      CHARACTER*4 ICAS3D
      CHARACTER*4 IFIRST
      CHARACTER*4 ILAST
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION X3D(*)
      DIMENSION D(*)
CCCCC AUGUST 1992.  ADD FOLLOWING BLOCK OF CODE
      DIMENSION DSIZE(*)
      DIMENSION DSYMB(*)
      DIMENSION DCOLOR(*)
      DIMENSION DFILL(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IFUNC(*)
C
C
      DIMENSION YPLOT(*)
      DIMENSION XPLOT(*)
      DIMENSION X2PLOT(*)
      DIMENSION TAGPLO(*)
C
      DIMENSION XIDC(100)
C
CCCCC THE FOLLOWING 5 ARRAYS WERE COMMENTED OUT (ALAN) (FEBRUARY 1989)
CCCCC DIMENSION XSAVE(5000)
CCCCC DIMENSION YSAVE(5000)
CCCCC DIMENSION XOUT(5000)
CCCCC DIMENSION YOUT(5000)
CCCCC DIMENSION TAGOUT(5000)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCO3D.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPGR'
      ISUBN2='AP  '
C
CCCCC THE FOLLOWING LINE WAS INSERTED BY ALAN.  FEBRUARY 1989
      YSAVE=0.0
C
CCCCC ADD FOLLOWING LINE  SEPTEMBER 1998.
      IMPSW2=IMPSW
C
      ICONT=IDCONT(1)
      NUMHPP=IDNHPP(1)
C
      IF(IBUGUG.EQ.'OFF'.AND.ISUBRO.NE.'GRAP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPGRAP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NPLOTP,ICASPL,INEGSW
   52 FORMAT('N,NPLOTP,ICASPL,INEGSW = ',2I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICONT,MAXCHA,NUMDEV,MAXDEV
   53 FORMAT('ICONT,MAXCHA,NUMDEV,MAXDEV = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISQUAR
   54 FORMAT('ISQUAR = ',A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO90
      DO55I=1,NPLOTP
      WRITE(ICOUT,56)I,Y(I),X(I),X3D(I),D(I)
   56 FORMAT('I,Y(I),X(I),X3D(I),D(I) = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,61)XMATN,YMATN,XMITN,YMITN
   61 FORMAT('XMATN,YMATN,XMITN,YMITN = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IMPSW,IMPNR,IMPNC,IMPCO
   71 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)PMXMIN,PMXMAX,PMYMIN,PMYMAX
   72 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IERASW
   73 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   74 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)PXMIN,PXMAX,PYMIN,PYMAX
   75 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
C
   90 CONTINUE
C
C               ****************************************
C               **  STEP 11--                         **
C               **  COPY PLOT COORDINATES             **
C               **  OUT TO VARIABLES YPLOT, XPLOT,    **
C               **  X2PLOT, AND TAGPLOT               **
C               ****************************************
C
      DO100I=1,NPLOTP
      YPLOT(I)=Y(I)
      XPLOT(I)=X(I)
      X2PLOT(I)=X3D(I)
      TAGPLO(I)=D(I)
  100 CONTINUE
      J4=5
      IN(J4)=NPLOTP
      J4=6
      IN(J4)=NPLOTP
      J4=7
      IN(J4)=NPLOTP
      J4=8
      IN(J4)=NPLOTP
C
C               ****************************************
C               **  STEP 12--                         **
C               **  IF THE RESPONSE IS TO BE NEGATED  **
C               **  (AS IN HANGING HISTOGRAMS),       **
C               **  THEN DO SO HERE.                  **
C               ****************************************
C
      IF(INEGSW.EQ.'OFF')GOTO290
      IF(NPLOTP.LE.0)GOTO290
      DO200I=1,NPLOTP
      Y(I)=-Y(I)
  200 CONTINUE
  290 CONTINUE
C
C               *********************************************
C               **  STEP 13--                              **
C               **  IF THE MULTIPLOTTING SWITCH IS ON,     **
C               **  THEN SET THE FRAME CORNER COORDINATES  **
C               **  BEFORE THE PLOT IS DRAWN.              **
C               *********************************************
C
      IF(IMPSW.EQ.'OFF')GOTO390
C
      IF(IMPCO.GE.2)IERASW='OFF'
CCCCC DO NOT ERASE SCREEN FOR 3 AND 4 ARGUMENT FORMS OF MULTIPLOT 
      IF(IMPCO.EQ.1.AND.IMPARG.GE.3)IERASW='OFF'
C
      IPROD=IMPNR*IMPNC
      IMPCO2=MOD(IMPCO,IPROD)
      IF(IMPCO2.LE.0)IMPCO2=IPROD
      ICOL=MOD(IMPCO2,IMPNC)
      IF(ICOL.LE.0)ICOL=IMPNC
      IROW=((IMPCO2-ICOL)/IMPNC)+1
      AIROW=IROW
      AICOL=ICOL
C
      AMPNR=IMPNR
      AMPNC=IMPNC
C
      XDEL=(PMXMAX-PMXMIN)/AMPNC
      YDEL=(PMYMAX-PMYMIN)/AMPNR
C
      X1C=PMXMIN+(AICOL-1.0)*XDEL
      X2C=X1C+XDEL
      Y1C=PMYMAX-AIROW*YDEL
      Y2C=Y1C+YDEL
C
      PWXMIN=X1C
      PWXMAX=X2C
      PWYMIN=Y1C
      PWYMAX=Y2C
C
      IF(IBUGUG.EQ.'OFF'.AND.ISUBRO.NE.'GRAP')GOTO329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('AT END OF STEP 13--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)IMPSW,IMPNR,IMPNC,IMPCO
  322 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)IPROD,IMPCO2,IROW,ICOL
  323 FORMAT('IPROD,IMPCO2,IROW,ICOL = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)PMXMIN,PMXMAX,PMYMIN,PMYMAX
  324 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)XDEL,YDEL
  325 FORMAT('XDEL,YDEL = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)X1C,X2C,Y1C,Y2C
  326 FORMAT('X1C,X2C,Y1C,Y2C = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)PWXMIN,PWXMAX,PWYMIN,PWYMAX
  327 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
  329 CONTINUE
C
  390 CONTINUE
C
C               *************************************************************
C               **  STEP 21--                                              **
C               **  MONITOR NUMSET = THE NUMBER OF SUBSETS.                **
C               **  IF NUMSET EXCEEDS MAXCHA                               **
C               **  (THE MAXIMUM NUMBER OF PLOT CHARACTERS),               **
C               **  THEN THE ANALYSIS WILL BE SEQUENTIALLY                 **
C               **  PARTITIONED INTO NUMSET=MAXCHA SUBSETS AT A TIME       **
C               **  (THAT IS, LOWER LEVEL SUBROUTINES WILL BE FED          **
C               **  ONLY NUMSET=MAXCHA SUBSETS AT A TIME).                 **
C               **  IMIN IS THAT ELEMENT NUMBER (1 THROUGH NPLOTP)         **
C               **  IN THE DATA SET WHERE THE NEXT PARTITION IS TO BEGIN.  **
C               **  THE FOLLOWING LARGE LOOP                               **
C               **  (STARTING WITH     1000 CONTINUE)                      **
C               **  WILL BE ENTERED ONLY IF MORE PARTITIONS EXIST.         **
C               **  IF IMORE = 'YES', THEN MORE PARTITIONS EXIST;          **
C               **  IF IMORE = 'NO' , THEN NO MORE PARTITIONS EXIST        **
C               **  AND THEREFORE WE ARE DONE.                             **
C               *************************************************************
C
      ISTEPN='21'
      IF(IBUGUG.EQ.'ON'.OR.ISUBRO.EQ.'GRAP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMORE='YES'
      IPASS=0
      IMIN=1
C
 1000 CONTINUE
      IMORE='NO'
      IPASS=IPASS+1
      NUMSET=0
C
C               ******************************************
C               **  STEP 22--                           **
C               **  IF A PLOT OF NO DATA IS CALLED FOR  **
C               **  (AS IN THE GENERATION OF            **
C               **  DIAGRAMS, EQUATIONS, AND SLIDES),   **
C               **  THEN SKIP IMMEDIATELY               **
C               **  TO THE PLOTTING.                    **
C               ******************************************
C
      ISTEPN='22'
      IF(IBUGUG.EQ.'ON'.OR.ISUBRO.EQ.'GRAP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'NODA')GOTO1300
C
C               **************************************************
C               **  STEP 23--                                   **
C               **  DETERMINE IF A 3DPLOT IS BEING GENERATED    **
C               **************************************************
C
      ISTEPN='23'
      IF(IBUGUG.EQ.'ON'.OR.ISUBRO.EQ.'GRAP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICAS3D='OFF'
      IF(ICASPL.EQ.'3DNO')GOTO1210
      IF(ICASPL.EQ.'3DEF')GOTO1210
      IF(ICASPL.EQ.'3DVS')GOTO1210
      IF(ICASPL.EQ.'3DFR')GOTO1210
      IF(ICASPL.EQ.'3DHI')GOTO1210
      IF(ICASPL.EQ.'YCUB')GOTO1210
      IF(ICASPL.EQ.'BECP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'LDCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'EWCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'GGCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'GOCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'EPCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'SBCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'SUCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'JBCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'JUCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'ALCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'PLCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'TSCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'IGCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'RICP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'FNCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'FCCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'FCP'  .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'STCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'LZCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'GHCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'NTCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'NCCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'PECP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'NBCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'HYCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'BBCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'PZCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'TECP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'IBCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'HECP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'GALP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'GMCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'HBCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'BNCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'G4CP' .AND. IPPCFO.EQ.'3D')GOTO1210
      IF(ICASPL.EQ.'AXCP' .AND. IPPCFO.EQ.'3D')GOTO1210
      GOTO1290
 1210 CONTINUE
      ICAS3D='ON'
 1290 CONTINUE
C
C               ****************************************************************
C               **  STEP 24--                                                 **
C               **  DETERMINE THE NUMBER OF DISTINCT SUBSETS                  **
C               **  TO BE PLOTTED (ON THE BASIS OF THE NUMBER                 **
C               **  OF DISTINCT LEVELS OF THE SUBSET DEFINITION VARIABLE).    **
C               **  EACH SUBSET DEFINES A POTENTIAL CURVE ON THE FINAL PLOT.  **
C               **  COPY EACH SUBSET IDENTIFIER INTO XIDC(.)                  **
C               **  AND THEN SORT (AN ASCENDING SORT) XIDC(.).                **
C               ****************************************************************
C
      ISTEPN='24'
      IF(IBUGUG.EQ.'ON'.OR.ISUBRO.EQ.'GRAP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110J=1,MAXCHA
      XIDC(J)=0.0
 1110 CONTINUE
C
      DO1120I=IMIN,NPLOTP
      I2=I
      IF(NUMSET.LE.0)GOTO1125
      DO1130J=1,NUMSET
      IF(D(I).EQ.XIDC(J))GOTO1120
 1130 CONTINUE
 1125 CONTINUE
      NUMSET=NUMSET+1
      IF(NUMSET.GT.MAXCHA)GOTO1135
      XIDC(NUMSET)=D(I)
 1120 CONTINUE
      IMORE='NO'
      GOTO1139
 1135 CONTINUE
      IMORE='YES'
      IMIN=I2
      NUMSET=MAXCHA
      GOTO1139
 1139 CONTINUE
      IF(NUMSET.GE.2)CALL SORT(XIDC,NUMSET,XIDC)
C
C               *************************
C               **  STEP 31--          **
C               **  GENERATE THE PLOT  **
C               *************************
C
 1300 CONTINUE
C
      ISTEPN='31'
      IF(IBUGUG.EQ.'ON'.OR.ISUBRO.EQ.'GRAP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFIRST='NO'
      ILAST='NO'
      IF(IPASS.EQ.1)IFIRST='YES'
      IF(IMORE.EQ.'NO')ILAST='YES'
C
      IF(IBUGUG.EQ.'OFF'.AND.ISUBRO.NE.'GRAP')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1301)
 1301 FORMAT('***** FROM THE MIDDLE  OF DPGRAP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1302)
 1302 FORMAT('      (IMMEDIATELY BEFORE A PLOT IS GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1303)ICONT,NUMHPP,MAXCHA
 1303 FORMAT('ICONT,NUMHPP,MAXCHA = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1304)N,NPLOTP,NUMSET,IMIN,IMORE,IPASS,
     1ICASPL,IFIRST,ILAST
 1304 FORMAT('N,NPLOTP,NUMSET,IMIN,IMORE,IPASS,',
     1'ICASPL,IFIRST,ILAST = ',4I8,2X,A4,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO1305I=1,NUMSET
      WRITE(ICOUT,1306)I,XIDC(I),ICHAPA(I),ILINPA(I)
 1306 FORMAT('I,XIDC(I),ICHAPA(I),ILINPA(I) =',I6,F15.7,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1305 CONTINUE
      WRITE(ICOUT,1307)Y(1),X(1),D(1)
 1307 FORMAT('Y(1),X(1),D(1) = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1308)Y(NPLOTP),X(NPLOTP),D(NPLOTP)
 1308 FORMAT('Y(NPLOTP),X(NPLOTP),D(NPLOTP) = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('A PLOT IS GENERATED AT THIS TIME')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
C
CCCCC IF(ICONT.EQ.'ON')
CCCCC1CALL TPLOT(Y,X,D,NPLOTP,NUMSET,ICASPL,ICAS3D,IFIRST,ILAST,
CCCCC1IBARPA,BARSPA,IFENCE,NUMHPP,NUMVPP,
CCCCC1XMATN,YMATN,XMITN,YMITN,
CCCCC1IBUGP,IBUGP1,IBUGP2,IBUGP3,IERROR)
C
      IF(ICONT.EQ.'ON')
     1CALL PLOTGE(Y,X,X3D,D,NPLOTP,XIDC,NUMSET,
     1ICASPL,ICAS3D,
     1ISQUAR,
     1YSAVE,
     1IVGMSW,IHGMSW,
     1IFIRST,ILAST,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
CCCCC AUGUST 1992.  ADD FOLLOWING LINE
     1DSIZE,DSYMB,DCOLOR,DFILL,
     1ICAPSW,
     1IBUGU2,IBUGU3,IBUGU4,ISUBRO,IERROR)
C
      IF(ICONT.EQ.'OFF'.AND.NUMHPP.LE.130.AND.NUMSET.LE.1)
     1CALL PLOTN(Y,X,NPLOTP,ICHAPA,MAXCHA,ICASPL,ICAS3D,
     1ITITTE,NCTITL,
     1IX1LTE,NCX1LA,
     1IX2LTE,NCX2LA,
     1IX3LTE,NCX3LA,
     1IY1LTE,NCY1LA,
     1IY2LTE,NCY2LA,
     1GX1MIN,GX1MAX,GY1MIN,GY1MAX,
     1IERASW,IBUGU2,IERROR)
C
      IF(ICONT.EQ.'OFF'.AND.NUMHPP.LE.130.AND.NUMSET.GE.2)
     1CALL PLOTCN(Y,X,D,NPLOTP,ICHAPA,MAXCHA,ICASPL,ICAS3D,
     1ITITTE,NCTITL,
     1IX1LTE,NCX1LA,
     1IX2LTE,NCX2LA,
     1IX3LTE,NCX3LA,
     1IY1LTE,NCY1LA,
     1IY2LTE,NCY2LA,
     1GX1MIN,GX1MAX,GY1MIN,GY1MAX,
     1IERASW,IBUGU2,IERROR)
C
      IF(ICONT.EQ.'OFF'.AND.NUMHPP.GT.130.AND.NUMSET.LE.1)
     1CALL PLOTW(Y,X,NPLOTP,ICHAPA,MAXCHA,ICASPL,ICAS3D,
     1ITITTE,NCTITL,
     1IX1LTE,NCX1LA,
     1IX2LTE,NCX2LA,
     1IX3LTE,NCX3LA,
     1IY1LTE,NCY1LA,
     1IY2LTE,NCY2LA,
     1GX1MIN,GX1MAX,GY1MIN,GY1MAX,
     1IERASW,IBUGU2,IERROR)
C
      IF(ICONT.EQ.'OFF'.AND.NUMHPP.GT.130.AND.NUMSET.GE.2)
     1CALL PLOTCW(Y,X,D,NPLOTP,ICHAPA,MAXCHA,ICASPL,ICAS3D,
     1ITITTE,NCTITL,
     1IX1LTE,NCX1LA,
     1IX2LTE,NCX2LA,
     1IX3LTE,NCX3LA,
     1IY1LTE,NCY1LA,
     1IY2LTE,NCY2LA,
     1GX1MIN,GX1MAX,GY1MIN,GY1MAX,
     1IERASW,IBUGU2,IERROR)
C
      IF(ICONT.EQ.'OFF'.AND.NUMDEV.GE.2)
     1CALL PLOTGE(Y,X,X3D,D,NPLOTP,XIDC,NUMSET,
     1ICASPL,ICAS3D,
     1ISQUAR,
     1YSAVE,
     1IVGMSW,IHGMSW,
     1IFIRST,ILAST,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
CCCCC AUGUST 1992.  ADD FOLLOWING LINE
     1DSIZE,DSYMB,DCOLOR,DFILL,
     1ICAPSW,
     1IBUGU2,IBUGU3,IBUGU4,ISUBRO,IERROR)
C
      IF(IMORE.EQ.'YES')GOTO1000
C
C               *********************************************
C               **  STEP 32--                              **
C               **  IF THE MULTIPLOTTING SWITCH IS ON,     **
C               **  AND IF THE LAST PLOT ON THE PAGE       **
C               **  HAS JUST BEEN GENERATED,               **
C               **  THEN REVERT THE FRAME COORDINATE       **
C               **  AND PRE-ERASE SETTINGS BACK TO THEIR   **
C               **  PRIOR SETTINGS.                        **
C               *********************************************
C
      IF(IMPSW.EQ.'OFF')GOTO2190
CCCCC THE FOLLOWING LINE WAS FIXED NOVEMBER 1991
CCCCC IMPCO=IMPCO+1
      IF(IMPSW.EQ.'ON')IMPCO=IMPCO+1
CCCCC IPROD=IMPNR*IMPNC
CCCCC IF(IMPCO.GT.IPROD)GOTO2110
CCCCC GOTO2190
C2110 CONTINUE
CCCCC IMPCO=1
CCCCC IERASW=IERASV
CCCCC IX1TSW=IX1TSV
CCCCC IX2TSW=IX2TSV
CCCCC IY1TSW=IY1TSV
CCCCC IY2TSW=IY2TSV
CCCCC PXMIN=PXMISV
CCCCC PXMAX=PXMASV
CCCCC PYMIN=PYMISV
CCCCC PYMAX=PYMASV
 2190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGUG.EQ.'OFF'.AND.ISUBRO.NE.'GRAP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGRAP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR,ICAS3D,I3DPRO
 9012 FORMAT('IERROR,ICAS3D,I3DPRO = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NPLOTP,ICASPL,INEGSW
 9013 FORMAT('N,NPLOTP,ICASPL,INEGSW = ',2I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICONT,MAXCHA,NUMDEV,MAXDEV
 9014 FORMAT('ICONT,MAXCHA,NUMDEV,MAXDEV = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ISQUAR
 9015 FORMAT('ISQUAR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)XMATN,YMATN,XMITN,YMITN
 9021 FORMAT('XMATN,YMATN,XMITN,YMITN = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IMPSW,IMPNR,IMPNC,IMPCO
 9031 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)PMXMIN,PMXMAX,PMYMIN,PMYMAX
 9032 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)IERASW
 9033 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9034 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)PXMIN,PXMAX,PYMIN,PYMAX
 9035 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPGRAY(NPTS,NLAB,
     1AMEAN,ASD,N,
     1XGD,XGDS2,SEGDK1,SEGDK2,
     1DLOWGD,DHIGGD,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--IMPLEMENT GRAYBILL-DEAL APPROACH TO CONSENSUS MEANS
C     PRINTING--YES
C     SUBROUTINES NEEDED--NONE
C     REFERENCES--SINHA (1985). "UNBIASED ESTIMATION OF THE
C                 VARIANCE OF THE GRAYBILL-DEAL ESTIMATOR OF THE
C                 COMMON MEAN OF SEVERAL POPULATIONS", CANADIAN
C                 JOURNAL OF STATISTICS, 13, PP. 243-247.
C               --ZHANG (2006). "THE UNCERTAINTY ASSOCIATED WITH
C                 THE WEIGHTED MEAN OF MEASUREMENT DATA",
C                 METROLOGIA, 43, PP. 195-204.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IMETH
C
      REAL AMEAN(*)
      REAL ASD(*)
C
      REAL APPF
      REAL XGD
      REAL XGDS2
      REAL SEGDK1
      REAL SEGDK2
C
      LOGICAL IFLAG9
C
      INTEGER N(*)
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      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='DPGR'
      ISUBN2='AY  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GRAY')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPGRAY--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB
   52   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C     STEP 1: COMPUTE THE GRAYBILL-DEAL CONSENSUS MEAN
C
      IFLAG9=.TRUE.
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
      DO910I=1,NLAB
        DNI=DBLE(N(I))
        DMEAN=DBLE(AMEAN(I))
        DVARI=DBLE(ASD(I))**2
        DWI=DNI/DVARI
        DSUM1=DSUM1 + DWI*DMEAN
        DSUM2=DSUM2 + DWI
        IF(N(I).GT.3)THEN
          DSUM3=DSUM3 + ((DNI-3.0D0)/(DNI-1.0D0))*DWI
        ELSE
          IFLAG9=.FALSE.
        ENDIF
  910 CONTINUE
      XGD=REAL(DSUM1/DSUM2)
      DTERM3=DSUM2
      DTERM4=DSUM3
C
C     STEP 2: COMPUTE THE GRAYBILL-DEAL VARIANCE.  FOUR METHODS
C             FOR COMPUTING THE VARIANCE ARE USED:
C
C             1) SIMPLE: 1/SUM[i=1 to nlab][1/s(i)'**2]
C             2) METHOD PROPOSED BY SINH
C             3) METHOD 1 PROPOSED BY ZHANG
C             4) METHOD 2 PROPOSED BY ZHANG
C
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
      DSUM4=0.0D0
C
      DO920I=1,NLAB
        DNI=DBLE(N(I))
        DMEAN=DBLE(AMEAN(I))
        DVARI=DBLE(ASD(I))**2
        DWI=DNI/DVARI
        DWI3=DWI/DTERM3
        DSUM1=DSUM1 + DWI3*(1.0D0 - DWI3)/(DNI - 1.0D0)
        DSUM2=DSUM2 + DWI
        IF(N(I).GT.3)THEN
          DTERM5=((DNI-3.0D0)/(DNI-1.0D0))*DWI
          DWI2=DTERM5/DTERM4
          DSUM3=DSUM3 + DTERM5
          DSUM4=DSUM4 + DWI2*(1.0D0-DWI2)/(DNI-1.0D0)
        ELSE
          IFLAG9=.FALSE.
        ENDIF
  920 CONTINUE
      DTERM1=(1.0D0 + DSUM1)/DTERM3
      XGDS2=REAL((1.0D0/DTERM3)*(1.0D0 + 4.0D0*DSUM1))
      SEGDK1=SQRT(XGDS2)
      SEGDK2=2.0*SQRT(XGDS2)
      XGDS20=REAL(1.0D0/DSUM2)
      IF(IFLAG9)THEN
        XGDSZ1=REAL(1.0D0/DSUM3)
        XGDSZ2=REAL((1.0D0/DSUM3)*(1.0D0 + 2.0D0*DSUM4))
      ELSE
        XGDSZ1=0.0
        XGDSZ2=0.0
      ENDIF
C
C     COMPUTE THE RUKHIN CONFIDENCE INTERVALS
C
      DP=DBLE(NLAB)
      DPP=1.0D0/DBLE(NLAB-1)
      DRR=DP**(DP*DPP/2.0D0)
      IDF=NLAB-1
      ALPHA=0.975
      CALL TPPF(REAL(ALPHA),IDF,APPF)
      DPH=DBLE(APPF)/DRR/(DSQRT(DP-1.0D0))
C
      DSUM1=0.0D0
      DPROD1=1.0D0
      DO930I=1,NLAB
        DNI=DBLE(N(I))
        DMEAN=DBLE(AMEAN(I))
        DVARI=DBLE(ASD(I))**2
        DWI=DNI/DVARI
        DSUM1=DSUM1 + DWI*(DMEAN - DBLE(XGD))**2
        DPROD1=DPROD1*DWI
  930 CONTINUE
      DPROD1=DPROD1**DPP
      DRI=DPH*DSQRT(DSUM1)/DSQRT(DPROD1)
      DLOWGD=DBLE(XGD) - DRI
      DHIGGD=DBLE(XGD) + DRI
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5107)
 5107   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('<TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=400>')
 5127   FORMAT('      </TD>')
 5126   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5128   FORMAT('   </TR>')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('         &nbsp;')
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5170)
 5170   FORMAT('         <b>7. Method: Graybill-Deal</b>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Estimate of Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XGD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
 5172   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Estimate of Variance (Sinha):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XGDS2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
 5173   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Estimate of Variance (naive):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XGDS20
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        IF(IFLAG9)THEN
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5174)
 5174   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Estimate of Variance (Zhang 1):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XGDSZ1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5175)
 5175   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Estimate of Variance (Zhang 2):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XGDSZ2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5177)
 5177   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Standard Uncertainty (<i>k</i> = 1):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SQRT(XGDS2)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5178)
 5178   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Expanded Uncertainty (<i>k</i> = 2):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)2.0*SQRT(XGDS2)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5182)
 5182   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Lower 95% (Rukhin) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DLOWGD)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5183)
 5183   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Upper 95% (Rukhin) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DHIGGD)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5184)
 5184   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Note: Graybill-Deal Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5185)
 5185   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Any Number of Labs, but no<br>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5186)
 5186   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Between Lab Variance')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
C
 8002   FORMAT(A1,'begin{table}')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf 7. Method: Graybill-Deal:} & ',
     1         2X,A1,A1)
 8012   FORMAT(5X,'Estimate of Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
 8013   FORMAT(5X,'Estimate of Variance (Sinha): & ',
     1         F15.7,2X,A1,A1)
 8014   FORMAT(5X,'Estimate of Variance (naive): & ',
     1         F15.7,2X,A1,A1)
 8015   FORMAT(5X,'Estimate of Variance (Zhang 1): & ',
     1         F15.7,2X,A1,A1)
 8016   FORMAT(5X,'Estimate of Variance (Zhang 2): & ',
     1         F15.7,2X,A1,A1)
C
        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)XGD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)XGDS2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)XGDS20,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG9)THEN
          WRITE(ICOUT,8015)XGDSZ1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8016)XGDSZ2,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 8020   FORMAT(5X,'Standard Uncertainty (k = 1): & ',
     1         F15.7,2X,A1,A1)
 8021   FORMAT(5X,'Expanded Uncertainty (k = 2): & ',
     1         F15.7,2X,A1,A1)
        WRITE(ICOUT,8020)SQRT(XGDS2),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)2.0*SQRT(XGDS2),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8026   FORMAT(5X,'Lower 95',A1,'% (Rukhin) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8027   FORMAT(5X,'Upper 95',A1,'% (Rukhin) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8028   FORMAT(5X,'Note: Graybill-Deal Best Usage: & ',
     1         2X,A1,A1)
 8029   FORMAT(5X,'      Any Number of Labs, but no ',
     1         'Between Lab Variance & ',2X,A1,A1)
        WRITE(ICOUT,8026)IBASLC,REAL(DLOWGD),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,REAL(DHIGGD),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*5500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b 7. Method: Graybill-Deal'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=27
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=30
        IVALUE(1)='   Estimate of Consensus Mean:'
        AVALUE(2)=XGD
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Estimate of Variance (Sinha):'
        AVALUE(2)=XGDS2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Estimate of Variance (naive):'
        AVALUE(2)=XGDS20
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IF(IFLAG9)THEN
        NCHAR(1)=34
        IVALUE(1)='   Estimate of Variance (Zhang 1):'
        AVALUE(2)=XGDSZ1
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=34
        IVALUE(1)='   Estimate of Variance (Zhang 2):'
        AVALUE(2)=XGDSZ2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        NCHAR(1)=32
        IVALUE(1)='   Standard Uncertainty (k = 1):'
        AVALUE(2)=SQRT(XGDS2)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Expanded Uncertainty (k = 2):'
        AVALUE(2)=2.0*SQRT(XGDS2)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=23
        IVALUE(1)='   Normal PPF of 0.975:'
        AVALUE(2)=APPF
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Lower 95% (Rukhin) Confidence Limit:'
        AVALUE(2)=REAL(DLOWGD)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Upper 95% (Rukhin) Confidence Limit:'
        AVALUE(2)=REAL(DHIGGD)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IVALUE(1)='   Note: Graybill-Deal Best Usage:'
        NCHAR(1)=34
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         Any Number of Labs,'
        NCHAR(1)=28
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         but no Between Lab Variance'
        NCHAR(1)=36
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('7.  Method: Graybill-Deal')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4002)XGD
 4002   FORMAT('    Estimate of Consensus Mean:             ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)XGDS2
 4003   FORMAT('    Estimate of Variance (Sinha):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4004)XGDS20
 4004   FORMAT('    Estimate of Variance (Naive):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG9)THEN
        WRITE(ICOUT,4005)XGDSZ1
 4005   FORMAT('    Estimate of Variance (Zhang 1):         ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4006)XGDSZ2
 4006   FORMAT('    Estimate of Variance (Zhang 2):         ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,4013)SQRT(XGDS2)
 4013   FORMAT('    Standard Uncertainty (Sinha) (k = 1):   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4014)2.0*SQRT(XGDS2)
 4014   FORMAT('    Expanded Uncertainty (Sinha) (k = 2):   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4022)REAL(DLOWGD)
 4022   FORMAT('    Lower 95% (Rukhin) Confidence Limit:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)REAL(DHIGGD)
 4023   FORMAT('    Upper 95% (Rukhin) Confidence Limit:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('    Note: Graybill-Deal Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)
 4032   FORMAT('          Any Number of Labs, but no ',
     1         'Between Lab Variance')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GRAY')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPGRAY--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NLAB
 9013   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)XGD,XGDS2
 9014   FORMAT('XGD,XGDS2 = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)DLOWGD,DHIGGD
 9015   FORMAT('DLOWGD,DHIGGD = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPGRCL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IVGRCO,IHGRCO,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 2 GRID COLOR SWITCHES CONTAINED IN THE
C              VARIABLES IVGRCO AND IHGRCO.
C              SUCH GRID COLOR SWITCHES DEFINE THE COLOR OF
C              THE 2 SETS (ONE VERTICAL AND ONE HORIZONTAL)
C              OF GRID LINES ON A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C     OUTPUT ARGUMENTS--IVGRCO (A HOLLERITH VARIABLE
C                       DENOTING THE COLOR OF THE VERTICAL GRID LINES
C                     --IHGRCO (A HOLLERITH VARIABLE
C                       DENOTING THE COLOR OF THE HORIZONTAL GRID LINES
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCO
C
      CHARACTER*4 IVGRCO
      CHARACTER*4 IHGRCO
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  THE VERTICAL   GRID LINES  ARE TO BE CHANGED   **
C               *****************************************************
C
      IF(ICOM.EQ.'XGRI')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFCO
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IVGRCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE GRID COLOR (FOR VERTICAL   ',
     1'GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  THE HORIZONTAL GRID LINES  ARE TO BE CHANGED   **
C               *****************************************************
C
      IF(ICOM.EQ.'YGRI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFCO
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IHGRCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE GRID COLOR (FOR HORIZONTAL ',
     1'GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               *******************************************************
C               **  TREAT THE CASE WHEN                              **
C               **  GRID LINES IN BOTH DIRECTIONS ARE TO BE CHANGED  **
C               *******************************************************
C
      IF(ICOM.EQ.'GRID')GOTO1300
      IF(ICOM.EQ.'XYGR')GOTO1300
      IF(ICOM.EQ.'YXGR')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFCO
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IHGRCO=IHOLD
      IVGRCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE GRID COLOR (FOR GRID LINES IN ',
     1'BOTH DIRECTIONS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPGRID(ICOM,IHARG,NUMARG,IVGRSW,IHGRSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 2 GRID SWITCHES CONTAINED IN THE
C              VARIABLES IVGRSW AND IHGRSW.
C              SUCH GRID SWITCHES TURN ON OR OFF
C              THE 2 SETS (ONE VERTICAL AND ONE HORIZONTAL)
C              OF GRID LINES ON A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IVGRSW (A HOLLERITH VARIABLE
C                       DENOTING WHETHER THE VERTICAL GRID LINES ARE
C                       ON    OR    OFF)
C                     --IHGRSW (A HOLLERITH VARIABLE
C                       DENOTING WHETHER THE HORIZONTAL GRID LINES ARE
C                       ON    OR    OFF)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IVGRSW
      CHARACTER*4 IHGRSW
C
      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
C               *******************************************
C               **  TREAT THE CASE WHEN                  **
C               **  THE VERTICAL GRID LINES ARE DEFINED  **
C               *******************************************
C
      IF(ICOM.EQ.'XGRI')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1110
      IF(IHARG(1).EQ.'ON')GOTO1110
      IF(IHARG(1).EQ.'OFF')GOTO1120
      IF(IHARG(1).EQ.'AUTO')GOTO1110
      IF(IHARG(1).EQ.'DEFA')GOTO1120
      IERROR='YES'
      GOTO1900
C
 1110 CONTINUE
      IFOUND='YES'
      IVGRSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE XGRID SWITCH (FOR VERTICAL GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      IFOUND='YES'
      IVGRSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE XGRID SWITCH (FOR VERTICAL GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               *********************************************
C               **  TREAT THE CASE WHEN                    **
C               **  THE HORIZONTAL GRID LINES ARE DEFINED  **
C               *********************************************
C
      IF(ICOM.EQ.'YGRI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1210
      IF(IHARG(1).EQ.'ON')GOTO1210
      IF(IHARG(1).EQ.'OFF')GOTO1220
      IF(IHARG(1).EQ.'AUTO')GOTO1210
      IF(IHARG(1).EQ.'DEFA')GOTO1220
      IERROR='YES'
      GOTO1900
C
 1210 CONTINUE
      IFOUND='YES'
      IHGRSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE YGRID SWITCH (FOR HORIZONTAL GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO1900
C
 1220 CONTINUE
      IFOUND='YES'
      IHGRSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE YGRID SWITCH (FOR HORIZONTAL GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1226)
 1226 FORMAT('HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               ***********************************
C               **  TREAT THE CASE WHEN          **
C               **  BOTH GRID LINES ARE DEFINED  **
C               ***********************************
C
      IF(ICOM.EQ.'XYGR')GOTO1300
      IF(ICOM.EQ.'YXGR')GOTO1300
      IF(ICOM.EQ.'GRID')GOTO1300
      IFOUND='NO'
      GOTO1900
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1310
      IF(IHARG(1).EQ.'ON')GOTO1310
      IF(IHARG(1).EQ.'OFF')GOTO1320
      IF(IHARG(1).EQ.'AUTO')GOTO1310
      IF(IHARG(1).EQ.'DEFA')GOTO1320
      IERROR='YES'
      GOTO1399
C
 1310 CONTINUE
      IFOUND='YES'
      IVGRSW='ON'
      IHGRSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE GRID SWITCH (FOR BOTH HORIZONTAL AND VERTICAL ',
     1'GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO1900
C
 1320 CONTINUE
      IFOUND='YES'
      IVGRSW='OFF'
      IHGRSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE GRID SWITCH (FOR BOTH HORIZONTAL AND VERTICAL ',
     1'GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)
 1326 FORMAT('HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPGRMN(ICOM,IHARG,NUMARG,IVGMSW,IHGMSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 2 MINOR GRID SWITCHES CONTAINED IN THE
C              VARIABLES IVGMSW AND IHGMSW.
C              SUCH MINOR GRID SWITCHES TURN ON OR OFF
C              THE 2 SETS (ONE VERTICAL AND ONE HORIZONTAL)
C              OF GRID LINES (AT THE MINOR TIC MARKS) ON A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IVGMSW (A HOLLERITH VARIABLE
C                       DENOTING WHETHER THE VERTICAL GRID LINES ARE
C                       ON    OR    OFF)
C                     --IHGMSW (A HOLLERITH VARIABLE
C                       DENOTING WHETHER THE HORIZONTAL GRID LINES ARE
C                       ON    OR    OFF)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/6
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
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
      ISUBN1='DPGR'
      ISUBN2='MN  '
C
C               *******************************************
C               **  TREAT THE CASE WHEN                  **
C               **  THE VERTICAL GRID LINES ARE DEFINED  **
C               *******************************************
C
      IF(ICOM.EQ.'XGMI')GOTO1100
      IF(ICOM.EQ.'MINO'.AND.
     1NUMARG.GE.1.AND.IHARG(1).EQ.'XGRI')GOTO1105
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1110
      IF(IHARG(1).EQ.'ON')GOTO1110
      IF(IHARG(1).EQ.'OFF')GOTO1120
      IF(IHARG(1).EQ.'AUTO')GOTO1110
      IF(IHARG(1).EQ.'DEFA')GOTO1120
      IERROR='YES'
      GOTO1900
C
 1105 CONTINUE
      IF(NUMARG.LE.1)GOTO1110
      IF(IHARG(2).EQ.'ON')GOTO1110
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1110
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      IERROR='YES'
      GOTO1900
C
 1110 CONTINUE
      IFOUND='YES'
      IVGMSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE MINOR XGRID SWITCH (FOR VERTICAL GRID LINES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('AT MINOR TICS) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      IFOUND='YES'
      IVGMSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE MINOR XGRID SWITCH (FOR VERTICAL GRID LINES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('AT MINOR TICS) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               *********************************************
C               **  TREAT THE CASE WHEN                    **
C               **  THE HORIZONTAL GRID LINES ARE DEFINED  **
C               *********************************************
C
      IF(ICOM.EQ.'YGMI')GOTO1200
      IF(ICOM.EQ.'MINO'.AND.
     1NUMARG.GE.1.AND.IHARG(1).EQ.'YGRI')GOTO1205
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1210
      IF(IHARG(1).EQ.'ON')GOTO1210
      IF(IHARG(1).EQ.'OFF')GOTO1220
      IF(IHARG(1).EQ.'AUTO')GOTO1210
      IF(IHARG(1).EQ.'DEFA')GOTO1220
      IERROR='YES'
      GOTO1900
C
 1205 CONTINUE
      IF(NUMARG.LE.1)GOTO1210
      IF(IHARG(2).EQ.'ON')GOTO1210
      IF(IHARG(2).EQ.'OFF')GOTO1220
      IF(IHARG(2).EQ.'AUTO')GOTO1210
      IF(IHARG(2).EQ.'DEFA')GOTO1220
      IERROR='YES'
      GOTO1900
C
 1210 CONTINUE
      IFOUND='YES'
      IHGMSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE MINOR YGRID SWITCH (FOR HORIZONTAL GRID LINES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('AT MINOR TICS) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO1900
C
 1220 CONTINUE
      IFOUND='YES'
      IHGMSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE MINOR YGRID SWITCH (FOR HORIZONTAL GRID LINES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1226)
 1226 FORMAT('AT MINOR TICS) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               ***********************************
C               **  TREAT THE CASE WHEN          **
C               **  BOTH GRID LINES ARE DEFINED  **
C               ***********************************
C
      IF(ICOM.EQ.'XYGM')GOTO1300
      IF(ICOM.EQ.'YXGM')GOTO1300
      IF(ICOM.EQ.'GMIN')GOTO1300
      IF(ICOM.EQ.'MINO'.AND.
     1NUMARG.GE.1.AND.IHARG(1).EQ.'XYGR')GOTO1305
      IF(ICOM.EQ.'MINO'.AND.
     1NUMARG.GE.1.AND.IHARG(1).EQ.'YXGR')GOTO1305
      IF(ICOM.EQ.'MINO'.AND.
     1NUMARG.GE.1.AND.IHARG(1).EQ.'GRID')GOTO1305
      IFOUND='NO'
      GOTO1900
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1310
      IF(IHARG(1).EQ.'ON')GOTO1310
      IF(IHARG(1).EQ.'OFF')GOTO1320
      IF(IHARG(1).EQ.'AUTO')GOTO1310
      IF(IHARG(1).EQ.'DEFA')GOTO1320
      IERROR='YES'
      GOTO1399
C
 1305 CONTINUE
      IF(NUMARG.LE.1)GOTO1310
      IF(IHARG(2).EQ.'ON')GOTO1310
      IF(IHARG(2).EQ.'OFF')GOTO1320
      IF(IHARG(2).EQ.'AUTO')GOTO1310
      IF(IHARG(2).EQ.'DEFA')GOTO1320
      IERROR='YES'
      GOTO1399
C
 1310 CONTINUE
      IFOUND='YES'
      IVGMSW='ON'
      IHGMSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE MINOR XYGRID SWITCH (FOR BOTH HORIZ. AND VERT. ',
     1'GRID LINES AT MINOR TICS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO1900
C
 1320 CONTINUE
      IFOUND='YES'
      IVGMSW='OFF'
      IHGMSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE MINOR XYGRID SWITCH (FOR BOTH HORIZ. AND VERT. ',
     1'GRID LINE AT MINOR TICS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)
 1326 FORMAT('HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPGROL(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
     1IWRITE,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS SUBROUTINE READS THE CHARCTER DATA STORED IN
C              FILE "DPZCHF.DAT" AND STORES IT IN A GROUP LABEL.
C              EXAMPLE:
C
C                 LET GRPLAB = GROUP LABEL IX
C
C              IN ADDITION, SUPPORT THE FOLLOWING:
C
C                 LET GRPLAB = GROUP LABEL ST1 ST2 ...
C
C              WITH ST1, ST2, ... DENOTING PREVIOUSLY DEFINED
C              STRINGS.  THE "TO" SYNTAX IS SUPPORTED FOR THIS
C              CASE (E.G., ST1 TO ST10).
C
C                 LET GRPLAB = GROUP LABEL "label 1"  "label 2" ...
C
C              I.E., YOU CAN SPECIFY A NUMBER OF LITERAL STRINGS.
C              NOTE THAT THESE TWO FORMATS CANNOT BE MIXED (I.E.,
C              YOU CAN EITHER SPECIFY A LIST OF PREVIOUSLY DEFINED
C              STRING NAMES OR A LIST OF LITERAL STRINGS (ENCLOSED
C              IN QUOTES), BUT NOT BOTH TOGETHER.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM NUMBER OF ROWS FOR A GROUP LABEL IS
C                   MAXOBV/100.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/1
C     ORIGINAL VERSION--JANUARY   2004.
C     UPDATED         --JANUARY   2006. CREATE GROUP LABELS FROM
C                                       PREVIOUSLY DEFINED STRINGS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ICASEL
      CHARACTER*4 IFOUND
      CHARACTER*4 MESSAG
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
C
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IA(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
C
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOF2.INC'
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*500 IATEMP
      CHARACTER*6 IFRMT
      CHARACTER*4 IHTEMP(200)
      CHARACTER*130 ISTRIN
      CHARACTER*130 ISTRI2
C
      PARAMETER(MAXIND=100)
C
      CHARACTER*4 ISTRN1(MAXIND)
      CHARACTER*4 ISTRN2(MAXIND)
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='DPGR'
      ISUBN2='OL  '
C
      IERROR='NO'
      IOPFLG=0
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPGROL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)MAXGRP,MAXGLA
   53   FORMAT('MAXGRP,MAXGLA = ',2I6)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **************************************************
C               **  STEP 1--                                     *
C               **  DETERMINE IF ANY MORE GROUP LABEL VARIABLES  *
C               **  ARE AVAILABLE (DETERMINED BY MAXGRP).        *
C               **  FIRST CHECK IF NAME IS ALREADY DEFINED GROUP *
C               **  LABEL (OVERWRITE IF IT IS).                  *
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
C
C  DETERMINE IF NAME OF GROUP LABEL ALREADY DEFINED
C
      DO1005I=1,MAXGRP
        IF(IGRPVN(I)(1:4).EQ.IHLEFT .AND.
     1     IGRPVN(I)(5:8).EQ.IHLEF2)THEN
          IGRP=I
          IGRPVN(IGRP)(1:4)=IHLEFT
          IGRPVN(IGRP)(5:8)=IHLEF2
          DO1008J=1,MAXGLA
            IGRPLA(J,I)=' '
 1008     CONTINUE
          GOTO1099
        ENDIF
 1005 CONTINUE 
C
      ISTEPN='1B'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  CREATE A NEW NAME
C
      DO1010I=1,MAXGRP
        IF(IGRPVN(I)(1:8).EQ.'        ')THEN
          IGRP=I
          IGRPVN(IGRP)(1:4)=IHLEFT
          IGRPVN(IGRP)(5:8)=IHLEF2
          GOTO1099
        ENDIF
 1010 CONTINUE 
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** ERROR IN LET .. = GROUP LABELS ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)MAXGRP
 1013 FORMAT('      MAXIMUM NUMBER OF GROUP LABEL VARIABLES (',I6,
     1       ') EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1015)
 1015 FORMAT('      NO GROUP LABELS ASSIGNED.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1099 CONTINUE 
C
      ISTEPN='1C'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
C               ********************************************
C               **  STEP 2--                              **
C               **  OPEN THE DPZCHF.DAT FILE.             **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHRIGH=IHARG(5)
      IHRIG2=IHARG2(5)
C
      IOUNIT=IZCHNU
      IFILE=IZCHNA
      ISTAT=IZCHST
      IFORM=IZCHFO
      IACCES=IZCHAC
      IPROT=IZCHPR
      ICURST=IZCHCS
C
      ISUBN0='READ'
      IERRFI='NO'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,
     1            ICURST,
     1            IREWIN,ISUBN0,IERRFI,IBUGA3,ISUBRO,IERROR)
      IOPFLG=1
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
        WRITE(ICOUT,1091)
 1091   FORMAT('THE dpzchf.tex FILE OPENED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(IERRFI.EQ.'YES')GOTO4000
C
CCCCC IF(IERRFI.EQ.'YES')THEN
CCCCC   IERROR='YES'
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1011)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1018)
C1018   FORMAT('      UNABLE TO OPEN THE CHARACTER DATA FILE:')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1019)IFILE
C1019   FORMAT('      ',A80)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   GOTO8000
CCCCC ENDIF
C
      READ(IOUNIT,'(I8)',END=4000,ERR=4000)NUMVAR
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
        WRITE(ICOUT,1093)NUMVAR
 1093   FORMAT('NUMVAR = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IFOUND='NO'
      DO1130I=1,NUMVAR
        READ(IOUNIT,'(A4,A4)',END=4000,ERR=4000)IH,IH2
        IF(IHRIGH.EQ.IH .AND. IHRIG2.EQ.IH2)THEN
          IVAR=I
          IFOUND='YES'
          GOTO1199
        ENDIF
 1130 CONTINUE
C
C  1/2006: IF VARIABLE NOT FOUND, THEN
C          1) SEE IF IT IS A PREVIOUSLY DEFINED STRING
C          2) IF NOT A PREVIOUSLY DEFINED CHARACTER VARIABLE
C             OR A PREVIOUSLY DEFINED STRING, THEN TREAT AS
C             A LITERAL STRING
C
      GOTO4000
C
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1011)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,131)IHRIGH,IHRIG2
CC131 FORMAT('***** VARIABLE ',A4,A4,' NOT FOUND IN THE CHARACTER ',
CCCCC1       'DATA FILE:')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,119)IFILE
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO8000
C
CC171 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,111)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,173)
CC173 FORMAT('      ERROR READING THE NUMBER OF CHARACTER VARIABLES ',
CCCCC1       'IN THE CHARACTER DATA FILE:')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,119)IFILE
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO8000
C
CC181 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,111)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,183)
CC183 FORMAT('      ERROR READING THE VARIABLE NAMES ',
CCCCC1       'IN THE CHARACTER DATA FILE:')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,119)IFILE
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO8000
C
 1199 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
        WRITE(ICOUT,1193)IVAR
 1193   FORMAT('IVAR = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *************************************************
C               **  STEP 3--                                   **
C               **  DEFINE THE GRPOUP LABELS.                  **
C               **  STORE UNIQUE VALUES IN IGRPLA.             **
C               *************************************************
C
C  1/2006: THIS IS CASE WHERE WE READ GROUP LABELS FROM
C          CHARACTER DATA FILE (DPZCHF.DAT).
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IATEMP=' '
      IFRMT='(A   )'
      WRITE(IFRMT(3:5),'(I3)')25*IVAR
      N=1
      IROW=1
      READ(IOUNIT,IFRMT,END=2491,ERR=2491)IATEMP
      IFRST=(IVAR-1)*25 + 1
      ILAST=IVAR*25 - 1
      IGRPLA(1,IGRP)=' '
      IGRPLA(1,IGRP)=IATEMP(IFRST:ILAST)
C
      DO2210I=2,MAXOBV
        IROW=I
        IATEMP=' '
        READ(IOUNIT,IFRMT,END=2499,ERR=2491)IATEMP
        DO2220J=1,N
          IF(IATEMP(IFRST:ILAST).EQ.IGRPLA(J,IGRP)(1:24))GOTO2210
 2220   CONTINUE
        N=N+1
C
        IF(N.GT.MAXGLA)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2261)
 2261     FORMAT('***** WARNING IN LET ... = GROUP LABELS ...')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2263)MAXGLA
 2263     FORMAT('      MAXIMUM NUMBER OF ROWS FOR GROUP LABELS (',
     1           I6,') ','EXCEEDED.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2265)
 2265     FORMAT('      NO ADDITIONAL GROUP LABELS ASSIGNED.')
          CALL DPWRST('XXX','BUG ')
          GOTO8000
        ENDIF
C
        IGRPLA(N,IGRP)=' '
        IGRPLA(N,IGRP)=IATEMP(IFRST:ILAST)
 2210 CONTINUE
      GOTO2499
C
 2491 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2493)IROW
 2493 FORMAT('      ERROR READING ROW ',I8,' OF THE CHARACTER ',
     1       'VARIABLES IN THE CHARACTER DATA FILE:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2495)IFILE
 2495 FORMAT('      ',A80)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8000
C
C               *************************************************
C               **  STEP 4--                                   **
C               **  DETERMINE IF VARIABLE IS A PREVIOUSLY      **
C               **  DEFINED STRING.  IF NOT, TREAT AS A        **
C               **  LITERAL STRING.                            **
C               *************************************************
C
C  1/2006: THIS IS CASE WHERE WE READ GROUP LABELS FROM
C
 4000 CONTINUE
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=5
      JMAX=NUMARG
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
        WRITE(ICOUT,4001)JMIN,JMAX,MAXIND
 4001   FORMAT('JMIN,JMAX,MAXIND = ',3I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(JMAX.LT.JMIN)GOTO8000
      IWRITE='OFF'
      IERROR='NO'
C
      CALL EXTSTR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXIND,
     1IHNAME,IHNAM2,IUSE,NUMNAM,
     1ISTRN1,ISTRN2,NUMSTR,
     1IWRITE,IBUGA3,ISUBRO,IERROR)
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
        WRITE(ICOUT,4003)NUMSTR
 4003   FORMAT('NUMSTR = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IERROR.EQ.'NO')THEN
C
C  CASE WHERE WE ARE EXTRACTING STRINGS
C
        NUMSTR=MIN(NUMSTR,MAXGLA)
        N=NUMSTR
        DO4005I=1,MAXGLA
          IGRPLA(I,IGRP)=' '
 4005   CONTINUE
C
        DO4010I2=1,NUMSTR
          DO4015I=1,NUMNAM
            II=I
            IF(ISTRN1(I2).EQ.IHNAME(I) .AND. ISTRN2(I2).EQ.IHNAM2(I))
     1        GOTO4019
 4015     CONTINUE
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4021)
 4021     FORMAT('****** ERROR FROM DPGROL--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4023)ISTRN1(I2),ISTRN2(I2)
 4023     FORMAT('       STRING ',A4,A4,' NOT MATCHED IN NAME ',
     1           'TABLE.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO8000
C
 4019     CONTINUE
          IVAL=IVALUE(II)
          VAL=VALUE(II)
          IL1=IVSTAR(II)
          IL2=IVSTOP(II)
C
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
            WRITE(ICOUT,4011)IL1,IL2
 4011       FORMAT('II,IL1,IL2 = ',3I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          CALL DPCOFH(IL1,IL2,IFUNC,NUMCHF,IHTEMP,NH,IBUGA3,IERROR)
          ILAST=MIN(24,NH)
C
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
            WRITE(ICOUT,4013)NH,ILAST
 4013       FORMAT('NH,ILAST = ',2I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          IF(ILAST.GT.0)THEN
            DO4020J=1,ILAST
              IGRPLA(I2,IGRP)(J:J)=IHTEMP(J)(1:1)
 4020       CONTINUE
            IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
              WRITE(ICOUT,4014)I2,IGRPLA(I2,IGRP)
 4014         FORMAT('I2,IGRPLA(I2,IGRP) = ',I8,A24)
              CALL DPWRST('XXX','BUG ')
            ENDIF
          ENDIF
 4010   CONTINUE
      ELSE
C
C  CASE WHERE WE ARE EXTRACTING LITERALS
C
        ICNT=0
        IFRST=5
        MESSAG='OFF'
        DO4105I=1,MAXGLA
          IGRPLA(I,IGRP)=' '
 4105   CONTINUE
        DO4108I=1,130
          ISTRIN(I:I)=IANSLC(I)(1:1)
 4108   CONTINUE
C
 4100   CONTINUE
          IFRST=IFRST+1
          ICNT=ICNT+1
          ISTART=1
          ISTOP=130
          IERROR='NO'
          ICOL1=1
          ICOL2=130
          CALL DPEXS1(ISTRIN,ISTART,ISTOP,IFRST,MESSAG,
     1                ICOL1,ICOL2,ISTRI2,NCSTR2,
     1                IBUGA3,ISUBRO,IERROR)
          IF(NCSTR2.GT.0 .AND. IERROR.NE.'YES')THEN
            ILAST=MIN(24,NCSTR2)
            DO4120J=1,ILAST
              IGRPLA(ICNT,IGRP)(J:J)=ISTRI2(J:J)
 4120       CONTINUE
            GOTO4100
          ENDIF
          N=ICNT-1
      ENDIF
C
      GOTO2499
C
C               ******************************
C               **  STEP 3--                **
C               **  WRITE OUT A FEW LINES   **
C               **  OF SUMMARY INFORMATION  **
C               **  ABOUT THE CODING.       **
C               ******************************
C
 2499 CONTINUE
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2811)N
 2811   FORMAT('NUMBER OF DISTINCT FACTORS DETECTED = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(N.GT.1)THEN
          WRITE(ICOUT,2821)MIN(N,20)
 2821     FORMAT('THE FIRST ',I4,' GROUP LABELS:')
          CALL DPWRST('XXX','BUG ')
          DO2820I=1,MIN(N,20)
            WRITE(ICOUT,2822)I,IGRPLA(I,IGRP)
 2822       FORMAT('GROUP LABEL ',I2,' IS: ',A24)
            CALL DPWRST('XXX','BUG ')
 2820     CONTINUE
        ENDIF
      ENDIF
      GOTO8000
C
C               ***************************************
C               **  STEP 88--                        **
C               **  CLOSE THE DPZCHF.DAT FILE.       **
C               ***************************************
C
 8000 CONTINUE
C
      IF(IOPFLG.EQ.1)THEN
        IENDFI='OFF'
        IREWIN='ON'
        CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1              IENDFI,IREWIN,ISUBN0,IERRFI,IBUGA3,ISUBRO,IERROR)
        IZCHCS='CLOSED'
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'GROL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END OF DPGROL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA3,IERROR
 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)N,IGRP
 9013   FORMAT('N,IIGRP = ',2I8)
        CALL DPWRST('XXX','BUG ')
        IF(N.GT.0)THEN
          DO9015I=1,N
            WRITE(ICOUT,9016)I,IGRPLA(I,IGRP)
 9016       FORMAT('I,IGRPLA(I,IGRP) = ',I8,A24)
            CALL DPWRST('XXX','BUG ')
 9015     CONTINUE
        ENDIF
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPGRO2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A  GROUND
C              WITH THE TOP AT (X1,Y1)
C              AND THE BOTTOM AT (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
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.  CALL 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.'GRO2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPGRO2--')
      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 GROUND             **
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
      K=0
C
      X=0
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=ALEN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      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/3.0
      Y=ALEN/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/3.0
      Y=-ALEN/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
      K=0
C
      X=ALEN*(2.0/3.0)
      Y=ALEN/4.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*(2.0/3.0)
      Y=-ALEN/4.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.'GRO2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGRO2--')
      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 DPGROU(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 GROUNDS
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 TOP AND THE BOTTOM TIP
C           OF THE GROUND.
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 GROUND 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 GROUND 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 GROUND 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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
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(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDCOLO(*)
      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.'GROU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPGROU--')
      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='GROU'
      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 DPGROU--')
      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 GROUND ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH TOP AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND WITH THE BOTTOM AT THE POINT 20 15')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      GROUND 20 20 20 15 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      GROUND ABSOLUTE 20 20 20 15 ')
      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 DPGRO2(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.'GROU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGROU--')
      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 DPGRPA(ICOM,IHARG,IHARG2,NUMARG,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPGRPA(ICOM,IHARG,NUMARG,
     1IDEFPA,
     1IVGRPA,IHGRPA,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 2 GRID PATTERN SWITCHES CONTAINED IN THE
C              VARIABLES IVGRPA AND IHGRPA.
C              SUCH GRID PATTERN SWITCHES DEFINE THE PATTERN OF
C              THE 2 SETS (ONE VERTICAL AND ONE HORIZONTAL)
C              OF GRID LINES ON A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFPA
C     OUTPUT ARGUMENTS--IVGRPA (A HOLLERITH VARIABLE
C                       DENOTING THE PATTERN OF THE VERTICAL GRID LINES
C                     --IHGRPA (A HOLLERITH VARIABLE
C                       DENOTING THE PATTERN OF THE HORIZONTAL GRID LINES
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDEFPA
C
      CHARACTER*4 IVGRPA
      CHARACTER*4 IHGRPA
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  THE VERTICAL   GRID LINES  ARE TO BE CHANGED   **
C               *****************************************************
C
      IF(ICOM.EQ.'XGRI')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFPA
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'5')IHOLD='DA5'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IVGRPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE GRID PATTERN (FOR VERTICAL   ',
     1'GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  THE HORIZONTAL GRID LINES  ARE TO BE CHANGED   **
C               *****************************************************
C
      IF(ICOM.EQ.'YGRI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFPA
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'5')IHOLD='DA5'
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IHGRPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE GRID PATTERN (FOR HORIZONTAL ',
     1'GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               *******************************************************
C               **  TREAT THE CASE WHEN                              **
C               **  GRID LINES IN BOTH DIRECTIONS ARE TO BE CHANGED  **
C               *******************************************************
C
      IF(ICOM.EQ.'GRID')GOTO1300
      IF(ICOM.EQ.'XYGR')GOTO1300
      IF(ICOM.EQ.'YXGR')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFPA
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(NUMARG).EQ.'5')IHOLD='DA5'
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IHGRPA=IHOLD
      IVGRPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE GRID PATTERN (FOR GRID LINES IN ',
     1'BOTH DIRECTIONS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPGRTH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PVGRTH,PHGRTH,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 2 GRID THICKNESS SWITCHES CONTAINED IN THE
C              VARIABLES PVGRTH AND PHGRTH.
C              SUCH GRID THICKNESS SWITCHES DEFINE THE THICKNESS OF
C              THE 2 SETS (ONE VERTICAL AND ONE HORIZONTAL)
C              OF GRID LINES ON A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C     OUTPUT ARGUMENTS--PVGRTH (A REAL VARIABLE
C                       DENOTING THE THICKNESS OF THE VERTICAL GRID LINES
C                     --PHGRTH (A REAL VARIABLE
C                       DENOTING THE THICKNESS OF THE HORIZONTAL GRID LINES
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      REAL        PDEFTH
C
      REAL        PVGRTH
      REAL        PHGRTH
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      REAL        PHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  THE VERTICAL   GRID LINES  ARE TO BE CHANGED   **
C               *****************************************************
C
      IF(ICOM.EQ.'XGRI')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      PHOLD=PDEFTH
      GOTO1180
C
 1160 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PVGRTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE GRID THICKNESS (FOR VERTICAL   ',
     1'GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  THE HORIZONTAL GRID LINES  ARE TO BE CHANGED   **
C               *****************************************************
C
      IF(ICOM.EQ.'YGRI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      PHOLD=PDEFTH
      GOTO1280
C
 1260 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PHGRTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE GRID THICKNESS (FOR HORIZONTAL ',
     1'GRID LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)PHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               *******************************************************
C               **  TREAT THE CASE WHEN                              **
C               **  GRID LINES IN BOTH DIRECTIONS ARE TO BE CHANGED  **
C               *******************************************************
C
      IF(ICOM.EQ.'GRID')GOTO1300
      IF(ICOM.EQ.'XYGR')GOTO1300
      IF(ICOM.EQ.'YXGR')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      PHOLD=PDEFTH
      GOTO1380
C
 1360 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PHGRTH=PHOLD
      PVGRTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE GRID THICKNESS (FOR GRID LINES IN ',
     1'BOTH DIRECTIONS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)PHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPGRUB(XTEMP1,MAXNXT,
     1ICAPSW,ICASAN,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT GRUBB TEST FOR
C              OUTLIERS
C     EXAMPLE--GRUBB TEST Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/9
C     ORIGINAL VERSION--SEPTEMBER 1997.
C     UPDATED         --JANUARY   2004.
C     UPDATED         --FEBRUARY  2006. DISTINCT CASES FOR MINIMUM
C                                       AND MAXIMUM
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICASAN
C
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 IH11
      CHARACTER*4 IH12
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPGR'
      ISUBN2='UB  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************************
C               **  TREAT THE GRUBB            TEST CASE  **
C               ********************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'GRUB')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPGRUB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPGRUB--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR THE GRUBB TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      THE ARGUMENT MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPGRUB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH THE GRUBB TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,MIN(80,IWIDTH))
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1. **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPGRUB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH THE GRUBB TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,MIN(80,IWIDTH))
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************
C               **  STEP 52--                    **
C               **  DO THE GRUBB TEST            **
C               ***********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPGRUB, AS WE ARE ABOUT TO CALL DPGRU2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPGRU2(Y,NS1,
     1XTEMP1,MAXNXT,
     1ICAPSW,ICAPTY,IGRU1S,ICASAN,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT975,CUT99,CUT100,
     1ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPGR'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF50'
      VALUE0=CUT50
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF75'
      VALUE0=CUT75
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF90'
      VALUE0=CUT90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF95'
      VALUE0=CUT95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='F975'
      VALUE0=CUT975
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF99'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='F100'
      VALUE0=CUT100
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'GRUB')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGRUB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPGRU2(Y,N,
     1XTEMP,MAXNXT,
     1ICAPSW,ICAPTY,IGRU1S,ICASAN,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT975,CUT99,CUT100,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT THE GRUBB TEST
C              FOR EQUALITY TO A DISTRIBUTION
C     EXAMPLE--GRUBB TEST Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/9
C     ORIGINAL VERSION--SEPTEMBER 1997.
C     UPDATED         --JANUARY   2004. SUPPORT FOR HTML, LATEX OUTPUT
C     UPDATED         --MAY       2005. CORRECT CRITICAL VALUES
C                                       (REALLY 2 TESTS - ONE FOR
C                                       POSITIVE OUTLIERS AND ONE FOR
C                                       NEGATIVE OUTLIERS).  NEED TO
C                                       DIVIDE CRITICAL VALUES BY 2.
C                                       IN ADDITION, GENERATE THE
C                                       ONE TAILED VERSIONS.
C     UPDATED         --FEBRUARY  2006. SEPARATE SYNTAX FOR MINIMUM
C                                       AND MAXIMUM TESTS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IGRU1S
      CHARACTER*4 ICASAN
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBASLC
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
      CHARACTER*6 ICONC4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPGR'
      ISUBN2='UB  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'GRU2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPGRU2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3,ICASAN
   52 FORMAT('IBUGA3,ICASAN = ',2A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPGRU2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPGRU2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPGRU2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR    GRUBB's    TEST  **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      NM2=N-2
      CALL MINIM(Y,N,IWRITE,YMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,YMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
      RATIO1=(YMEAN-YMIN)/YSD
      RATIO2=(YMAX-YMEAN)/YSD
      STATV0=MAX(RATIO1,RATIO2)
      STATV1=RATIO1
      STATV2=RATIO2
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'GRU2')THEN
        WRITE(ICOUT,4109)YMEAN,YSD,YMIN,YMAX
        CALL DPWRST('XXX','BUG')
      ENDIF
 4109 FORMAT('YMEAN,YSD,YMIN,YMAX=',4E15.7)
C
C  3 CASES:
C
C  1) TEST BOTH MIN AND MAX
C  2) TEST MIN
C  3) TEST MAX
C
CCCCC IPASS=0
C
C4199 CONTINUE
C
CCCCC IPASS=IPASS+1
CCCCC IF(IPASS.GT.3)GOTO9000
CCCCC IF(IGRU1S.EQ.'OFF'.AND.IPASS.GT.1)GOTO9000
C
      IF(ICASAN.EQ.'GTES')THEN
        STATVA=STATV0
        AFACT=2.0
        APOSS=YMIN
        IF(RATIO2.GT.RATIO1)APOSS=YMAX
      ELSEIF(ICASAN.EQ.'GTMI')THEN
        STATVA=STATV1
        AFACT=1.0
        APOSS=YMIN
      ELSEIF(ICASAN.EQ.'GTMA')THEN
        STATVA=STATV2
        AFACT=1.0
        APOSS=YMAX
      ENDIF
      Q=(STATVA*SQRT(REAL(N))/REAL(N-1))**2
      IF(Q.GE.1.0)THEN
        STATCD=1.0
      ELSE
        T=SQRT((Q/(1.0-Q))*REAL(NM2))
        T2=-T
        CALL TCDF(T2,NM2,CDF)
        ALPHA=2.0*REAL(N)*CDF
        STATCD=1.0-ALPHA
      ENDIF
C
      CUT0=0.
C
C  MAY 2005.  DIVIDE CRITICAL VALUES BY 2.
C
      ALPHA=.5
      P2=1.0 - (ALPHA/REAL(N))/AFACT
      CALL TPPF(P2,NM2,T)
      CUT50=(REAL(N-1)/SQRT(REAL(N)))*SQRT(T*T/(REAL(NM2)+T*T))
C
      ALPHA=.25
      P2=1.0 - (ALPHA/REAL(N))/AFACT
      CALL TPPF(P2,NM2,T)
      CUT75=(REAL(N-1)/SQRT(REAL(N)))*SQRT(T*T/(REAL(NM2)+T*T))
C
      ALPHA=.10
      P2=1.0 - (ALPHA/REAL(N))/AFACT
      CALL TPPF(P2,NM2,T)
      CUT90=(REAL(N-1)/SQRT(REAL(N)))*SQRT(T*T/(REAL(NM2)+T*T))
C
      ALPHA=.05
      P2=1.0 - (ALPHA/REAL(N))/AFACT
      CALL TPPF(P2,NM2,T)
      CUT95=(REAL(N-1)/SQRT(REAL(N)))*SQRT(T*T/(REAL(NM2)+T*T))
C
      ALPHA=.025
      P2=1.0 - (ALPHA/REAL(N))/AFACT
      CALL TPPF(P2,NM2,T)
      CUT975=(REAL(N-1)/SQRT(REAL(N)))*SQRT(T*T/(REAL(NM2)+T*T))
C
      ALPHA=.01
      P2=1.0 - (ALPHA/REAL(N))/AFACT
      CALL TPPF(P2,NM2,T)
      CUT99=(REAL(N-1)/SQRT(REAL(N)))*SQRT(T*T/(REAL(NM2)+T*T))
C
      ALPHA=0.0
      CUT100=REAL(N-1)/SQRT(REAL(N))
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
      ICONC4='REJECT'
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR GRUBB TEST            **
C               *********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: WRITE HEADER
C
        WRITE(ICOUT,5001)
 5001   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
 5002   FORMAT('<CENTER>')
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'GTES')THEN
          WRITE(ICOUT,5003)
 5003     FORMAT('<B>GRUBBS TEST FOR OUTLIERS (TEST MAX AND MIN)<BR>')
        ELSEIF(ICASAN.EQ.'GTMI')THEN
          WRITE(ICOUT,5006)
 5006     FORMAT('<B>GRUBBS TEST FOR OUTLIERS (TEST MIN ONLY)<BR>')
        ELSEIF(ICASAN.EQ.'GTMA')THEN
          WRITE(ICOUT,5008)
 5008     FORMAT('<B>GRUBBS TEST FOR OUTLIERS (TEST MAX ONLY)<BR>')
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
 5004   FORMAT('(ASSUMPTION: NORMALITY)</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5005)
 5005   FORMAT('</CENTER> <BR><BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START LIST
C
        WRITE(ICOUT,5010)
 5010   FORMAT('<OL>')
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2A: LIST ITEM 1
C
 5007   FORMAT('   <LI>Statistics:')
 5009   FORMAT('       <P>')
 5011   FORMAT('       <TABLE NOBORDER>')
 5021   FORMAT('         <TR>')
 5023   FORMAT('            <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
 5027   FORMAT('            </TD>')
 5026   FORMAT('            <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
 5029   FORMAT('                ',I8)
 5028   FORMAT('         </TR>')
 5051   FORMAT('            ',G15.7)
 5052   FORMAT('            &nbsp;')
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5009)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
C
 5025   FORMAT('               Number of Observations:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5025)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5041   FORMAT('               Minimum:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)YMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5042   FORMAT('               Mean:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5042)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)YMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5043   FORMAT('               Maximum:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)YMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5044   FORMAT('               Standard Deviation:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5044)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)YSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5045   FORMAT('               Grubbs Test Statistic')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)STATVA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5091)
 5091   FORMAT('       </TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5009)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: LIST ITEM 2
C
        WRITE(ICOUT,5066)
 5066   FORMAT('   <LI>Percent Points of the Reference ',
     1         'Distribution<br>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
 5067   FORMAT('       for the Grubbs Test Statistic:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5009)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
C
 5071   FORMAT('               0    Percent Point:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5072   FORMAT('               50   Percent Point:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT50
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5073   FORMAT('               75   Percent Point:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT75
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5074   FORMAT('               90   Percent Point:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5075   FORMAT('               95   Percent Point:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5078   FORMAT('               97.55   Percent Point:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT975
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
 5076   FORMAT('               99   Percent Point:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5076)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT99
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
 5077   FORMAT('               100   Percent Point:')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5077)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT100
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5009)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2C: LIST ITEM 3
C
        WRITE(ICOUT,5081)
 5081   FORMAT('   <LI>Conclusion (at the 5% level):')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5009)
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,5087)
 5087     FORMAT('        There are no outliers.')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5088)APOSS
 5088     FORMAT('        The value, ',G15.7,', is an outlier')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
 5093   FORMAT('</OL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5095)
 5095   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
 8000   FORMAT('{',A1,'bf GRUBBS TEST FOR OUTLIERS ',
     1         '(TEST BOTH MIN AND MAX}',2X,A1,A1)
 8013   FORMAT('{',A1,'bf GRUBBS TEST FOR OUTLIERS ',
     1         '(TEST MIN ONLY}',2X,A1,A1)
 8014   FORMAT('{',A1,'bf GRUBBS TEST FOR OUTLIERS ',
     1         '(TEST MAX ONLY}',2X,A1,A1)
 8001   FORMAT('{',A1,'bf (ASSUMPTION: NORMALITY}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8004   FORMAT(A1,'begin{center}')
 8005   FORMAT(A1,'end{center}')
 8006   FORMAT(A1,'end{verbatim}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
 8011   FORMAT(A1,'begin{enumerate}')
 8012   FORMAT(A1,'end{enumerate}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'GTES')THEN
          WRITE(ICOUT,8000)IBASLC,IBASLC,IBASLC
        ELSEIF(ICASAN.EQ.'GTMI')THEN
          WRITE(ICOUT,8013)IBASLC,IBASLC,IBASLC
        ELSEIF(ICASAN.EQ.'GTMA')THEN
          WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8020   FORMAT(11X,A1,'newline')
 8021   FORMAT(5X,A1,'item Statistics:')
 8022   FORMAT(5X,A1,'item Percent Points of the Reference ',
     1         'Distribution for Grubbs Test Statistic:')
 8023   FORMAT(5X,A1,'item Conclusion (at the 5',A1,'% level):')
 8030   FORMAT(11X,A1,'begin{tabular} {lr}')
 8031   FORMAT(11X,'Number of Observations: & ',I8,2X,A1,A1)
 8032   FORMAT(11X,'Minimum: & ',G15.7,2X,A1,A1)
 8033   FORMAT(11X,'Mean: & ',G15.7,2X,A1,A1)
 8034   FORMAT(11X,'Maximum: & ',G15.7,2X,A1,A1)
 8035   FORMAT(11X,'Standard Deviation: & ',G15.7,2X,A1,A1)
 8036   FORMAT(11X,'Grubbs Test Statistic: & ',G15.7,2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8042   FORMAT(11X,'There are no outliers.',2X,A1,A1)
 8043   FORMAT(11X,'The value, ',G15.7,', is an outlier.',2X,A1,A1)
 8044   FORMAT(11X,'0      Percent Point: & ',G15.7,2X,A1,A1)
 8045   FORMAT(11X,'50     Percent Point: & ',G15.7,2X,A1,A1)
 8046   FORMAT(11X,'90     Percent Point: & ',G15.7,2X,A1,A1)
 8047   FORMAT(11X,'95     Percent Point: & ',G15.7,2X,A1,A1)
 8048   FORMAT(11X,'99     Percent Point: & ',G15.7,2X,A1,A1)
 8049   FORMAT(11X,'99.5   Percent Point: & ',G15.7,2X,A1,A1)
 8050   FORMAT(11X,'100    Percent Point: & ',G15.7,2X,A1,A1)
 8058   FORMAT(11X,'97.5   Percent Point: & ',G15.7,2X,A1,A1)
C
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)YMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)YMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)YMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)YSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8036)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8022)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)CUT0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)CUT50,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)CUT90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8047)CUT95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8058)CUT975,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8048)CUT99,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)CUT100,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,8042)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8043)APOSS,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8051   FORMAT(A1,'end{enumerate}')
 8052   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8051)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8052)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'GTES')THEN
          WRITE(ICOUT,4211)
 4211     FORMAT('              GRUBBS TEST FOR OUTLIERS ',
     1           '(TEST FOR BOTH MIN AND MAX)')
        ELSEIF(ICASAN.EQ.'GTMI')THEN
          WRITE(ICOUT,4213)
 4213     FORMAT('              GRUBBS TEST FOR OUTLIERS ',
     1           '(TEST FOR MIN ONLY)')
        ELSEIF(ICASAN.EQ.'GTMA')THEN
          WRITE(ICOUT,4214)
 4214     FORMAT('              GRUBBS TEST FOR OUTLIERS ',
     1           '(TEST FOR MAX ONLY)')
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4212)
 4212   FORMAT('              (ASSUMPTION: NORMALITY)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4241)
 4241   FORMAT('1. STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)N
 4242   FORMAT(6X,'NUMBER OF OBSERVATIONS      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4343)YMIN
 4343   FORMAT(6X,'MINIMUM                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)YMEAN
 4243   FORMAT(6X,'MEAN                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4443)YMAX
 4443   FORMAT(6X,'MAXIMUM                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4244)YSD
 4244   FORMAT(6X,'STANDARD DEVIATION          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4344)STATVA
 4344   FORMAT(6X,'GRUBBS TEST STATISTIC       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4341)
 4341   FORMAT('2. PERCENT POINTS OF THE REFERENCE DISTRIBUTION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4441)
 4441   FORMAT(3X,'FOR GRUBBS TEST STATISTIC')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)CUT0
 4245   FORMAT(6X,'0          % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)CUT50
 4246   FORMAT(6X,'50         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4247)CUT75
 4247   FORMAT(6X,'75         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4248)CUT90
 4248   FORMAT(6X,'90         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4249)CUT95
 4249   FORMAT(6X,'95         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4253)CUT975
 4253   FORMAT(6X,'97.5       % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4250)CUT99
 4250   FORMAT(6X,'99         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4251)CUT100
 4251   FORMAT(6X,'100        % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        CDF2=100.0*STATCD
CCCCC   WRITE(ICOUT,4259)CDF2,STATVA
C4259   FORMAT(6X,G15.7,'  % POINT:     ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4261)
 4261   FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LT.CUT95)THEN
          WRITE(ICOUT,4263)
 4263     FORMAT(6X,'THERE ARE NO OUTLIERS.')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4265)APOSS
 4265     FORMAT(6X,'THE VALUE, ',G15.7,', IS AN OUTLIER.')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
CCCCC GOTO4199
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'GRU2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGRU2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),XTEMP(I)
 9017 FORMAT('I,Y(I),XTEMP(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPGSL(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR GREEK SIMPLEX LOWER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPGSL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHGR(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.16)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DGSL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.17)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DGSL2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGSL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPGSU(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR GREEK SIMPLEX UPPER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IOPERA
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
      DIMENSION IOPERA(300)
      DIMENSION IX(300)
      DIMENSION IY(300)
C
      DIMENSION IXMIND(30)
      DIMENSION IXMAXD(30)
      DIMENSION IXDELD(30)
      DIMENSION ISTARD(30)
      DIMENSION NUMCOO(30)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
C     DEFINE CHARACTER    527--UPPER CASE ALPH
C
      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',   0,  12/
      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',  -8,  -9/
      DATA IOPERA(   3),IX(   3),IY(   3)/'MOVE',   0,  12/
      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',   8,  -9/
      DATA IOPERA(   5),IX(   5),IY(   5)/'MOVE',  -5,  -2/
      DATA IOPERA(   6),IX(   6),IY(   6)/'DRAW',   5,  -2/
C
      DATA IXMIND(   1)/  -9/
      DATA IXMAXD(   1)/   9/
      DATA IXDELD(   1)/  18/
      DATA ISTARD(   1)/   1/
      DATA NUMCOO(   1)/   6/
C
C     DEFINE CHARACTER    528--UPPER CASE BETA
C
      DATA IOPERA(   7),IX(   7),IY(   7)/'MOVE',  -7,  12/
      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',  -7,  -9/
      DATA IOPERA(   9),IX(   9),IY(   9)/'MOVE',  -7,  12/
      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',   2,  12/
      DATA IOPERA(  11),IX(  11),IY(  11)/'DRAW',   5,  11/
      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',   6,  10/
      DATA IOPERA(  13),IX(  13),IY(  13)/'DRAW',   7,   8/
      DATA IOPERA(  14),IX(  14),IY(  14)/'DRAW',   7,   6/
      DATA IOPERA(  15),IX(  15),IY(  15)/'DRAW',   6,   4/
      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',   5,   3/
      DATA IOPERA(  17),IX(  17),IY(  17)/'DRAW',   2,   2/
      DATA IOPERA(  18),IX(  18),IY(  18)/'MOVE',  -7,   2/
      DATA IOPERA(  19),IX(  19),IY(  19)/'DRAW',   2,   2/
      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',   5,   1/
      DATA IOPERA(  21),IX(  21),IY(  21)/'DRAW',   6,   0/
      DATA IOPERA(  22),IX(  22),IY(  22)/'DRAW',   7,  -2/
      DATA IOPERA(  23),IX(  23),IY(  23)/'DRAW',   7,  -5/
      DATA IOPERA(  24),IX(  24),IY(  24)/'DRAW',   6,  -7/
      DATA IOPERA(  25),IX(  25),IY(  25)/'DRAW',   5,  -8/
      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',   2,  -9/
      DATA IOPERA(  27),IX(  27),IY(  27)/'DRAW',  -7,  -9/
C
      DATA IXMIND(   2)/ -11/
      DATA IXMAXD(   2)/  10/
      DATA IXDELD(   2)/  21/
      DATA ISTARD(   2)/   7/
      DATA NUMCOO(   2)/  21/
C
C     DEFINE CHARACTER    529--UPPER CASE GAMM
C
      DATA IOPERA(  28),IX(  28),IY(  28)/'MOVE',  -6,  12/
      DATA IOPERA(  29),IX(  29),IY(  29)/'DRAW',  -6,  -9/
      DATA IOPERA(  30),IX(  30),IY(  30)/'MOVE',  -6,  12/
      DATA IOPERA(  31),IX(  31),IY(  31)/'DRAW',   6,  12/
C
      DATA IXMIND(   3)/ -10/
      DATA IXMAXD(   3)/   7/
      DATA IXDELD(   3)/  17/
      DATA ISTARD(   3)/  28/
      DATA NUMCOO(   3)/   4/
C
C     DEFINE CHARACTER    530--UPPER CASE DELT
C
      DATA IOPERA(  32),IX(  32),IY(  32)/'MOVE',   0,  12/
      DATA IOPERA(  33),IX(  33),IY(  33)/'DRAW',  -8,  -9/
      DATA IOPERA(  34),IX(  34),IY(  34)/'MOVE',   0,  12/
      DATA IOPERA(  35),IX(  35),IY(  35)/'DRAW',   8,  -9/
      DATA IOPERA(  36),IX(  36),IY(  36)/'MOVE',  -8,  -9/
      DATA IOPERA(  37),IX(  37),IY(  37)/'DRAW',   8,  -9/
C
      DATA IXMIND(   4)/  -9/
      DATA IXMAXD(   4)/   9/
      DATA IXDELD(   4)/  18/
      DATA ISTARD(   4)/  32/
      DATA NUMCOO(   4)/   6/
C
C     DEFINE CHARACTER    531--UPPER CASE EPSI
C
      DATA IOPERA(  38),IX(  38),IY(  38)/'MOVE',  -6,  12/
      DATA IOPERA(  39),IX(  39),IY(  39)/'DRAW',  -6,  -9/
      DATA IOPERA(  40),IX(  40),IY(  40)/'MOVE',  -6,  12/
      DATA IOPERA(  41),IX(  41),IY(  41)/'DRAW',   7,  12/
      DATA IOPERA(  42),IX(  42),IY(  42)/'MOVE',  -6,   2/
      DATA IOPERA(  43),IX(  43),IY(  43)/'DRAW',   2,   2/
      DATA IOPERA(  44),IX(  44),IY(  44)/'MOVE',  -6,  -9/
      DATA IOPERA(  45),IX(  45),IY(  45)/'DRAW',   7,  -9/
C
      DATA IXMIND(   5)/ -10/
      DATA IXMAXD(   5)/   9/
      DATA IXDELD(   5)/  19/
      DATA ISTARD(   5)/  38/
      DATA NUMCOO(   5)/   8/
C
C     DEFINE CHARACTER    532--UPPER CASE ZETA
C
      DATA IOPERA(  46),IX(  46),IY(  46)/'MOVE',   7,  12/
      DATA IOPERA(  47),IX(  47),IY(  47)/'DRAW',  -7,  -9/
      DATA IOPERA(  48),IX(  48),IY(  48)/'MOVE',  -7,  12/
      DATA IOPERA(  49),IX(  49),IY(  49)/'DRAW',   7,  12/
      DATA IOPERA(  50),IX(  50),IY(  50)/'MOVE',  -7,  -9/
      DATA IOPERA(  51),IX(  51),IY(  51)/'DRAW',   7,  -9/
C
      DATA IXMIND(   6)/ -10/
      DATA IXMAXD(   6)/  10/
      DATA IXDELD(   6)/  20/
      DATA ISTARD(   6)/  46/
      DATA NUMCOO(   6)/   6/
C
C     DEFINE CHARACTER    533--UPPER CASE ETA
C
      DATA IOPERA(  52),IX(  52),IY(  52)/'MOVE',  -7,  12/
      DATA IOPERA(  53),IX(  53),IY(  53)/'DRAW',  -7,  -9/
      DATA IOPERA(  54),IX(  54),IY(  54)/'MOVE',   7,  12/
      DATA IOPERA(  55),IX(  55),IY(  55)/'DRAW',   7,  -9/
      DATA IOPERA(  56),IX(  56),IY(  56)/'MOVE',  -7,   2/
      DATA IOPERA(  57),IX(  57),IY(  57)/'DRAW',   7,   2/
C
      DATA IXMIND(   7)/ -11/
      DATA IXMAXD(   7)/  11/
      DATA IXDELD(   7)/  22/
      DATA ISTARD(   7)/  52/
      DATA NUMCOO(   7)/   6/
C
C     DEFINE CHARACTER    534--UPPER CASE THET
C
      DATA IOPERA(  58),IX(  58),IY(  58)/'MOVE',  -2,  12/
      DATA IOPERA(  59),IX(  59),IY(  59)/'DRAW',  -4,  11/
      DATA IOPERA(  60),IX(  60),IY(  60)/'DRAW',  -6,   9/
      DATA IOPERA(  61),IX(  61),IY(  61)/'DRAW',  -7,   7/
      DATA IOPERA(  62),IX(  62),IY(  62)/'DRAW',  -8,   4/
      DATA IOPERA(  63),IX(  63),IY(  63)/'DRAW',  -8,  -1/
      DATA IOPERA(  64),IX(  64),IY(  64)/'DRAW',  -7,  -4/
      DATA IOPERA(  65),IX(  65),IY(  65)/'DRAW',  -6,  -6/
      DATA IOPERA(  66),IX(  66),IY(  66)/'DRAW',  -4,  -8/
      DATA IOPERA(  67),IX(  67),IY(  67)/'DRAW',  -2,  -9/
      DATA IOPERA(  68),IX(  68),IY(  68)/'DRAW',   2,  -9/
      DATA IOPERA(  69),IX(  69),IY(  69)/'DRAW',   4,  -8/
      DATA IOPERA(  70),IX(  70),IY(  70)/'DRAW',   6,  -6/
      DATA IOPERA(  71),IX(  71),IY(  71)/'DRAW',   7,  -4/
      DATA IOPERA(  72),IX(  72),IY(  72)/'DRAW',   8,  -1/
      DATA IOPERA(  73),IX(  73),IY(  73)/'DRAW',   8,   4/
      DATA IOPERA(  74),IX(  74),IY(  74)/'DRAW',   7,   7/
      DATA IOPERA(  75),IX(  75),IY(  75)/'DRAW',   6,   9/
      DATA IOPERA(  76),IX(  76),IY(  76)/'DRAW',   4,  11/
      DATA IOPERA(  77),IX(  77),IY(  77)/'DRAW',   2,  12/
      DATA IOPERA(  78),IX(  78),IY(  78)/'DRAW',  -2,  12/
      DATA IOPERA(  79),IX(  79),IY(  79)/'MOVE',  -3,   2/
      DATA IOPERA(  80),IX(  80),IY(  80)/'DRAW',   3,   2/
C
      DATA IXMIND(   8)/ -11/
      DATA IXMAXD(   8)/  11/
      DATA IXDELD(   8)/  22/
      DATA ISTARD(   8)/  58/
      DATA NUMCOO(   8)/  23/
C
C     DEFINE CHARACTER    535--UPPER CASE IOTA
C
      DATA IOPERA(  81),IX(  81),IY(  81)/'MOVE',   0,  12/
      DATA IOPERA(  82),IX(  82),IY(  82)/'DRAW',   0,  -9/
C
      DATA IXMIND(   9)/  -4/
      DATA IXMAXD(   9)/   4/
      DATA IXDELD(   9)/   8/
      DATA ISTARD(   9)/  81/
      DATA NUMCOO(   9)/   2/
C
C     DEFINE CHARACTER    536--UPPER CASE KAPP
C
      DATA IOPERA(  83),IX(  83),IY(  83)/'MOVE',  -7,  12/
      DATA IOPERA(  84),IX(  84),IY(  84)/'DRAW',  -7,  -9/
      DATA IOPERA(  85),IX(  85),IY(  85)/'MOVE',   7,  12/
      DATA IOPERA(  86),IX(  86),IY(  86)/'DRAW',  -7,  -2/
      DATA IOPERA(  87),IX(  87),IY(  87)/'MOVE',  -2,   3/
      DATA IOPERA(  88),IX(  88),IY(  88)/'DRAW',   7,  -9/
C
      DATA IXMIND(  10)/ -11/
      DATA IXMAXD(  10)/  10/
      DATA IXDELD(  10)/  21/
      DATA ISTARD(  10)/  83/
      DATA NUMCOO(  10)/   6/
C
C     DEFINE CHARACTER    537--UPPER CASE LAMB
C
      DATA IOPERA(  89),IX(  89),IY(  89)/'MOVE',   0,  12/
      DATA IOPERA(  90),IX(  90),IY(  90)/'DRAW',  -8,  -9/
      DATA IOPERA(  91),IX(  91),IY(  91)/'MOVE',   0,  12/
      DATA IOPERA(  92),IX(  92),IY(  92)/'DRAW',   8,  -9/
C
      DATA IXMIND(  11)/  -9/
      DATA IXMAXD(  11)/   9/
      DATA IXDELD(  11)/  18/
      DATA ISTARD(  11)/  89/
      DATA NUMCOO(  11)/   4/
C
C     DEFINE CHARACTER    538--UPPER CASE MU
C
      DATA IOPERA(  93),IX(  93),IY(  93)/'MOVE',  -8,  12/
      DATA IOPERA(  94),IX(  94),IY(  94)/'DRAW',  -8,  -9/
      DATA IOPERA(  95),IX(  95),IY(  95)/'MOVE',  -8,  12/
      DATA IOPERA(  96),IX(  96),IY(  96)/'DRAW',   0,  -9/
      DATA IOPERA(  97),IX(  97),IY(  97)/'MOVE',   8,  12/
      DATA IOPERA(  98),IX(  98),IY(  98)/'DRAW',   0,  -9/
      DATA IOPERA(  99),IX(  99),IY(  99)/'MOVE',   8,  12/
      DATA IOPERA( 100),IX( 100),IY( 100)/'DRAW',   8,  -9/
C
      DATA IXMIND(  12)/ -12/
      DATA IXMAXD(  12)/  12/
      DATA IXDELD(  12)/  24/
      DATA ISTARD(  12)/  93/
      DATA NUMCOO(  12)/   8/
C
C     DEFINE CHARACTER    539--UPPER CASE NU
C
      DATA IOPERA( 101),IX( 101),IY( 101)/'MOVE',  -7,  12/
      DATA IOPERA( 102),IX( 102),IY( 102)/'DRAW',  -7,  -9/
      DATA IOPERA( 103),IX( 103),IY( 103)/'MOVE',  -7,  12/
      DATA IOPERA( 104),IX( 104),IY( 104)/'DRAW',   7,  -9/
      DATA IOPERA( 105),IX( 105),IY( 105)/'MOVE',   7,  12/
      DATA IOPERA( 106),IX( 106),IY( 106)/'DRAW',   7,  -9/
C
      DATA IXMIND(  13)/ -11/
      DATA IXMAXD(  13)/  11/
      DATA IXDELD(  13)/  22/
      DATA ISTARD(  13)/ 101/
      DATA NUMCOO(  13)/   6/
C
C     DEFINE CHARACTER    540--UPPER CASE XI
C
      DATA IOPERA( 107),IX( 107),IY( 107)/'MOVE',  -7,  12/
      DATA IOPERA( 108),IX( 108),IY( 108)/'DRAW',   7,  12/
      DATA IOPERA( 109),IX( 109),IY( 109)/'MOVE',  -3,   2/
      DATA IOPERA( 110),IX( 110),IY( 110)/'DRAW',   3,   2/
      DATA IOPERA( 111),IX( 111),IY( 111)/'MOVE',  -7,  -9/
      DATA IOPERA( 112),IX( 112),IY( 112)/'DRAW',   7,  -9/
C
      DATA IXMIND(  14)/  -9/
      DATA IXMAXD(  14)/   9/
      DATA IXDELD(  14)/  18/
      DATA ISTARD(  14)/ 107/
      DATA NUMCOO(  14)/   6/
C
C     DEFINE CHARACTER    541--UPPER CASE OMIC
C
      DATA IOPERA( 113),IX( 113),IY( 113)/'MOVE',  -2,  12/
      DATA IOPERA( 114),IX( 114),IY( 114)/'DRAW',  -4,  11/
      DATA IOPERA( 115),IX( 115),IY( 115)/'DRAW',  -6,   9/
      DATA IOPERA( 116),IX( 116),IY( 116)/'DRAW',  -7,   7/
      DATA IOPERA( 117),IX( 117),IY( 117)/'DRAW',  -8,   4/
      DATA IOPERA( 118),IX( 118),IY( 118)/'DRAW',  -8,  -1/
      DATA IOPERA( 119),IX( 119),IY( 119)/'DRAW',  -7,  -4/
      DATA IOPERA( 120),IX( 120),IY( 120)/'DRAW',  -6,  -6/
      DATA IOPERA( 121),IX( 121),IY( 121)/'DRAW',  -4,  -8/
      DATA IOPERA( 122),IX( 122),IY( 122)/'DRAW',  -2,  -9/
      DATA IOPERA( 123),IX( 123),IY( 123)/'DRAW',   2,  -9/
      DATA IOPERA( 124),IX( 124),IY( 124)/'DRAW',   4,  -8/
      DATA IOPERA( 125),IX( 125),IY( 125)/'DRAW',   6,  -6/
      DATA IOPERA( 126),IX( 126),IY( 126)/'DRAW',   7,  -4/
      DATA IOPERA( 127),IX( 127),IY( 127)/'DRAW',   8,  -1/
      DATA IOPERA( 128),IX( 128),IY( 128)/'DRAW',   8,   4/
      DATA IOPERA( 129),IX( 129),IY( 129)/'DRAW',   7,   7/
      DATA IOPERA( 130),IX( 130),IY( 130)/'DRAW',   6,   9/
      DATA IOPERA( 131),IX( 131),IY( 131)/'DRAW',   4,  11/
      DATA IOPERA( 132),IX( 132),IY( 132)/'DRAW',   2,  12/
      DATA IOPERA( 133),IX( 133),IY( 133)/'DRAW',  -2,  12/
C
      DATA IXMIND(  15)/ -11/
      DATA IXMAXD(  15)/  11/
      DATA IXDELD(  15)/  22/
      DATA ISTARD(  15)/ 113/
      DATA NUMCOO(  15)/  21/
C
C     DEFINE CHARACTER    542--UPPER CASE PI
C
      DATA IOPERA( 134),IX( 134),IY( 134)/'MOVE',  -7,  12/
      DATA IOPERA( 135),IX( 135),IY( 135)/'DRAW',  -7,  -9/
      DATA IOPERA( 136),IX( 136),IY( 136)/'MOVE',   7,  12/
      DATA IOPERA( 137),IX( 137),IY( 137)/'DRAW',   7,  -9/
      DATA IOPERA( 138),IX( 138),IY( 138)/'MOVE',  -7,  12/
      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',   7,  12/
C
      DATA IXMIND(  16)/ -11/
      DATA IXMAXD(  16)/  11/
      DATA IXDELD(  16)/  22/
      DATA ISTARD(  16)/ 134/
      DATA NUMCOO(  16)/   6/
C
C     DEFINE CHARACTER    543--UPPER CASE RHO
C
      DATA IOPERA( 140),IX( 140),IY( 140)/'MOVE',  -7,  12/
      DATA IOPERA( 141),IX( 141),IY( 141)/'DRAW',  -7,  -9/
      DATA IOPERA( 142),IX( 142),IY( 142)/'MOVE',  -7,  12/
      DATA IOPERA( 143),IX( 143),IY( 143)/'DRAW',   2,  12/
      DATA IOPERA( 144),IX( 144),IY( 144)/'DRAW',   5,  11/
      DATA IOPERA( 145),IX( 145),IY( 145)/'DRAW',   6,  10/
      DATA IOPERA( 146),IX( 146),IY( 146)/'DRAW',   7,   8/
      DATA IOPERA( 147),IX( 147),IY( 147)/'DRAW',   7,   5/
      DATA IOPERA( 148),IX( 148),IY( 148)/'DRAW',   6,   3/
      DATA IOPERA( 149),IX( 149),IY( 149)/'DRAW',   5,   2/
      DATA IOPERA( 150),IX( 150),IY( 150)/'DRAW',   2,   1/
      DATA IOPERA( 151),IX( 151),IY( 151)/'DRAW',  -7,   1/
C
      DATA IXMIND(  17)/ -11/
      DATA IXMAXD(  17)/  10/
      DATA IXDELD(  17)/  21/
      DATA ISTARD(  17)/ 140/
      DATA NUMCOO(  17)/  12/
C
C     DEFINE CHARACTER    544--UPPER CASE SIGM
C
      DATA IOPERA( 152),IX( 152),IY( 152)/'MOVE',  -7,  12/
      DATA IOPERA( 153),IX( 153),IY( 153)/'DRAW',   0,   2/
      DATA IOPERA( 154),IX( 154),IY( 154)/'DRAW',  -7,  -9/
      DATA IOPERA( 155),IX( 155),IY( 155)/'MOVE',  -7,  12/
      DATA IOPERA( 156),IX( 156),IY( 156)/'DRAW',   7,  12/
      DATA IOPERA( 157),IX( 157),IY( 157)/'MOVE',  -7,  -9/
      DATA IOPERA( 158),IX( 158),IY( 158)/'DRAW',   7,  -9/
C
      DATA IXMIND(  18)/  -9/
      DATA IXMAXD(  18)/   9/
      DATA IXDELD(  18)/  18/
      DATA ISTARD(  18)/ 152/
      DATA NUMCOO(  18)/   7/
C
C     DEFINE CHARACTER    545--UPPER CASE TAU
C
      DATA IOPERA( 159),IX( 159),IY( 159)/'MOVE',   0,  12/
      DATA IOPERA( 160),IX( 160),IY( 160)/'DRAW',   0,  -9/
      DATA IOPERA( 161),IX( 161),IY( 161)/'MOVE',  -7,  12/
      DATA IOPERA( 162),IX( 162),IY( 162)/'DRAW',   7,  12/
C
      DATA IXMIND(  19)/  -8/
      DATA IXMAXD(  19)/   8/
      DATA IXDELD(  19)/  16/
      DATA ISTARD(  19)/ 159/
      DATA NUMCOO(  19)/   4/
C
C     DEFINE CHARACTER    546--UPPER CASE UPSI
C
      DATA IOPERA( 163),IX( 163),IY( 163)/'MOVE',  -7,   7/
      DATA IOPERA( 164),IX( 164),IY( 164)/'DRAW',  -7,   9/
      DATA IOPERA( 165),IX( 165),IY( 165)/'DRAW',  -6,  11/
      DATA IOPERA( 166),IX( 166),IY( 166)/'DRAW',  -5,  12/
      DATA IOPERA( 167),IX( 167),IY( 167)/'DRAW',  -3,  12/
      DATA IOPERA( 168),IX( 168),IY( 168)/'DRAW',  -2,  11/
      DATA IOPERA( 169),IX( 169),IY( 169)/'DRAW',  -1,   9/
      DATA IOPERA( 170),IX( 170),IY( 170)/'DRAW',   0,   5/
      DATA IOPERA( 171),IX( 171),IY( 171)/'DRAW',   0,  -9/
      DATA IOPERA( 172),IX( 172),IY( 172)/'MOVE',   7,   7/
      DATA IOPERA( 173),IX( 173),IY( 173)/'DRAW',   7,   9/
      DATA IOPERA( 174),IX( 174),IY( 174)/'DRAW',   6,  11/
      DATA IOPERA( 175),IX( 175),IY( 175)/'DRAW',   5,  12/
      DATA IOPERA( 176),IX( 176),IY( 176)/'DRAW',   3,  12/
      DATA IOPERA( 177),IX( 177),IY( 177)/'DRAW',   2,  11/
      DATA IOPERA( 178),IX( 178),IY( 178)/'DRAW',   1,   9/
      DATA IOPERA( 179),IX( 179),IY( 179)/'DRAW',   0,   5/
C
      DATA IXMIND(  20)/  -9/
      DATA IXMAXD(  20)/   9/
      DATA IXDELD(  20)/  18/
      DATA ISTARD(  20)/ 163/
      DATA NUMCOO(  20)/  17/
C
C     DEFINE CHARACTER    547--UPPER CASE PHI
C
      DATA IOPERA( 180),IX( 180),IY( 180)/'MOVE',   0,  12/
      DATA IOPERA( 181),IX( 181),IY( 181)/'DRAW',   0,  -9/
      DATA IOPERA( 182),IX( 182),IY( 182)/'MOVE',  -2,   7/
      DATA IOPERA( 183),IX( 183),IY( 183)/'DRAW',  -5,   6/
      DATA IOPERA( 184),IX( 184),IY( 184)/'DRAW',  -6,   5/
      DATA IOPERA( 185),IX( 185),IY( 185)/'DRAW',  -7,   3/
      DATA IOPERA( 186),IX( 186),IY( 186)/'DRAW',  -7,   0/
      DATA IOPERA( 187),IX( 187),IY( 187)/'DRAW',  -6,  -2/
      DATA IOPERA( 188),IX( 188),IY( 188)/'DRAW',  -5,  -3/
      DATA IOPERA( 189),IX( 189),IY( 189)/'DRAW',  -2,  -4/
      DATA IOPERA( 190),IX( 190),IY( 190)/'DRAW',   2,  -4/
      DATA IOPERA( 191),IX( 191),IY( 191)/'DRAW',   5,  -3/
      DATA IOPERA( 192),IX( 192),IY( 192)/'DRAW',   6,  -2/
      DATA IOPERA( 193),IX( 193),IY( 193)/'DRAW',   7,   0/
      DATA IOPERA( 194),IX( 194),IY( 194)/'DRAW',   7,   3/
      DATA IOPERA( 195),IX( 195),IY( 195)/'DRAW',   6,   5/
      DATA IOPERA( 196),IX( 196),IY( 196)/'DRAW',   5,   6/
      DATA IOPERA( 197),IX( 197),IY( 197)/'DRAW',   2,   7/
      DATA IOPERA( 198),IX( 198),IY( 198)/'DRAW',  -2,   7/
C
      DATA IXMIND(  21)/ -10/
      DATA IXMAXD(  21)/  10/
      DATA IXDELD(  21)/  20/
      DATA ISTARD(  21)/ 180/
      DATA NUMCOO(  21)/  19/
C
C     DEFINE CHARACTER    548--UPPER CASE CHI
C
      DATA IOPERA( 199),IX( 199),IY( 199)/'MOVE',  -7,  12/
      DATA IOPERA( 200),IX( 200),IY( 200)/'DRAW',   7,  -9/
      DATA IOPERA( 201),IX( 201),IY( 201)/'MOVE',  -7,  -9/
      DATA IOPERA( 202),IX( 202),IY( 202)/'DRAW',   7,  12/
C
      DATA IXMIND(  22)/ -10/
      DATA IXMAXD(  22)/  10/
      DATA IXDELD(  22)/  20/
      DATA ISTARD(  22)/ 199/
      DATA NUMCOO(  22)/   4/
C
C     DEFINE CHARACTER    549--UPPER CASE PSI
C
      DATA IOPERA( 203),IX( 203),IY( 203)/'MOVE',   0,  12/
      DATA IOPERA( 204),IX( 204),IY( 204)/'DRAW',   0,  -9/
      DATA IOPERA( 205),IX( 205),IY( 205)/'MOVE',  -9,   6/
      DATA IOPERA( 206),IX( 206),IY( 206)/'DRAW',  -8,   6/
      DATA IOPERA( 207),IX( 207),IY( 207)/'DRAW',  -7,   5/
      DATA IOPERA( 208),IX( 208),IY( 208)/'DRAW',  -6,   1/
      DATA IOPERA( 209),IX( 209),IY( 209)/'DRAW',  -5,  -1/
      DATA IOPERA( 210),IX( 210),IY( 210)/'DRAW',  -4,  -2/
      DATA IOPERA( 211),IX( 211),IY( 211)/'DRAW',  -1,  -3/
      DATA IOPERA( 212),IX( 212),IY( 212)/'DRAW',   1,  -3/
      DATA IOPERA( 213),IX( 213),IY( 213)/'DRAW',   4,  -2/
      DATA IOPERA( 214),IX( 214),IY( 214)/'DRAW',   5,  -1/
      DATA IOPERA( 215),IX( 215),IY( 215)/'DRAW',   6,   1/
      DATA IOPERA( 216),IX( 216),IY( 216)/'DRAW',   7,   5/
      DATA IOPERA( 217),IX( 217),IY( 217)/'DRAW',   8,   6/
      DATA IOPERA( 218),IX( 218),IY( 218)/'DRAW',   9,   6/
C
      DATA IXMIND(  23)/ -11/
      DATA IXMAXD(  23)/  11/
      DATA IXDELD(  23)/  22/
      DATA ISTARD(  23)/ 203/
      DATA NUMCOO(  23)/  16/
C
C     DEFINE CHARACTER    550--UPPER CASE OMEG
C
      DATA IOPERA( 219),IX( 219),IY( 219)/'MOVE',  -7,  -9/
      DATA IOPERA( 220),IX( 220),IY( 220)/'DRAW',  -3,  -9/
      DATA IOPERA( 221),IX( 221),IY( 221)/'DRAW',  -6,  -2/
      DATA IOPERA( 222),IX( 222),IY( 222)/'DRAW',  -7,   2/
      DATA IOPERA( 223),IX( 223),IY( 223)/'DRAW',  -7,   6/
      DATA IOPERA( 224),IX( 224),IY( 224)/'DRAW',  -6,   9/
      DATA IOPERA( 225),IX( 225),IY( 225)/'DRAW',  -4,  11/
      DATA IOPERA( 226),IX( 226),IY( 226)/'DRAW',  -1,  12/
      DATA IOPERA( 227),IX( 227),IY( 227)/'DRAW',   1,  12/
      DATA IOPERA( 228),IX( 228),IY( 228)/'DRAW',   4,  11/
      DATA IOPERA( 229),IX( 229),IY( 229)/'DRAW',   6,   9/
      DATA IOPERA( 230),IX( 230),IY( 230)/'DRAW',   7,   6/
      DATA IOPERA( 231),IX( 231),IY( 231)/'DRAW',   7,   2/
      DATA IOPERA( 232),IX( 232),IY( 232)/'DRAW',   6,  -2/
      DATA IOPERA( 233),IX( 233),IY( 233)/'DRAW',   3,  -9/
      DATA IOPERA( 234),IX( 234),IY( 234)/'DRAW',   7,  -9/
C
      DATA IXMIND(  24)/ -10/
      DATA IXMAXD(  24)/  10/
      DATA IXDELD(  24)/  20/
      DATA ISTARD(  24)/ 219/
      DATA NUMCOO(  24)/  16/
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPGSU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C               **************************************************
C
      CALL DPCHGR(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
      GOTO1000
C
C               **************************************
C               **************************************
C               **  STEP 2--                        **
C               **  EXTRACT THE COORDINATES         **
C               **  FOR THIS PARTICULAR CHARACTER.  **
C               **************************************
C               **************************************
C
 1000 CONTINUE
      ISTART=ISTARD(ICHARN)
      NC=NUMCOO(ICHARN)
      ISTOP=ISTART+NC-1
      J=0
      DO1100I=ISTART,ISTOP
      J=J+1
      IOP(J)=IOPERA(I)
      X(J)=IX(I)
      Y(J)=IY(I)
 1100 CONTINUE
      NUMCO=J
      IXMINS=IXMIND(ICHARN)
      IXMAXS=IXMAXD(ICHARN)
      IXDELS=IXDELD(ICHARN)
C
      GOTO9000
C
C               *****************
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPGSU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHADE(IHARG,IARGT,ARG,NUMARG,DEFHAD,
     1HARDDE,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE HARDCOPY DELAY FACTOR.
C              THE SPECIFIED HARDCOPY DELAY FACTOR WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE HARDDE.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFHAD (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--HARDDE (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
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 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DELA')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'DELA')GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPHADE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR HARDCOPY DELAY ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE THE ANALYST WISHES TO DOUBLE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE DELAY TIME WHILE HARDCOPIES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      ARE BEING MADE, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      HARDCOPY DELAY 2 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFHAD
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
CCCCC HARDDE=HOLD
      AIMAX=2**(NUMBPC*NUMCPW-2)
      IF(HOLD.LT.AIMAX)HARDDE=HOLD
      IF(HOLD.GE.AIMAX)HARDDE=AIMAX
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)HARDDE
 1181 FORMAT('THE HARDCOPY DELAY FACTOR HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPHANW(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,IANS,
     1IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--ACCESS THE ON-LINE NIST/SEMATECH ENGINEERING
C              STATISTICS HANDBOOK VIA
C              A WEB BROWSER (DEFAULTS TO NETSCAPE).
C
C              THIS COMMAND TAKES THE FOLLOWING FORMS:
C                  WEB HANDBOOK       - GO TO MAIN HANDBOOK HOME PAGE
C                  WEB HANDBOOK <KEYWORD> - GO TO A PARTICULAR PAGE
C                                       IN THE ON-LINE HANDBOOK BASED
C                                       ON MATCHING <KEYWORD> TO A
C                                       FILE (HANDBOOK.TEX)
C     INPUT  ARGUMENTS--IANS    (A  HOLLERITH VECTOR)
C                     --IWIDTH (AN INTEGER VARIABLE)
C                     --IBROWS  (A CHARACTER VARIABLE THAT IDENTIFIES
C                               THE BROWSER TO USE)
C                     --IHBURL  (A CHARACTER VARIABLE THAT IDENTIFIES
C                               THE WEB URL OF THE DATAPLOT HOME PAGE)
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/3
C     ORIGINAL VERSION--MARCH     1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IANS
      CHARACTER*1 IQUOTE
      CHARACTER*40 ILINE1
      CHARACTER*40 ILINE2
      CHARACTER*500 ICALL
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 ISUBN0
      CHARACTER*4 IERRFI
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
C
      CHARACTER*4 IWORD1
      CHARACTER*4 IWORD2
      CHARACTER*4 IWORD3
      CHARACTER*4 IWORD4
      CHARACTER*4 IWOR12
C
      CHARACTER*4 IBRWFL
C
      CHARACTER*1 ICHAR1
C
      CHARACTER*4 ICTEST
      CHARACTER*4 ICTES2
C
      CHARACTER*4 IZ1
      CHARACTER*4 IZ2
      CHARACTER*4 IZ3
      CHARACTER*4 IZ4
C
      CHARACTER*40 ISTRIN
      CHARACTER*4 IERRO2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
      DIMENSION IARGT(*)
      DIMENSION IANS(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.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='DPHA'
      ISUBN2='NW  '
      NUMLIN=(-999)
      NUMSEC=(-999)
      ISECNA=(-999)
C
      NUMAR2=(-999)
C
      IWORD1='    '
      IWORD2='    '
      IWORD3='    '
      IWORD4='    '
      IWOR12='    '
C
      ICTEST='    '
      ICTES2='    '
C
      ILINE1='                              '
      ILINE2='                              '
      ICALL=' '
C
      IZ1='    '
      IZ2='    '
      IZ3='    '
      IZ4='    '
C
      JCHAR1=(-999)
      JSEC=(-999)
      JSECP1=(-999)
C
      ISKIP=(-999)
      ISTART=(-999)
      ISTOP=(-999)
      I2=(-999)
C
      ISTRIN='                              '
C
      NUMWHF=(-999)
      ILOC2=(-999)
      ILOC3=(-999)
      ILOC4=(-999)
C
      ILOC2P=(-999)
      ILOC3P=(-999)
      ILOC4P=(-999)
C
      CALL DPCONA(39,IQUOTE)
C
      IFOUND='YES'
      IERROR='NO'
C
      ISHIFT=1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGS2,IERROR)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HANW')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHANW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IWIDTH
   54 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(IANS(I),I=1,IWIDTH)
   55 FORMAT('IANS(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)IBROWS(1:80)
   86 FORMAT('IBROWS = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IHBURL(1:80)
   88 FORMAT('IHBURL = ',A80)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IF(
     1       (IHOST1.EQ.'SUN') .OR.
     1       (IHOST1.EQ.'CRAY' .AND. IOPSY1.EQ.'UNIX') .OR.
     1       (IHOST1.EQ.'CONV') .OR.
     1       (IHOST1.EQ.'SGI ') .OR.
     1       (IHOST1.EQ.'HP-9') .OR.
     1       (IHOST1.EQ.'AIX ') .OR.
     1       (IHOST1.EQ.'LINU') .OR.
     1       (IOPSY1.EQ.'UNIX'))GOTO199
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO199
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')GOTO199
  100 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** FROM DPHANW--WEB HANDBOOK CURRENTLY ONLY SUPPORTED ',
     1'UNIX OR IBM-PC WINDOW 95/NT PLATFORMS.')
  199 CONTINUE
C
C               **********************************************************
C               **  STEP 21--                                           **
C               **  COPY OVER THE FIRST 4 WORDS AFTER THE WORDS WEB HANDBOOK**
C               **********************************************************
C
      IPASS=0
 1000 CONTINUE
      IPASS=IPASS+1
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPASS.LE.1)THEN
         IF(NUMARG.GE.1)IWORD1=IHARG(1)
         IF(NUMARG.GE.1)IWOR12=IHARG2(1)
         IF(NUMARG.GE.2)IWORD2=IHARG(2)
         IF(NUMARG.GE.3)IWORD3=IHARG(3)
         IF(NUMARG.GE.4)IWORD4=IHARG(4)
         NUMAR2=NUMARG
      ENDIF
C
      IF(NUMAR2.LE.0)THEN
         NUMAR2=1
         IWORD1='HOME'
         IWOR12='PAGE'
      ENDIF
C
      IF(IWORD1.EQ.'HOME'.AND.IWOR12.EQ.'PAGE')GOTO5099
C
C             ********************************************************
C             **  STEP 22--                                         **
C             **  STRIP OUT THE FIRST CHARACTER OF THE FIRST WORD.  **
C             ********************************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HANW')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICHAR1=IWORD1(1:1)
C
C               *******************************
C               **  STEP 32--                **
C               **  COPY OVER FILE VARIABLES **
C               *******************************
C
      ISTEPN='32'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 3210 CONTINUE
      IOUNIT=IHHBNU
      IFILE=IHHBNA
      ISTAT=IHHBST
      IFORM=IHHBFO
      IACCES=IHHBAC
      IPROT=IHHBPR
      ICURST=IHHBCS
      ISUBN0='HANW'
      IERRFI='NO'
C
 3291 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HANW')GOTO3299
      WRITE(ICOUT,3293)IOUNIT
 3293 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3294)IFILE
 3294 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3295)ISTAT,IFORM,IACCES,IPROT,ICURST
 3295 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3296)IBUGS2,ISUBRO,ISUBN0,IERRFI
 3296 FORMAT('IBUGS2,ISUBRO,ISUBN0,IERRFI = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 3299 CONTINUE
C
C               ****************************************
C               **  STEP 33--                         **
C               **  CHECK TO SEE IF HELP FILE EXISTS  **
C               ****************************************
C
      ISTEPN='33'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HANW')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO3300
      GOTO3390
 3300 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3311)
 3311 FORMAT('***** ERROR IN DPHANW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3312)
 3312 FORMAT('      THE DESIRED HANDBOOK INFORMATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3313)
 3313 FORMAT('      CANNOT BE GIVEN BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3314)
 3314 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3315)
 3315 FORMAT('      WHICH STORES SUCH HANDBOOK INFORMATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3316)
 3316 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3317)ISTAT,IHHBST
 3317 FORMAT('ISTAT,IHELST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3318)IFILE(1:50)
 3318 FORMAT('IFILE(1:50) = ',A50)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 3390 CONTINUE
C
C               *********************
C               **  STEP 34--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='34'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ******************************************************
C               **  STEP 52.1--                                     **
C               **  LOOP THROUGH THE VARIOUS LINES OF THIS SECTION  **
C               **  OF THE FILE.                                    **
C               ******************************************************
C
 5099 CONTINUE
      ISTEPN='52.1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICALL=' '
      DO5100I=MAXBRO,1,-1
         NUMBRO=I
         IF(IBROWS(I:I).NE.' ')GOTO5109
 5100 CONTINUE
 5109 CONTINUE
      IF(NUMBRO.GT.0)THEN
        ICALL(1:NUMBRO)=IBROWS(1:NUMBRO)
        NCSTR=NUMBRO+1
        ICALL(NCSTR:NCSTR)=' '
      ELSE
        ICALL(1:9)='netscape '
        NCSTR=9
      ENDIF
C
      IBRWFL='NETS'
      IF(NUMBRO.GE.8)THEN
        DO5125I=1,NUMBRO-7
          IF(IBROWS(I:I+7).EQ.'IEXPLORE' .OR.
     1       IBROWS(I:I+7).EQ.'iexplore')THEN
             IBRWFL='IEXP'
             GOTO5128
          ENDIF
 5125   CONTINUE
 5128   CONTINUE
      ENDIF
C
      NUMURL=NCHURL
C
C  IF "SET NETSCAPE OLD" COMMAND WAS ENTERED, THEN USE 
C  -remote NETSCAPE OPTION.  THIS ONLY APPLIES TO UNIX PLATFORMS.
C
      IF(IHOST1.EQ.'IBM-')THEN
        IF(IBRWFL.EQ.'NETS')THEN
          NCSTR=NCSTR+1
          NCSTR2=NCSTR+3
          ICALL(NCSTR:NCSTR2)=' -h '
          NCSTR=NCSTR2
        ENDIF
        GOTO5129 
      ENDIF
      IF(INETSW.EQ.'OLD'.AND.IHOST1.NE.'IBM-')THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+8
        ICALL(NCSTR:NCSTR2)=' -remote '
        NCSTR=NCSTR2+1
        ICALL(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+7
        ICALL(NCSTR:NCSTR2)='openURL('
        NCSTR=NCSTR2
      ENDIF
C
 5129 CONTINUE
      IF(NUMURL.GT.0)THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+NUMURL-1
        ICALL(NCSTR:NCSTR2)=IHBURL(1:NUMURL)
        N1URL=NCSTR
        N2URL=NCSTR2
        NCSTR=NCSTR2
      ELSE
        NCSTR=NCSTR+1
        N1URL=NCSTR
        NCSTR2=NCSTR+6
        ICALL(NCSTR:NCSTR2)='http://'
        NCSTR=NCSTR2
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+16
        ICALL(NCSTR:NCSTR2)='www.itl.nist.gov/'
        NCSTR=NCSTR2
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+19
        ICALL(NCSTR:NCSTR2)='itl/div898/handbook/'
        NCSTR=NCSTR2
        N2URL=NCSTR2
      ENDIF
C
      IF(IWORD1.EQ.'HOME'.AND.IWOR12.EQ.'PAGE')GOTO5300
      DO5200I=1,100000
      ILINE1=' '
      ILINE2=' '
      I2=I
C
C               *****************************************
C               **  STEP 52.2--                        **
C               **  READ IN SUCCEEDING LINES UNTIL     **
C               **  GET A HIT BASED ON THE FIRST WORD  **
C               **  OF THE COMMAND.                    **
C               *****************************************
C
      ISTEPN='52.2'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      READ(IOUNIT,5202,END=5280)ILINE1,ILINE2
 5202 FORMAT(A40,A40)
      IF(ILINE1(1:4).EQ.'    ')GOTO5200
C
      ICTEST=' '
      ICTES2=' '
      NBLANK=41
      DO5203II=1,40
        IF(ILINE1(II:II).EQ.' '.OR.ILINE1(II:II).EQ.'-')THEN
          NBLANK=II
          GOTO5204
        ENDIF
 5203 CONTINUE
 5204 CONTINUE
      IF(NBLANK.LE.5)THEN
        ICTEST(1:NBLANK-1)=ILINE1(1:NBLANK-1)
      ELSE
        NLAST=NBLANK
        IF(NLAST.GT.9)NLAST=9
        ICTEST(1:4)=ILINE1(1:4)
        ICTES2(1:NLAST-5)=ILINE1(5:NLAST-1)
      ENDIF
C
      IF(ICTEST.NE.IWORD1)GOTO5200
CCCC  IF(ICTES2.NE.' '.AND.ICTES2.NE.IWOR12)GOTO5200
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HANW')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5206)I,ILINE1(1:40)
 5206    FORMAT('I,ILINE1(1:40)=',I8,2X,A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5207)I,ILINE2(1:40)
 5207    FORMAT('I,ILINE2(1:40)=',I8,2X,A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5208)NUMARG,NUMAR2,IWORD1,IWOR12,ICTEST,ICTES2
 5208    FORMAT('NUMARG,NUMAR2,IWORD1,IWOR12,ICTEST,ICTES2 = ',
     1   I8,I8,2X,A4,2X,A4,2X,A4,2x,A4)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***********************************************
C               **  STEP 52.3--                              **
C               **  IF GOT A HIT ON THE FIRST 4-CHAR. WORD,  **
C               **  CHECK FOR A HIT ON ALL 4-CHAR WORDS      **
C               ***********************************************
C
CCCCC FIX A FEW SMALL BUGS IN THIS SECTION.  AUGUST 1999.
CCCCC 1) TREAT HYPHEN AS SPACE
CCCCC 2) VALUES OF ILOCP2, ILOCP3, ILOCP4 IF LESS THAN 3 CHARACTERS
C
      ISTEPN='52.3'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HANW')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NSTRT=NBLANK
      NUMWHF=1
      IZ1(1:4)=ICTEST(1:4)
      IZ2=' '
      IZ3=' '
      IZ4=' '
C
C  LOOK FOR SECOND WORD
C
      DO5212II=NBLANK,40
        IF(ILINE1(II:II).NE.' '.AND.ILINE1(II:II).NE.'-')THEN
          NSTRT=II
          DO5214J=II,40
            IF(ILINE1(J:J).EQ.' '.OR.ILINE1(J:J).EQ.'-')THEN
              NLAST=J-1
              GOTO5219
            ENDIF
 5214     CONTINUE
        ENDIF
 5212 CONTINUE
      NLAST=0
 5219 CONTINUE
      IF(NLAST.LE.0)GOTO5270
      NUMWHF=2
      NCH=NLAST-NSTRT+1
      IF(NCH.GT.4)NCH=4
      IZ2(1:NCH)=ILINE1(NSTRT:NSTRT+NCH-1)
      NBLANK=NLAST+1
      IF(NBLANK.GE.40)GOTO5270
C
C  LOOK FOR THIRD WORD
C
      DO5222II=NBLANK,40
        IF(ILINE1(II:II).NE.' '.AND.ILINE1(II:II).NE.'-')THEN
          NSTRT=II
          DO5224J=II,40
            IF(ILINE1(J:J).EQ.' '.OR.ILINE1(J:J).EQ.'-')THEN
              NLAST=J-1
              GOTO5229
            ENDIF
 5224     CONTINUE
        ENDIF
 5222 CONTINUE
      NLAST=0
 5229 CONTINUE
      IF(NLAST.LE.0)GOTO5270
      NUMWHF=3
      NCH=NLAST-NSTRT+1
      IF(NCH.GT.4)NCH=4
      IZ3(1:NCH)=ILINE1(NSTRT:NSTRT+NCH-1)
      NBLANK=NLAST+1
      IF(NBLANK.GE.40)GOTO5270
C
C  LOOK FOR FOURTH WORD
C
      DO5232II=NBLANK,40
        IF(ILINE1(II:II).NE.' '.AND.ILINE1(II:II).NE.'-')THEN
          NSTRT=II
          DO5234J=II,40
            IF(ILINE1(J:J).EQ.' '.OR.ILINE1(J:J).EQ.'-')THEN
              NLAST=J-1
              GOTO5239
            ENDIF
 5234     CONTINUE
        ENDIF
 5232 CONTINUE
      NLAST=0
 5239 CONTINUE
      IF(NLAST.LE.0)GOTO5270
      NUMWHF=4
      NCH=NLAST-NSTRT+1
      IF(NCH.GT.4)NCH=4
      IZ4(1:NCH)=ILINE1(NSTRT:NSTRT+NCH-1)
      NBLANK=NLAST+1
      IF(NBLANK.GE.40)GOTO5270
C
 5270 CONTINUE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HANW')THEN
         WRITE(ICOUT,5241)
 5241    FORMAT('***** FROM 1731 IN MIDDLE OF DPHANW--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5242)IWORD1,IWOR12,IWORD2,IWORD3,IWORD4
 5242    FORMAT('IWORD1,IWOR12,IWORD2,IWORD3,IWORD4 = ',
     1   A4,2X,A4,2X,A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5243)ILINE1(1:40)
 5243    FORMAT('ILINE1(1:40) = ',A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5244)IZ1,IZ2,IZ3,IZ4
 5244    FORMAT('IZ1,IZ2,IZ3,IZ4 = ',A4,2X,A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5245)ISTRIN
 5245    FORMAT('ISTRIN = ',A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5246)NUMARG,NUMAR2,NUMWHF
 5246    FORMAT('NUMARG,NUMAR2,NUMWHF = ',3I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5247)ILOC2,ILOC3,ILOC4
 5247    FORMAT('ILOC2,ILOC3,ILOC4 = ',3I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5248)ILOC2P,ILOC3P,ILOC4P
 5248    FORMAT('ILOC2P,ILOC3P,ILOC4P = ',3I8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1994
      IF(NUMAR2.NE.NUMWHF)GOTO5200
C
 5252 CONTINUE
      IF(NUMAR2.LE.1)GOTO5290
      IF(NUMWHF.LE.1)GOTO5290
C
      IF(IZ2.EQ.IWORD2)GOTO5253
C
      GOTO5200
C
 5253 CONTINUE
      IF(NUMAR2.LE.2)GOTO5290
      IF(NUMWHF.LE.2)GOTO5290
C
      IF(IZ3.EQ.IWORD3)GOTO5254
C
      GOTO5200
C
 5254 CONTINUE
      IF(NUMAR2.LE.3)GOTO5290
      IF(NUMWHF.LE.3)GOTO5290
C
      IF(IZ4.EQ.IWORD4)GOTO5290
C
 5200 CONTINUE
C
 5280 CONTINUE
      IERROR='YES'
CCCCC ONLY ONE PASS MADE.  FEBRUARY 2000.
CCCCC IF(IPASS.GE.2)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5281)
 5281    FORMAT('***** ERROR IN DPHANW--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5282)
 5282    FORMAT('      THE SPECIFIED COMMAND FOR WHICH')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5283)
 5283    FORMAT('      WEB HANDBOOK WAS DESIRED WAS NOT FOUND')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5284)
 5284    FORMAT('      IN THE HELP FILE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5285)
 5285    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5286)(IANS(I),I=1,IWIDTH)
 5286    FORMAT('      ',120A1)
         CALL DPWRST('XXX','BUG ')
CCCCC ENDIF
      GOTO6100
C
 5290 CONTINUE
C
C               ****************************************************
C               **  STEP 53--                                     **
C               **  IF HAVE A HIT ON ALL WORDS,                   **
C               **  THEN USE DPSYS2 TO MAKE A SYSTEM CALL         **
C               **  TO INIATE NETSCAPE.                           **
C               **  CHECK IF URL BEGINS WITH http (A FEW SPECIAL  **
C               **  CASES GO TO NON-DATAPLOT WEB PAGE             **
C               ****************************************************
C
 5300 CONTINUE
      ISTEPN='53'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HANW')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IWORD1.EQ.'HOME'.AND.IWOR12.EQ.'PAGE')THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+12
        ICALL(NCSTR:NCSTR2)='homepage.html'
        NCSTR=NCSTR2
        GOTO5349
      ENDIF
C
      DO5330J=40,1,-1
        NTEMP=J
        IF(ILINE2(J:J).NE.' ')GOTO5339
 5330 CONTINUE
 5339 CONTINUE
      IF(NTEMP.LE.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5351)
        CALL DPWRST('XXX','BUG ')
        ILINE2(1:13)='homepage.html'
        NTEMP=13
      ENDIF
 5351 FORMAT('***** WARNING: NO MATCH FOUND, DEFAULT TO HANDBOOK ',
     1'HOME PAGE.')
C
C  ABSOLUTE URL ADDRESS FOUND
C
      IF(ILINE2(1:5).EQ.'http:')THEN
        ICALL(N1URL:N2URL)=' '
        NCSTR=N1URL-1
      ENDIF
C
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+NTEMP-1
      ICALL(NCSTR:NCSTR2)=ILINE2(1:NTEMP)
      NCSTR=NCSTR2
 5349 CONTINUE
      IF(INETSW.EQ.'OLD'.AND.IHOST1.NE.'IBM-')THEN
        NCSTR=NCSTR+1
        ICALL(NCSTR:NCSTR)=')'
        NCSTR=NCSTR+1
        ICALL(NCSTR:NCSTR)=IQUOTE
      ENDIF
      IF(IHOST1.NE.'IBM-')THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+1
        ICALL(NCSTR:NCSTR2)=' &'
        NCSTR=NCSTR2
      ENDIF
C
      IF(INETSW.EQ.'NEW')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5411)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IHOST1.NE.'IBM-')THEN
          WRITE(ICOUT,5412)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5413)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5414)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5415)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
 5411 FORMAT('*****NOTE: IT MAY TAKE THE BROWSER A FEW MOMENTS TO ',
     1      'START UP.')
 5412 FORMAT('     IF YOU ARE USING THE NETSCAPE BROWSER, YOU CAN ',
     1       'SPEED UP SUBSEQUENT')
 5413 FORMAT('     USE OF WEB HANDBOOK BY ENTERING THE FOLLOWING ',
     1       'DATAPLOT COMMAND')
 5414 FORMAT('     (LEAVE THE BROWSER OPEN):')
 5415 FORMAT('         SET NETSCAPE OLD')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HANW')THEN
         WRITE(ICOUT,5441)NCSTR
 5441    FORMAT('AT CALL DPSYS2, NCSTR = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5443)ICALL(1:100)
 5443    FORMAT('ICALL(1:100)=',A100)
         CALL DPWRST('XXX','BUG ')
      ENDIF
CCCCC CLOSE FILE BEFORE CALL DPSYS2.  SEEMS TO CAUSE A PROBLEM ON
CCCCC RS-6000.  FEBRUARY 2000.
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERRO2)
      IF(IERRFI.EQ.'YES')GOTO9000
      CALL DPSYS2(ICALL,NCSTR,ISUBRO,IERROR)
      GOTO9000
C
C               **************************************
C               **  STEP 61--                       **
C               **  CLOSE           THE HELP FILE.  **
C               **************************************
C
 6100 CONTINUE
C
      ISTEPN='61'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IWORD1.EQ.'HOME'.AND.IWOR12.EQ.'PAGE')GOTO6199
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERRO2)
      IF(IERRFI.EQ.'YES')GOTO9000
 6199 CONTINUE
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HANW')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHANW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR,IERRO2
 9012 FORMAT('IBUGS2,ISUBRO,IERROR,IERRO2 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGS2,IFOUND,IERROR
 9028 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IOUNIT
 9031 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IFILE
 9032 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)ISTAT
 9033 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IFORM
 9034 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IACCES
 9035 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IPROT
 9036 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)ICURST
 9037 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)IENDFI
 9038 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IREWIN
 9039 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)ISUBN0
 9041 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IERRFI
 9042 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IWORD1,IWORD2,ICHAR1
 9043 FORMAT('IWORD1,IWORD2,ICHAR1 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9060)ILINE1(1:40),ICTEST,IWORD1,IWOR12
 9060 FORMAT('ILINE1(1:40),ICTEST,IWORD1,IWOR12=',A30,2X,A4,A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)NUMSEC,NUMLIN,ISECNA
 9061 FORMAT('NUMSEC,NUMLIN,ISECNA = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)NUMARG,NUMAR2
 9062 FORMAT('NUMARG,NUMAR2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9063)IWORD1,IWORD2,IWORD3,IWORD4,IWOR12
 9063 FORMAT('IWORD1,IWORD2,IWORD3,IWORD4,IWOR12 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9064)ILINE1(1:40)
 9064 FORMAT('ILINE1(1:40) = ',A40)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9065)IZ1,IZ2,IZ3,IZ4
 9065 FORMAT('IZ1,IZ2,IZ3,IZ4 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9066)ISTRIN
 9066 FORMAT('ISTRIN = ',A40)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9067)NUMWHF
 9067 FORMAT('NUMWHF = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9068)ILOC2,ILOC3,ILOC4
 9068 FORMAT('ILOC2,ILOC3,ILOC4 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9069)ILOC2P,ILOC3P,ILOC4P
 9069 FORMAT('ILOC2P,ILOC3P,ILOC4P = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9071)ICHAR1
 9071 FORMAT('ICHAR1 = ',A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9077)I2
 9077 FORMAT('I2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9079)IBUGS2,ISUBRO,IERROR
 9079 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9093)IERROR,IERRO2,IPASS
 9093 FORMAT('IERROR,IERRO2,IPASS = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9095)IWORD1,IWOR12,IWORD2
 9095 FORMAT('IWORD1,IWOR12,IWORD2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9096)IWORD3,IWORD4
 9096 FORMAT('IWORD3,IWORD4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9097)IBROWS(1:80)
 9097 FORMAT('IBROWS = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9097)IHBURL(1:80)
 9098 FORMAT('IHBURL = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9099)ICALL(1:256)
 9099 FORMAT('ICALL = ',A256)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHAPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1ICOPSW,NUMCOP,IFOUND,IERROR)
C
C     PURPOSE--TURN ON THE LOCAL HARDCOPY DEVICE
C              AND DEFINE THE NUMBER OF DESIRED COPIES.
C              THE POWER STATUS OF THE LOCAL HARDCOPY WILL BE
C              PLACED IN THE CHARACTER VARIABLE ICOPSW (ON/OFF).
C              THE NUMBER OF COPIES TO BE MADE WILL BE
C              PLACED IN THE INTEGER VARIABLE NUMCOP.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IHARG2 (A CHARACTER VECTOR)
C                     --IARGT  (A CHARACTER VECTOR)
C                     --IARG   (A CHARACTER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--ICOPSW (A CHARACTER VECTOR
C                              WHICH CONTAINS THE
C                              POWER (ON/OFF) FOR THE LOCAL HARDCOPY UNIT.
C                     --NUMCOP (AN INTEGER VARIABLE
C                              WHICH CONTAINS THE NUMBER OF COPIES
C                              TO BE MADE.
C                     --IFOUND ('YES' OR 'NO')
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 ICOPSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IDEV
      CHARACTER*4 IHOLD1
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
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
      IDEV='HARD'
C
 1150 CONTINUE
      IF(NUMARG.LE.0)GOTO1160
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ON')GOTO1160
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'OFF')GOTO1161
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO')GOTO1160
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DEFA')GOTO1161
      IF(NUMARG.EQ.1.AND.IARGT(1).EQ.'NUMB')GOTO1162
C
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'ON'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1163
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'OFF'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1161
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'AUTO'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1163
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'DEFA'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1161
C
      GOTO1199
C
 1160 CONTINUE
      IHOLD1='ON'
      IHOLD2=1
      GOTO1180
C
 1161 CONTINUE
      IHOLD1='OFF'
      IHOLD2=-1
      GOTO1180
C
 1162 CONTINUE
      IHOLD1='ON'
      IHOLD2=IARG(1)
      GOTO1180
C
 1163 CONTINUE
      IHOLD1='ON'
      IHOLD2=IARG(2)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ICOPSW=IHOLD1
      NUMCOP=IHOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IHOLD1
 1181 FORMAT('THE LOCAL HARDCOPY HAS JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
      IF(ICOPSW.EQ.'ON'.AND.NUMCOP.EQ.1)WRITE(ICOUT,1182)NUMCOP
 1182 FORMAT('    (WITH ',I3,' HARDCOPY   PER PLOT)')
      IF(ICOPSW.EQ.'ON'.AND.NUMCOP.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(ICOPSW.EQ.'ON'.AND.NUMCOP.GE.2)WRITE(ICOUT,1183)NUMCOP
 1183 FORMAT('    (WITH ',I3,' HARDCOPIES PER PLOT)')
      IF(ICOPSW.EQ.'ON'.AND.NUMCOP.GE.2)CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPHAZA(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM,
     1IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A NORMAL/LOGNORMAL/EXPONENTIAL/WEIBULL/GUMBEL HAZARD PLOT
C     EXAMPLE--LOGNORMAL HAZARD PLOT Y
C              LOGNORMAL HAZARD PLOT Y TAG
C     NOTE--THIS COMMAND CAN HAVE 1 OR 2 ARGUMENTS.
C           ARGUMENT 1 IS THE RESPONSE VARIABLE
C           IF THE HAZARD PLOT COMMAND HAS ONLY
C           1 ARGUMENT, THEN IT IS ASSUMED THAT ALL
C           OF THE DATA IS TO BE INCLUDED
C           (THAT IS, NO CENSORING).
C     NOTE--SOMETIMES THIS COMMAND HAS 2 ARGUMENTS--
C           ARGUMENT 1 IS THE RESPONSE VARIABLE
C           ARGUMENT 2 IS THE CENSOR-TAG VARIABLE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998. THIS IMPLEMENTATION NOT WORKING
C     UPDATED         --JANUARY   2006. CORRECT IMPLEMENTATION
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IX2TSC
      CHARACTER*4 IY1TSC
      CHARACTER*4 IY2TSC
C
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
C
      CHARACTER*4 IX1ZFM
      CHARACTER*4 IX2ZFM
      CHARACTER*4 IY1ZFM
      CHARACTER*4 IY2ZFM
C
      CHARACTER*4 IX1ZSV
      CHARACTER*4 IX2ZSV
      CHARACTER*4 IY1ZSV
      CHARACTER*4 IY2ZSV
C
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHO.INC'
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      DIMENSION YS(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),YS(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPHA'
      ISUBN2='ZA  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      SIGMA=(-999.0)
      AMU=(-999.0)
      SDSIGM=(-999.0)
      SDAMU=(-999.0)
      BPT1=(-999.0)
      BPT5=(-999.0)
      B1=(-999.0)
      B5=(-999.0)
      B10=(-999.0)
      B20=(-999.0)
      B50=(-999.0)
      B80=(-999.0)
      B90=(-999.0)
      B95=(-999.0)
      B99=(-999.0)
      B995=(-999.0)
      B999=(-999.0)
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED   APRIL 1992
      ICUTMX=NUMBPW
      IF(IHOST1.EQ.'CDC '.OR.IHOST1.EQ.'CYBE')ICUTMX=48
      IF(IHOST1.EQ.'205 ')ICUTMX=48
      CUTOFF=2**(ICUTMX-3)
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPHAZA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPLOTV,NPLOTP,NS
   52   FORMAT('NPLOTV,NPLOTP,NS = ',3I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53   FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)IANGLU,IBUGG2,IBUGG3,IBUGQ
   54   FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGQ = ',
     1         A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,56)ICASPL,MAXN
   56   FORMAT('ICASPL,MAXN = ',A4,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,57)IFOUND,IERROR
   57   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,58)MAXNPP
   58   FORMAT('MAXNPP = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,61)IX1TSC,IX2TSC,IY1TSC,IY2TSC
   61   FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,62)IX1TSV,IX2TSV,IY1TSV,IY2TSV
   62   FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***********************************
C               **  TREAT THE HAZARD  PLOT CASE  **
C               ***********************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'PLOT')GOTO1111
      GOTO9000
C
 1111 CONTINUE
      ILASTC=2
      IF(ICOM.EQ.'NORM')THEN
        ICASPL='NHAZ'
      ELSEIF(ICOM.EQ.'LOGN')THEN
        ICASPL='LHAZ'
      ELSEIF(ICOM.EQ.'EXPO')THEN
        ICASPL='EHAZ'
      ELSEIF(ICOM.EQ.'WEIB')THEN
        ICASPL='WHAZ'
      ELSEIF(ICOM.EQ.'GUMB')THEN
        ICASPL='GHAZ'
      ELSEIF(ICOM.EQ.'EXTR'.AND.IHARG(1).EQ.'VALU')THEN
        ICASPL='GHAZ'
        ILASTC=3
      ELSE
        GOTO9000
      ENDIF
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      IFOUND='YES'
C
C               *****************************************************
C               **  STEP 12--                                      **
C               **  CARRY OUT A GENERAL CHECK FOR THE              **
C               **  PROPER NUMBER OF INPUT ARGUMENTS               **
C               **  (IT SHOULD BE 1 OR 2).                         **
C               *****************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'HAZA')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               *****************************************************
C               **  STEP 14--                                      **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE             **
C               **  PROPER NUMBER OF INPUT ARGUMENTS               **
C               **  (IT SHOULD BE 1 OR 2).                         **
C               *****************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.GT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1411)
 1411   FORMAT('***** ERROR IN HAZARD PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1412)
 1412   FORMAT('      FOR A HAZARD PLOT, THE NUMBER OF VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1419)
 1419   FORMAT('      MUST BE EITHER 1 OR 2;  SUCH WAS NOT THE ',
     1         'CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1422)NUMVAR
 1422   FORMAT('      THE SPECIFIED NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1423)
 1423   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1424)(IANS(I),I=1,MIN(80,IWIDTH))
 1424     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************************
C               **  STEP 15--                                       *
C               **  EXAMINE THE VARIABLES--                         *
C               **  HAS EACH VARIABLE                               *
C               **  ALREADY BEEN DEFINED?                           *
C               **  NOTE THAT     ILISR1, ILISR2,                   *
C               **  IS THE LINE IN THE TABLE                        *
C               **  OF THE FIRST, SECOND                VARIABLE    *
C               **  RESPECTIVELY.                                   *
C               **  NOTE THAT     ICOLR1, ICOLR2,                   *
C               **  IS THE DATA COLUMN (1 TO 10+6)                  *
C               **  OF THE FIRST, SECOND                VARIABLE    *
C               **  RESPECTIVELY.                                   *
C               *****************************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      IF(NUMVAR.LE.1)GOTO1590
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN HAZARD PLOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2,IHRIX1,IHRIX2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST, BUT AS ',
     1       'A PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,MIN(80,IWIDTH))
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN HAZARD PLOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2,IHRIX1,IHRIX2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,1579)(IANS(I),I=1,MIN(80,IWIDTH))
 1579   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  CHECK THAT VARIABLES 1 AND 2       HAVE         **
C               **  THE SAME NUMBER OF ELEMENTS.                    **
C               ******************************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.EQ.2.AND.(NIRIG1.NE.NIRIG2))THEN
        WRITE(ICOUT,2111)
 2111   FORMAT('***** ERROR IN HAZARD PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2113)
 2113   FORMAT('      THE NUMBER OF OBSERVATIONS IN VARIABLES 1 AND 2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2114)
 2114   FORMAT('      MUST BE THE SAME;  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1
 2116   FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1         ' OBSERVATIONS;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2
 2117   FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1         ' OBSERVATIONS;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2120)
 2120   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2121)(IANS(I),I=1,MIN(100,IWIDTH))
 2121     FORMAT('      ',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3251)
 3251   FORMAT('***** ERROR IN HAZARD PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3252)
 3252   FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1         'EXTRACTED,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3254)IHRI11,IHRI12
 3254   FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1         'FROM VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3255)
 3255   FORMAT('      (FOR WHICH A HAZARD PLOT IS TO BE FORMED)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3257)MINN2
 3257   FORMAT('      MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3258)NQ
 3258   FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3259)
 3259   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,3260)(IANS(I),I=1,MIN(80,IWIDTH))
 3260     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE RESPONSE VARIABLE              **
C               **       THE CENSOR-TAG VARIABLE            **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')THEN
        WRITE(ICOUT,780)N,NIRIG1,NQ,IMAX
  780   FORMAT(' N,NIRIG1,NQ,IMAX = ',4I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      DO3300I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3300
      J=J+1
C
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IF(NUMVAR.LE.1)THEN
        Y2(J)=1.0
      ELSE
        IJ=MAXN*(ICOLR2-1)+I
        IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
        IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
        IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
        IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
        IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
        IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
        IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
      ENDIF
C
 3300 CONTINUE
      NS=J
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')THEN
        WRITE(ICOUT,776)J,NS
  776   FORMAT('J,NS = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT THE            **
C               **  COMBINATION OF CENSORING AND           **
C               **  SUBSETTING DOES NOT RESULT IN          **
C               **  TOO FEW DATA POINTS RESULTING          **
C               **  (AT LEAST 2)                           **
C               **  WITH WHICH TO FORM A NORMAL PLOT.      **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUNT=0
      IF(NS.LE.2)THEN
        ICOUNT=NS
      ELSE
        DO3400I=1,NS
          IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUNT=ICOUNT+1
 3400   CONTINUE
      ENDIF
C
      IF(ICOUNT.LE.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3451)
 3451   FORMAT('***** ERROR IN HAZARD PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3452)
 3452   FORMAT('      AFTER THE SPECIFIED CENSORING AND SUBSETTING ',
     1         'HAS BEEN PERFORMED,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3454)IHRI11,IHRI12
 3454   FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING FROM ',
     1         'VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3455)
 3455   FORMAT('      (FOR WHICH A HAZARD PLOT IS TO BE FORMED)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3457)MINN2
 3457   FORMAT('      MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3458)ICOUNT
 3458   FORMAT('      SUCH WAS NOT THE CASE HERE (ICOUNT = ',I8,')')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3459)
 3459   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,3460)(IANS(I),I=1,MIN(80,IWIDTH))
 3460     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************************
C               **  STEP 41--                                       *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS           *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE *
C               **  PLOT FORM THE CURVE DESIGNATION VARIABLE D(.) . *
C               **  THIS WILL BE BOTH ONES FOR BOTH CASES           *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).   *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).   *
C               *****************************************************
C
      ISTEPN='41'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HAZA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPHAZ2(Y1,Y2,NS,ICASPL,MAXN,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM,
     1IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1SIGMA,AMU,SDSIGM,SDAMU,
     1BPT1,BPT5,B1,B5,B10,B20,B50,B80,B90,B95,B99,B995,B999,
     1Y,X,D,NPLOTP,NPLOTV,
     1YS,
     1IBUGG3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 51--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='51'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      DO5100IPASS=1,17
      IF(IPASS.EQ.1)IH='SIGM'
      IF(IPASS.EQ.1)IH2='A   '
      IF(IPASS.EQ.2)IH='MU'
      IF(IPASS.EQ.2)IH2='    '
      IF(IPASS.EQ.3)IH='SDSI'
      IF(IPASS.EQ.3)IH2='GMA '
      IF(IPASS.EQ.4)IH='SDET'
      IF(IPASS.EQ.4)IH2='A   '
C
      IF(IPASS.EQ.5)IH='BPT1'
      IF(IPASS.EQ.5)IH2='    '
      IF(IPASS.EQ.6)IH='BPT5'
      IF(IPASS.EQ.6)IH2='    '
      IF(IPASS.EQ.7)IH='B1  '
      IF(IPASS.EQ.7)IH2='    '
      IF(IPASS.EQ.8)IH='B5  '
      IF(IPASS.EQ.8)IH2='    '
      IF(IPASS.EQ.9)IH='B10 '
      IF(IPASS.EQ.9)IH2='    '
      IF(IPASS.EQ.10)IH='B20 '
      IF(IPASS.EQ.10)IH2='    '
      IF(IPASS.EQ.11)IH='B50 '
      IF(IPASS.EQ.11)IH2='    '
      IF(IPASS.EQ.12)IH='B80 '
      IF(IPASS.EQ.12)IH2='    '
      IF(IPASS.EQ.13)IH='B90 '
      IF(IPASS.EQ.13)IH2='    '
      IF(IPASS.EQ.14)IH='B95 '
      IF(IPASS.EQ.14)IH2='    '
      IF(IPASS.EQ.15)IH='B99 '
      IF(IPASS.EQ.15)IH2='    '
      IF(IPASS.EQ.16)IH='B995'
      IF(IPASS.EQ.16)IH2='    '
      IF(IPASS.EQ.17)IH='B999'
      IF(IPASS.EQ.17)IH2='    '
      DO5150I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO5180
 5150 CONTINUE
      IF(NUMNAM.LT.MAXNAM)GOTO5170
      WRITE(ICOUT,5151)
 5151 FORMAT('***** ERROR IN DPHAZA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5152)
 5152 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5153)MAXNAM
 5153 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5154)
 5154 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5155)
 5155 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5156)
 5156 FORMAT('      HAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5157)
 5157 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5158)
 5158 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5159)
 5159 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5160)
 5160 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5161)
 5161 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5162)
 5162 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5163)(IANS(I),I=1,IWIDTH)
 5163 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 5170 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      IF(IPASS.EQ.1)VALUE(ILOC)=SIGMA
      IF(IPASS.EQ.2)VALUE(ILOC)=AMU
      IF(IPASS.EQ.3)VALUE(ILOC)=SDSIGM
      IF(IPASS.EQ.4)VALUE(ILOC)=SDAMU
      IF(IPASS.EQ.5)VALUE(ILOC)=BPT1
      IF(IPASS.EQ.6)VALUE(ILOC)=BPT5
      IF(IPASS.EQ.7)VALUE(ILOC)=B1
      IF(IPASS.EQ.8)VALUE(ILOC)=B5
      IF(IPASS.EQ.9)VALUE(ILOC)=B10
      IF(IPASS.EQ.10)VALUE(ILOC)=B20
      IF(IPASS.EQ.11)VALUE(ILOC)=B50
      IF(IPASS.EQ.12)VALUE(ILOC)=B80
      IF(IPASS.EQ.13)VALUE(ILOC)=B90
      IF(IPASS.EQ.14)VALUE(ILOC)=B95
      IF(IPASS.EQ.15)VALUE(ILOC)=B99
      IF(IPASS.EQ.16)VALUE(ILOC)=B995
      IF(IPASS.EQ.17)VALUE(ILOC)=B999
      VAL=VALUE(ILOC)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(ILOC)=IVAL
      GOTO5100
C
 5180 CONTINUE
      IF(IPASS.EQ.1)VALUE(I2)=SIGMA
      IF(IPASS.EQ.2)VALUE(I2)=AMU
      IF(IPASS.EQ.3)VALUE(I2)=SDSIGM
      IF(IPASS.EQ.4)VALUE(I2)=SDAMU
      IF(IPASS.EQ.5)VALUE(I2)=BPT1
      IF(IPASS.EQ.6)VALUE(I2)=BPT5
      IF(IPASS.EQ.7)VALUE(I2)=B1
      IF(IPASS.EQ.8)VALUE(I2)=B5
      IF(IPASS.EQ.9)VALUE(I2)=B10
      IF(IPASS.EQ.10)VALUE(I2)=B20
      IF(IPASS.EQ.11)VALUE(I2)=B50
      IF(IPASS.EQ.12)VALUE(I2)=B80
      IF(IPASS.EQ.13)VALUE(I2)=B90
      IF(IPASS.EQ.14)VALUE(I2)=B95
      IF(IPASS.EQ.15)VALUE(I2)=B99
      IF(IPASS.EQ.16)VALUE(I2)=B995
      IF(IPASS.EQ.17)VALUE(I2)=B999
      VAL=VALUE(I2)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(I2)=IVAL
      GOTO5100
C
 5100 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'ON'.AND.ISUBRO.EQ.'HAZA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPHAZA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IFOUND,IERROR
 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1         I8,I8,I8,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)ICASPL,MAXN,NUMVAR
 9014   FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015   FORMAT('NIRIG1,NIRIG2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016   FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
        CALL DPWRST('XXX','BUG ')
        IF(NPLOTP.GT.0)THEN
          DO9020I=1,NPLOTP
            WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
 9021       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
            CALL DPWRST('XXX','BUG ')
 9020     CONTINUE
        ENDIF
        WRITE(ICOUT,9031)ICOUNT
 9031   FORMAT('ICOUNT = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9041)IX1TSC,IX2TSC,IY1TSC,IY2TSC
 9041   FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9042)IX1TSV,IX2TSV,IY1TSV,IY2TSV
 9042   FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9043)SIGMA,AMU,SDSIGM,SDAMU
 9043   FORMAT('SIGMA,AMU,SDSIGM,SDAMU = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        DO9050I=1,NIRIG1
          WRITE(ICOUT,9051)I,Y1(I),Y2(I),ISUB(I)
 9051     FORMAT('I,Y1(I),Y2(I),ISUB(I) = ',I8,2E15.7,I8)
          CALL DPWRST('XXX','BUG ')
 9050   CONTINUE
        WRITE(ICOUT,9061)IHRI11,IHRI12
 9061   FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9062)IHRI21,IHRI22
 9062   FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPHAZ2(Y,TAGC,N,ICASPL,MAXN,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM,
     1IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1SIGMA,AMU,SDSIGM,SDAMU,
     1BPT1,BPT5,B1,B5,B10,B20,B50,B80,B90,B95,B99,B995,B999,
     1Y2,X2,D2,N2,NPLOTV,
     1YS,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A HAZARD PLOT.
C              THE PLOT WILL CONSIST OF 6 COMPONENTS--
C                  1) THE RAW DATA
C                  2) THE FITTED LINE
C                  3) THE HORIZONTAL 50% LINE
C                  4) THE VERTICAL   50% LINE
C                  5) 95% CONFIDENCE LIMITS
C                  6) 99% CONFIDENCE LIMITS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998. THIS IMPLEMENTATION REALLY NOT
C                                       CORRECT
C     UPDATED         --JANUARY   2006. INITIAL CORRECT IMPLEMENTATION
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IWRITE
c
      CHARACTER*4 IX1TSC
      CHARACTER*4 IX2TSC
      CHARACTER*4 IY1TSC
      CHARACTER*4 IY2TSC
C
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
C
      CHARACTER*4 IX1ZFM
      CHARACTER*4 IX2ZFM
      CHARACTER*4 IY1ZFM
      CHARACTER*4 IY2ZFM
C
      CHARACTER*4 IX1ZSV
      CHARACTER*4 IX2ZSV
      CHARACTER*4 IY1ZSV
      CHARACTER*4 IY2ZSV
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DOUBLE PRECISION DTEMP
      DOUBLE PRECISION DPDF
      DOUBLE PRECISION DEPS
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION TAGC(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION YS(*)
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 DEPS /1.0D-16/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPHA'
      ISUBN2='Z2  '
C
      IERROR='NO'
C
      AN=N
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HAZ2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPHAZ2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGG3,ISUBRO
   52   FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICASPL,MAXN,N,NPLOTV
   53   FORMAT('ICASPL,MAXN,N,NPLOTV = ',A4,2X,I8,I8,I8)
        CALL DPWRST('XXX','BUG ')
        IF(N.GT.0)THEN
          DO60I=1,N
            WRITE(ICOUT,61)I,Y(I),TAGC(I)
   61       FORMAT('I,Y(I),TAGC(I) = ',I8,2E12.5)
            CALL DPWRST('XXX','BUG ')
   60     CONTINUE
        ENDIF
        WRITE(ICOUT,71)IX1TSC,IX2TSC,IY1TSC,IY2TSC
   71   FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)IX1TSV,IX2TSV,IY1TSV,IY2TSV
   72   FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,73)SIGMA,AMU,SDSIGM,SDAMU
   73   FORMAT('SIGMA,AMU,SDSIGM,SDAMU = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,74)BPT1,BPT5,B1,B5
   74   FORMAT('BPT1,BPT5,B1,B5 = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,75)B10,B20,B50,B80,B90
   75   FORMAT(' B10,B20,B50,B80,B90 = ',5E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,76)B95,B99,B995,B999
   76   FORMAT('B95,B99,B995,B999 = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1.1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HAZ2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN HAZARD PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 3.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1114)N
 1114   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1130I=1,N
        IF(Y(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN HAZARD PLOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      DO1140I=1,N
        IF(TAGC(I).NE.0.0)GOTO1149
 1140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN HAZARD PLOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      ALL INPUT TAG VARIABLE ELEMENTS ARE ',
     1       'IDENTICALLY EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      TO 0.0;  THUS THERE ARE NO RESPONSE VARIABLE ',
     1       'VALUES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1145)
 1145 FORMAT('      REMAINING UPON WHICH TO PERFORM A HAZARD ANALYSIS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1149 CONTINUE
C
C   THE FOLLOWING IS THE BASIC ALGORITHM FOR THE HAZARD PLOT:
C
C    1) SORT THE FAILURE AND CENSORING TIMES AND ASSIGN A REVERSE
C       RANK, K, TO EACH VALUE
C    2) COMPUTE THE CUMULATIVE HAZARD FOR EACH FAILURE TIME
C       A) HAZARD = 100/K
C       B) CUMULTIVE HAZARD = SUM OF HAZARDS UP TO AND INCLUDING
C          THE CURRENT FAILURE
C    3) PLOT TIME ON THE VERTICAL AXIS AND THE CUMULATIVE HAZARD
C       (OR SOME FUNCTION OF THE CUMULATIVE HAZARD) ON THE HORIZONTAL
C       AXIS
C    4) DEPENDING ON THE SPECIFIC DISTRIBUTION, DETERMINE WHETHER
C       THE TIME AND CUMULATIVE HAZARD SCALES ARE LINEAR OR LOG
C
C   THE FOLLOWING ARE THE PLOT COORDINATES FOR THE SPECIFIC DISTRIBUTIONS:
C
C   1) EXPONENTIAL:
C      A) TIME IS PLOTTED ON A LINEAR SCALE
C      B) CUMULATIVE HAZARD IS PLOTTED ON A LINEAR SCALE
C
C   2) WEIBULL
C      A) TIME IS PLOTTED ON A LOG SCALE
C      B) CUMULATIVE HAZARD IS PLOTTED ON A LOG SCALE
C
C   3) EXTREME VALUE (GUMBEL)
C      A) TIME IS PLOTTED ON A LINEAR SCALE
C      B) CUMULATIVE HAZARD IS PLOTTED ON A LOG SCALE
C
C   4) NORMAL
C      A) TIME IS PLOTTED ON A LINEAR SCALE
C      B) NORPPF(1 - EXP(-H)) IS PLOTTED ON A LINEAR SCALE
C         WHERE H IS THE CUMULATIVE HAZARD VALUE
C
C   5) LOGNORMAL
C      A) TIME IS PLOTTED ON A LOG SCALE
C      B) NORPPF(1 - EXP(-H)) IS PLOTTED ON A LINEAR SCALE
C         WHERE H IS THE CUMULATIVE HAZARD VALUE
C
C               ***********************************************
C               **  STEP 21--                                **
C               **  SORT THE DATA AND CARRY ALONG THE TAG    **
C               ***********************************************
C
      ISTEPN='2.1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HAZ2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL SORTC(Y,TAGC,N,YS,TAGC)
      IWRITE='OFF'
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  COMPUTE CUMULATIVE HAZARD                **
C               ***********************************************
C
      ISTEPN='2.2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HAZ2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL CUMHAZ(YS,TAGC,N,IWRITE,Y,IBUGG3,IERROR)
C
C               ***********************************************
C               **  STEP 23--                                **
C               **  COMPUTE PLOT COORDINATES FOR VARIOUS     **
C               **  DISTRIBUTIONS                            **
C               ***********************************************
C
      ISTEPN='2.3'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HAZ2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      IX1TSV=IX1TSC
      IX2TSV=IX2TSC
      IY1TSV=IY1TSC
      IY2TSV=IY2TSC
C
      IX1ZSV=IX1ZFM
      IX2ZSV=IX2ZFM
      IY1ZSV=IY1ZFM
      IY2ZSV=IY2ZFM
C
C  Y   = CUMULATIVE HAZARD
C  YS  = SORTED FAILURE/CENSOR TIMES
C
      IF(ICASPL.EQ.'EHAZ')THEN
        J=0
        DO2310I=1,N
          IF(ABS(TAGC(I)).GE.0.5)THEN
            J=J+1
            X2(J)=Y(I)
            Y2(J)=YS(I)
            D2(J)=1.0
          ENDIF
 2310   CONTINUE
        IX1TSC='LINE'
        IX2TSC='LINE'
        IY1TSC='LINE'
        IY2TSC='LINE'
      ELSEIF(ICASPL.EQ.'WHAZ')THEN
        J=0
        DO2320I=1,N
          IF(ABS(TAGC(I)).GE.0.5)THEN
            J=J+1
            X2(J)=Y(I)
            Y2(J)=YS(I)
            D2(J)=1.0
          ENDIF
 2320   CONTINUE
        IX1TSC='LOG '
        IX2TSC='LOG '
        IX1ZFM='REAL'
        IX2ZFM='REAL'
        IY1TSC='LOG '
        IY2TSC='LOG '
        IY1ZFM='REAL'
        IY2ZFM='REAL'
      ELSEIF(ICASPL.EQ.'GHAZ')THEN
        J=0
        DO2330I=1,N
          IF(ABS(TAGC(I)).GE.0.5)THEN
            J=J+1
            X2(J)=Y(I)
            Y2(J)=YS(I)
            D2(J)=1.0
          ENDIF
 2330   CONTINUE
        IX1TSC='LOG '
        IX2TSC='LOG '
        IX1ZFM='REAL'
        IX2ZFM='REAL'
        IY1TSC='LINE'
        IY2TSC='LINE'
      ELSEIF(ICASPL.EQ.'NHAZ')THEN
        J=0
        DO2340I=1,N
          IF(ABS(TAGC(I)).GE.0.5)THEN
            J=J+1
CCCCC       DTEMP=DBLE(Y(I))
CCCCC       DTEMP=1.0D0 - DEXP(-DTEMP)
CCCCC       IF(DTEMP.LE.DEPS)THEN
CCCCC         DTEMP=DEPS
CCCCC       ELSEIF(DTEMP.GT.1.0D0-DEPS)THEN
CCCCC         DTEMP=1.0D0-DEPS
CCCCC       ENDIF
CCCCC       CALL NODPPF(DTEMP,DPDF)
CCCCC       X2(J)=REAL(DPDF)
            X2(J)=Y(I)
            Y2(J)=YS(I)
            D2(J)=1.0
          ENDIF
 2340   CONTINUE
CCCCC   IX1TSC='LOG '
CCCCC   IX2TSC='LOG '
        IX1TSC='NORM'
        IX2TSC='NORM'
        IX1ZFM='REAL'
        IX2ZFM='REAL'
        IY1TSC='LINE'
        IY2TSC='LINE'
      ELSEIF(ICASPL.EQ.'LHAZ')THEN
        J=0
        DO2350I=1,N
          IF(ABS(TAGC(I)).GE.0.5)THEN
            J=J+1
            DTEMP=DBLE(Y(I))
            DTEMP=1.0D0 - DEXP(-DTEMP)
            IF(DTEMP.LE.DEPS)THEN
              DTEMP=DEPS
            ELSEIF(DTEMP.GT.1.0D0-DEPS)THEN
              DTEMP=1.0D0-DEPS
            ENDIF
            CALL NODPPF(DTEMP,DPDF)
            X2(J)=REAL(DPDF)
            Y2(J)=YS(I)
            D2(J)=1.0
          ENDIF
 2350   CONTINUE
CCCCC   IX1TSC='LOG '
CCCCC   IX2TSC='LOG '
        IX1TSC='NORM'
        IX2TSC='NORM'
        IX1ZFM='REAL'
        IX2ZFM='REAL'
        IY1TSC='LOG '
        IY2TSC='LOG '
        IY1ZFM='REAL'
        IY2ZFM='REAL'
      ENDIF
      N2=J
      NPLOTV=3
C
      ISUBRO='DPHA'
      DO3000I=1,N2
       IF(IY1TSC.EQ.'LOG ')Y2(I)=LOG(Y2(I))
       IF(IX1TSC.EQ.'LOG ')X2(I)=LOG(X2(I))
 3000 CONTINUE 
      CALL LINFIT(Y2,X2,N2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      SIGMA=BETA
      AMU=ALPHA
      SDSIGM=SDBETA
      SDAMU=SDALPH
C
      NTEMP=N2
      N2=N2+1
      X2(N2)=X2(1)
      Y2(N2)=ALPHA+BETA*X2(1)
      D2(N2)=2.0
C
      N2=N2+1
      X2(N2)=X2(NTEMP)
      Y2(N2)=ALPHA+BETA*X2(NTEMP)
      D2(N2)=2.0
C
      DO3100I=1,N2
       IF(IY1TSC.EQ.'LOG ')Y2(I)=EXP(Y2(I))
       IF(IX1TSC.EQ.'LOG ')X2(I)=EXP(X2(I))
 3100 CONTINUE 
C
C               ************************************************
C               **  STEP 35--                                 **
C               **  FORM ESTIMATES FOR                        **
C               **     BPT1= .1%   POINT OF BEST-FIT DIST.    **
C               **     BPT5= .5%   POINT OF BEST-FIT DIST.    **
C               **     B1  =  1%   POINT OF BEST-FIT DIST.    **
C               **     B5  =  5%   POINT OF BEST-FIT DIST.    **
C               **     B10 = 10%   POINT OF BEST-FIT DIST.    **
C               **     B20 = 20%   POINT OF BEST-FIT DIST.    **
C               **     B50 = 50%   POINT OF BEST-FIT DIST.    **
C               **     B80 = 80%   POINT OF BEST-FIT DIST.    **
C               **     B90 = 90%   POINT OF BEST-FIT DIST.    **
C               **     B95 = 95%   POINT OF BEST-FIT DIST.    **
C               **     B99 = 99%   POINT OF BEST-FIT DIST.    **
C               **     B995= 99.5% POINT OF BEST-FIT DIST.    **
C               **     B999= 99.9% POINT OF BEST-FIT DIST.    **
C               ************************************************
C
      IF(ICASPL.EQ.'NHAZ')THEN
        P=.001
        CALL NORPPF(P,XOUT)
        BPT1=AMU+XOUT*SIGMA
        P=.005
        CALL NORPPF(P,XOUT)
        BPT5=AMU+XOUT*SIGMA
        P=.01
        CALL NORPPF(P,XOUT)
        B1=AMU+XOUT*SIGMA
        P=.05
        CALL NORPPF(P,XOUT)
        B5=AMU+XOUT*SIGMA
        P=.10
        CALL NORPPF(P,XOUT)
        B10=AMU+XOUT*SIGMA
        P=.20
        CALL NORPPF(P,XOUT)
        B20=AMU+XOUT*SIGMA
        P=.50
        CALL NORPPF(P,XOUT)
        B50=AMU+XOUT*SIGMA
        P=.80
        CALL NORPPF(P,XOUT)
        B80=AMU+XOUT*SIGMA
        P=.90
        CALL NORPPF(P,XOUT)
        B90=AMU+XOUT*SIGMA
        P=.95
        CALL NORPPF(P,XOUT)
        B95=AMU+XOUT*SIGMA
        P=.99
        CALL NORPPF(P,XOUT)
        B99=AMU+XOUT*SIGMA
        P=.995
        CALL NORPPF(P,XOUT)
        B995=AMU+XOUT*SIGMA
        P=.999
        CALL NORPPF(P,XOUT)
        B999=AMU+XOUT*SIGMA
      ELSEIF(ICASPL.EQ.'EHAZ')THEN
        P=.001
        CALL EXPPPF(P,XOUT)
        BPT1=AMU+XOUT*SIGMA
        P=.005
        CALL EXPPPF(P,XOUT)
        BPT5=AMU+XOUT*SIGMA
        P=.01
        CALL EXPPPF(P,XOUT)
        B1=AMU+XOUT*SIGMA
        P=.05
        CALL EXPPPF(P,XOUT)
        B5=AMU+XOUT*SIGMA
        P=.10
        CALL EXPPPF(P,XOUT)
        B10=AMU+XOUT*SIGMA
        P=.20
        CALL EXPPPF(P,XOUT)
        B20=AMU+XOUT*SIGMA
        P=.50
        CALL EXPPPF(P,XOUT)
        B50=AMU+XOUT*SIGMA
        P=.80
        CALL EXPPPF(P,XOUT)
        B80=AMU+XOUT*SIGMA
        P=.90
        CALL EXPPPF(P,XOUT)
        B90=AMU+XOUT*SIGMA
        P=.95
        CALL EXPPPF(P,XOUT)
        B95=AMU+XOUT*SIGMA
        P=.99
        CALL EXPPPF(P,XOUT)
        B99=AMU+XOUT*SIGMA
        P=.995
        CALL EXPPPF(P,XOUT)
        B995=AMU+XOUT*SIGMA
        P=.999
        CALL EXPPPF(P,XOUT)
        B999=AMU+XOUT*SIGMA
CCCCC ELSEIF(ICASPL.EQ.'LHAZ')THEN
CCCCC   SD=1.0
CCCCC   P=.001
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   BPT1=AMU+XOUT*SIGMA
CCCCC   P=.005
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   BPT5=AMU+XOUT*SIGMA
CCCCC   P=.01
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B1=AMU+XOUT*SIGMA
CCCCC   P=.05
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B5=AMU+XOUT*SIGMA
CCCCC   P=.10
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B10=AMU+XOUT*SIGMA
CCCCC   P=.20
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B20=AMU+XOUT*SIGMA
CCCCC   P=.50
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B50=AMU+XOUT*SIGMA
CCCCC   P=.80
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B80=AMU+XOUT*SIGMA
CCCCC   P=.90
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B90=AMU+XOUT*SIGMA
CCCCC   P=.95
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B95=AMU+XOUT*SIGMA
CCCCC   P=.99
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B99=AMU+XOUT*SIGMA
CCCCC   P=.995
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B995=AMU+XOUT*SIGMA
CCCCC   P=.999
CCCCC   CALL LGNPPF(P,SD,XOUT)
CCCCC   B999=AMU+XOUT*SIGMA
CCCCC ELSEIF(ICASPL.EQ.'WHAZ')THEN
CCCCC   MINMAX=1
CCCCC   GAMMA=1.0
CCCCC   P=.001
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   BPT1=AMU+XOUT*SIGMA
CCCCC   P=.005
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   BPT5=AMU+XOUT*SIGMA
CCCCC   P=.01
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B1=AMU+XOUT*SIGMA
CCCCC   P=.05
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B5=AMU+XOUT*SIGMA
CCCCC   P=.10
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B10=AMU+XOUT*SIGMA
CCCCC   P=.20
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B20=AMU+XOUT*SIGMA
CCCCC   P=.50
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B50=AMU+XOUT*SIGMA
CCCCC   P=.80
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B80=AMU+XOUT*SIGMA
CCCCC   P=.90
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B90=AMU+XOUT*SIGMA
CCCCC   P=.95
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B95=AMU+XOUT*SIGMA
CCCCC   P=.99
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B99=AMU+XOUT*SIGMA
CCCCC   P=.995
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B995=AMU+XOUT*SIGMA
CCCCC   P=.999
CCCCC   CALL WEIPPF(P,GAMMA,MINMAX,XOUT)
CCCCC   B999=AMU+XOUT*SIGMA
      ELSEIF(ICASPL.EQ.'GHAZ')THEN
        MINMAX=1
        P=.001
        CALL EV1PPF(P,MINMAX,XOUT)
        BPT1=AMU+XOUT*SIGMA
        P=.005
        CALL EV1PPF(P,MINMAX,XOUT)
        BPT5=AMU+XOUT*SIGMA
        P=.01
        CALL EV1PPF(P,MINMAX,XOUT)
        B1=AMU+XOUT*SIGMA
        P=.05
        CALL EV1PPF(P,MINMAX,XOUT)
        B5=AMU+XOUT*SIGMA
        P=.10
        CALL EV1PPF(P,MINMAX,XOUT)
        B10=AMU+XOUT*SIGMA
        P=.20
        CALL EV1PPF(P,MINMAX,XOUT)
        B20=AMU+XOUT*SIGMA
        P=.50
        CALL EV1PPF(P,MINMAX,XOUT)
        B50=AMU+XOUT*SIGMA
        P=.80
        CALL EV1PPF(P,MINMAX,XOUT)
        B80=AMU+XOUT*SIGMA
        P=.90
        CALL EV1PPF(P,MINMAX,XOUT)
        B90=AMU+XOUT*SIGMA
        P=.95
        CALL EV1PPF(P,MINMAX,XOUT)
        B95=AMU+XOUT*SIGMA
        P=.99
        CALL EV1PPF(P,MINMAX,XOUT)
        B99=AMU+XOUT*SIGMA
        P=.995
        CALL EV1PPF(P,MINMAX,XOUT)
        B995=AMU+XOUT*SIGMA
        P=.999
        CALL EV1PPF(P,MINMAX,XOUT)
        B999=AMU+XOUT*SIGMA
      ENDIF
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 DPHAZ2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,MAXN,N2,IERROR
 9012 FORMAT('ICASPL,MAXN,N2,IERROR = ',A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)IX1TSC,IX2TSC,IY1TSC,IY2TSC
 9021 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IX1TSV,IX2TSV,IY1TSV,IY2TSV
 9022 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)SIGMA,AMU,SDSIGM,SDAMU
 9032 FORMAT('SIGMA,AMU,SDSIGM,SDAMU = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)BPT1,BPT5,B1,B5
 9034 FORMAT('BPT1,BPT5,B1,B5 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)B10,B20,B50,B80,B90
 9035 FORMAT(' B10,B20,B50,B80,B90 = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)B95,B99,B995,B999
 9036 FORMAT('B95,B99,B995,B999 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)AMU
 9044 FORMAT('AMU = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHEIG(IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,
     1PTEXHE,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE HEIGHT FOR TEXT CHARACTERS.
C              THE HEIGHT FOR TEXT CHARACTERS WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PTEXHE.
C     NOTE--THE HEIGHT IS IN STANDARDIZED UNITS (0.0 TO 100.0).
C     NOTE--THE HEIGHT DOES NOT INCLUDE BETWEEN-LINE GAP.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PDEFHE
C                     --IBUGD2
C     OUTPUT ARGUMENTS--PTEXHE
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHEIG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PDEFHE
   53 FORMAT('PDEFHE = ',E15.7)
      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),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
   90 CONTINUE
C
C               *****************************
C               **  TREAT THE HEIGHT CASE  **
C               *****************************
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
C
      IF(NUMARG.GE.1.AND.IARGT(NUMARG).EQ.'NUMB')
     1GOTO1160
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPHEIG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR HEIGHT ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE IT IS DESIRED THAT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE TEXT CHARACTERS HAVE A HEIGHT OF 5')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      (WHERE THE VERTICAL SCREEN UNITS RANGE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      FROM 0 TO 100, AND WHERE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      THE BETWEEN-LINE GAP IS NOT INCLUDED),')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('           HEIGHT 5 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PTEXHE=PDEFHE
      GOTO1180
C
 1160 CONTINUE
      PTEXHE=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE HEIGHT (FOR TEXT CHARACTERS)  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PTEXHE
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      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)PTEXHE
 8111 FORMAT('THE CURRENT (TEXT) HEIGHT IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)PDEFHE
 8112 FORMAT('THE DEFAULT (TEXT) HEIGHT IS ',E15.7)
      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 DPHEIG--')
      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)PTEXHE
 9013 FORMAT('PTEXHE = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHELP(IHARG,IHARG2,NUMARG,IANS,IWIDTH,
CCCCC THE FOLLOWING 9 LINES WERE COMMENTED OUT NOVEMBER 1991
CCCCC1IHE1CO,IHE1AL,
CCCCC1IHE2CO,IHE2AL,
CCCCC1IHE3CO,IHE3AL,
CCCCC1IHE4CO,IHE4AL,
CCCCC1IHE5CO,IHE5AL,
CCCCC1IHE6CO,IHE6AL,
CCCCC1IHE7CO,IHE7AL,
CCCCC1IHE8CO,IHE8AL,
CCCCC1IHE9CO,IHE9AL,
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--PRINT OUT BRIEF INSTRUCTIONAL INFORMATION
C              ABOUT A PARTICULAR COMMAND
C              AS CALLED FOR BY THE HELP COMMAND.
C     INPUT  ARGUMENTS--IANS    (A  HOLLERITH VECTOR)
C                     --IWIDTH (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JUNE      1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --SEPTEMBER 1987.  MORE/PAUSE
C     UPDATED         --JANUARY   1989.  FIX TRUNCATION OF LONG LINES
C                                        UNDER CYBER NOS (ALAN)
C     UPDATED         --JULY      1989.  MORE/PAUSE IN THE SUBROUTINE DPMORE
C     UPDATED         --NOVEMBER  1989.  IERRO TO IERROR--CALL DPMORE
C     UPDATED         --JULY      1990.  ALLOW MORE... TO STOP LIST
C     UPDATED         --JULY      1990.  SPLIT HELP INTO 6 FILES
C     UPDATED         --AUGUST    1990.  EXPLICIT SETTING OF NUMLPR=0
C     UPDATED         --APRIL     1992.  IBUGHE/2 TO IBUGS2
C     UPDATED         --APRIL     1992.  COMMENT OUT 12 DEBUG STATEMENTS
C     UPDATED         --AUGUST    1994.  SEARCH SYNONYM FILE
C     UPDATED         --AUGUST    1994.  NUMWOR => NUMWHF
C     UPDATED         --DECEMBER  1994.  CORRECTIONS FOR SYNONYM FILE
C     UPDATED         --MARCH     1996.  UPDATE SECTIONS FOR MATR OPER
C     UPDATED         --APRIL     1997.  CONFLICT BETWEEN STATUS AND
C                                        STATISTIC PLOT
C     UPDATED         --NOVEMBER  1997.  CONFLICT BETWEEN:
C                                           INTERPOLATION - INTEGRAL
C                                           ROOTOGRAM     - ROOTS
C     UPDATED         --FEBRUARY  2003.  BUG FIX FOR LONGER ENTRIES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IANS
C
CCCCC THE FOLLOWING 18 LINES WERE COMMENTED OUT NOVEMBER 1991
CCCCC CHARACTER*12 IHE1CO
CCCCC CHARACTER*4 IHE1AL
C
CCCCC CHARACTER*12 IHE2CO
CCCCC CHARACTER*4 IHE2AL
C
CCCCC CHARACTER*12 IHE3CO
CCCCC CHARACTER*4 IHE3AL
C
CCCCC CHARACTER*12 IHE4CO
CCCCC CHARACTER*4 IHE4AL
C
CCCCC CHARACTER*12 IHE5CO
CCCCC CHARACTER*4 IHE5AL
C
CCCCC CHARACTER*12 IHE6CO
CCCCC CHARACTER*4 IHE6AL
C
CCCCC CHARACTER*12 IHE7CO
CCCCC CHARACTER*4 IHE7AL
C
CCCCC CHARACTER*12 IHE8CO
CCCCC CHARACTER*4 IHE8AL
C
CCCCC CHARACTER*12 IHE9CO
CCCCC CHARACTER*4 IHE9AL
C
      CHARACTER*40 ICPREH
      CHARACTER*40 ICPOSH
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 ISUBN0
      CHARACTER*4 IERRFI
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
C
      CHARACTER*4 ITABID
CCCCC CHARACTER*4 ITABII
      CHARACTER*4 IWORD1
      CHARACTER*4 IWORD2
      CHARACTER*4 IWORD3
      CHARACTER*4 IWORD4
      CHARACTER*4 IWORD5
      CHARACTER*4 IWOR12
C
      CHARACTER*1 ICHAR1
C
      CHARACTER*4 ICTEST
C
CCCCC THE FOLLOWING 5 LINES WERE COMMENTED OUT   AUGUST 1994
CCCCC CHARACTER*4 IW1
CCCCC CHARACTER*4 IW2
CCCCC CHARACTER*4 IW3
CCCCC CHARACTER*4 IW4
CCCCC CHARACTER*4 IW5
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1994
CCCCC THE FOLLOWING LINE WAS FXED FEBRUARY 2003
CCCCC CHARACTER*30 ILIN30
      CHARACTER*40 ILIN30
C
      CHARACTER*4 IZ1
      CHARACTER*4 IZ2
      CHARACTER*4 IZ3
      CHARACTER*4 IZ4
CCCCC FEBRUARY 2003: ADD FOLLOWING LINE
      CHARACTER*4 IZ5
C
      CHARACTER*4 ICTEXT
C
CCCCC FEBRUARY 2003: FIX FOLLOWING LINE
CCCCC CHARACTER*30 ISTRIN
      CHARACTER*40 ISTRIN
C
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      CHARACTER*4 IRESP
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1994
      CHARACTER*4 IERRO2
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1994
      CHARACTER*1 ICJUNK
      CHARACTER*80 ILINE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IANS(*)
C
      DIMENSION ITABID(100)
      DIMENSION ITABLN(100)
C
      DIMENSION ICTEXT(20)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPHE'
      ISUBN2='LP  '
C
      NUMLIN=(-999)
      NUMSEC=(-999)
      ISECNA=(-999)
C
      NUMAR2=(-999)
C
      IWORD1='    '
      IWORD2='    '
      IWORD3='    '
      IWORD4='    '
      IWORD5='    '
      IWOR12='    '
C
      ICTEST='    '
C
CCCCC THE FOLLOWING 5 LINES WERE COMMENTED OUT AUGUST 1994
CCCCC IW1='    '
CCCCC IW2='    '
CCCCC IW3='    '
CCCCC IW4='    '
CCCCC IW5='    '
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1994
      ILIN30='                              '
C
      IZ1='    '
      IZ2='    '
      IZ3='    '
      IZ4='    '
      IZ5='    '
C
      JCHAR1=(-999)
      JSEC=(-999)
      JSECP1=(-999)
C
      ISKIP=(-999)
      ISTART=(-999)
      ISTOP=(-999)
      I2=(-999)
C
      ISTRIN='                              '
C
CCCCC THE FOLLOWING LINE (AND ALL OTHER LINES          AUGUST 1994
CCCCC IN THIS SUBROUTINE CONTAINING NUMWOR)            AUGUST 1994
CCCCC WAS CHANGED (NUMWOR =>NUMWHF)                    AUGUST 1994
CCCCC NUMWOR=(-999)
      NUMWHF=(-999)
C
      ILOC2=(-999)
      ILOC3=(-999)
      ILOC4=(-999)
      ILOC5=(-999)
C
      ILOC2P=(-999)
      ILOC3P=(-999)
      ILOC4P=(-999)
      ILOC5P=(-999)
C
C
      IFOUND='YES'
      IERROR='NO'
C
      ISUBN1='DPHE'
      ISUBN2='LP  '
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HELP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHELP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IWIDTH
   54 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(IANS(I),I=1,IWIDTH)
   55 FORMAT('IANS(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 18 LINES WERE COMMENTED OUT NOVEMBER 1991
CCCCC WRITE(ICOUT,61)IHE1CO,IHE1AL
CCC61 FORMAT('IHE1CO,IHE1AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,62)IHE2CO,IHE2AL
CCC62 FORMAT('IHE2CO,IHE2AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,63)IHE3CO,IHE3AL
CCC63 FORMAT('IHE3CO,IHE3AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,64)IHE4CO,IHE4AL
CCC64 FORMAT('IHE4CO,IHE4AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,65)IHE5CO,IHE5AL
CCC65 FORMAT('IHE5CO,IHE5AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,66)IHE6CO,IHE6AL
CCC66 FORMAT('IHE6CO,IHE6AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,67)IHE7CO,IHE7AL
CCC67 FORMAT('IHE7CO,IHE7AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,68)IHE8CO,IHE8AL
CCC68 FORMAT('IHE8CO,IHE8AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,69)IHE9CO,IHE9AL
CCC69 FORMAT('IHE9CO,IHE9AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)NCPREH
   81 FORMAT('NCPREH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPREH.LE.0)GOTO84
      DO82I=1,NCPREH
      WRITE(ICOUT,83)I,ICPREH(I:I)
   83 FORMAT('I,ICPREH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   82 CONTINUE
   84 CONTINUE
      WRITE(ICOUT,86)NCPOSH
   86 FORMAT('NCPOSH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPOSH.LE.0)GOTO89
      DO87I=1,NCPOSH
      WRITE(ICOUT,88)I,ICPOSH(I:I)
   88 FORMAT('I,ICPOSH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   87 CONTINUE
   89 CONTINUE
   90 CONTINUE
C
C               **********************************************************
C               **  STEP 21--                                           **
C               **  COPY OVER THE FIRST 4 WORDS AFTER THE WORD   HELP.  **
C               **********************************************************
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED       AUGUST 1994 (JJF)
CCCCC TO SEARCH A SYNONYM FILE (DPHE7F.TEX)  AUGUST 1994
      IPASS=0
 1000 CONTINUE
      IPASS=IPASS+1
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPASS.LE.1)THEN
         IWORD1=IHARG(1)
         IWOR12=IHARG2(1)
         IWORD2=IHARG(2)
         IWORD3=IHARG(3)
         IWORD4=IHARG(4)
         IWORD5=IHARG(5)
         NUMAR2=NUMARG
      ENDIF
C
      IF(NUMAR2.LE.0)THEN
         NUMAR2=1
         IWORD1='OVER'
         IWOR12='VIEW'
      ENDIF
C
C               ********************************************************
C               **  STEP 22--                                         **
C               **  STRIP OUT THE FIRST CHARACTER OF THE FIRST WORD.  **
C               ********************************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICHAR1=IWORD1(1:1)
C
C               **************************************************
C               **  STEP 31--                                   **
C               **  BASED ON THE FIRST WORD OR                  **
C               **  THE FIRST CHARACTER OF THE FIRST WORD,      **
C               **  DETERMINE WHICH OF THE 6 HELP               **
C               **  FILES WILL BE USED.                         **
C               **************************************************
C
      JFILE=6
C
      IF(IWORD1.EQ.'OVER')GOTO3110
      IF(IWORD1.EQ.'GRAP')GOTO3110
      IF(IWORD1.EQ.'DIAG')GOTO3110
      IF(IWORD1.EQ.'ANAL')GOTO3110
      IF(IWORD1.EQ.'PLOT'.AND.IWORD2.EQ.'CONT')GOTO3110
      IF(IWORD1.EQ.'SUPP')GOTO3110
      IF(IWORD1.EQ.'OUTP')GOTO3110
      IF(IWORD1.EQ.'KEYW')GOTO3110
      IF(IWORD1.EQ.'FUNC')GOTO3110
      IF(IWORD1.EQ.'MATH'.AND.IWORD2.EQ.'FUNC')GOTO3110
      IF(IWORD1.EQ.'TRIG')GOTO3110
CCCCC THE FOLLOWING LINE WAS CHANGED     AUGUST 1994
CCCCC IF(IWORD1.EQ.'PROB')GOTO3110
      IF(IWORD1.EQ.'PROB'.AND.IWORD2.NE.'PLOT')GOTO3110
      IF(IWORD1.EQ.'LET '.AND.IWORD2.EQ.'SUBC')GOTO3110
      IF(IWORD1.EQ.'LET '.AND.IWORD2.EQ.'SUB-')GOTO3110
      IF(IWORD1.EQ.'LET '.AND.IWORD2.EQ.'SUB ')GOTO3110
CCCCC APRIL 1997.  STAT CAN MEAN EITHER STATISTICS, STATUS, OR
CCCCC STATISTIC PLOT.  FOLLOWING LINE ONLY FOR STATISTICS.
CCCCC IF(IWORD1.EQ.'STAT')GOTO3110
      IF(IWORD1.EQ.'STAT')THEN
        IF(IWORD2.NE.'PLOT' .AND. IWOR12.NE.'US')GOTO3110
      ENDIF
      IF(IWORD1.EQ.'MATH'.AND.IWORD2.EQ.'OPER')GOTO3110
CCCCC MARCH 1996.  ADD FOLLOWING LINE.
      IF(IWORD1.EQ.'MATR'.AND.IWORD2.EQ.'OPER')GOTO3110
CCCCC MAY 2002: CHECK FOR CONFLICT WITH RANDOM NUMBER GENERATOR
CCCCC COMMAND.
CCCCC IF(IWORD1.EQ.'RAND')GOTO3110
      IF(IWORD1.EQ.'RAND'.AND.IWORD3.NE.'GENE')GOTO3110
      IF(IWORD1.EQ.'TEXT'.AND.IWORD2.EQ.'SUBC')GOTO3110
      IF(IWORD1.EQ.'TEXT'.AND.IWORD2.EQ.'SUB-')GOTO3110
      IF(IWORD1.EQ.'TEXT'.AND.IWORD2.EQ.'SUB ')GOTO3110
      IF(IWORD1.EQ.'CAPI')GOTO3110
      IF(IWORD1.EQ.'CAPS')GOTO3110
      IF(IWORD1.EQ.'CAP ')GOTO3110
      IF(IWORD1.EQ.'SUBS'.AND.IWOR12.EQ.'CRIP')GOTO3110
      IF(IWORD1.EQ.'SUBS'.AND.IWOR12.EQ.'SET ')GOTO3110
      IF(IWORD1.EQ.'GREE')GOTO3110
      IF(IWORD1.EQ.'MATH'.AND.IWORD2.EQ.'SYMB')GOTO3110
      IF(IWORD1.EQ.'MISC')GOTO3110
      IF(IWORD1.EQ.'CHAR'.AND.IWORD2.EQ.'TYPE')GOTO3110
      IF(IWORD1.EQ.'LINE'.AND.IWORD2.EQ.'TYPE')GOTO3110
      IF(IWORD1.EQ.'COLO'.AND.IWORD2.EQ.'TYPE')GOTO3110
      IF(IWORD1.EQ.'ASCI'.AND.IWORD2.EQ.'FILE')GOTO3110
C
      IF(ICHAR1.EQ.'A')GOTO3120
      IF(ICHAR1.EQ.'B')GOTO3120
      IF(ICHAR1.EQ.'C')GOTO3120
C
      IF(ICHAR1.EQ.'D')GOTO3130
      IF(ICHAR1.EQ.'E')GOTO3130
      IF(ICHAR1.EQ.'F')GOTO3130
      IF(ICHAR1.EQ.'G')GOTO3130
      IF(ICHAR1.EQ.'H')GOTO3130
      IF(ICHAR1.EQ.'I')GOTO3130
      IF(ICHAR1.EQ.'J')GOTO3130
      IF(ICHAR1.EQ.'K')GOTO3130
C
      IF(ICHAR1.EQ.'L')GOTO3140
      IF(ICHAR1.EQ.'M')GOTO3140
      IF(ICHAR1.EQ.'N')GOTO3140
      IF(ICHAR1.EQ.'O')GOTO3140
C
      IF(ICHAR1.EQ.'P')GOTO3150
      IF(ICHAR1.EQ.'Q')GOTO3150
      IF(ICHAR1.EQ.'R')GOTO3150
      IF(ICHAR1.EQ.'S')GOTO3150
C
CCCCC IF(ICHAR1.EQ.'T')GOTO3160
CCCCC IF(ICHAR1.EQ.'U')GOTO3160
CCCCC IF(ICHAR1.EQ.'V')GOTO3160
CCCCC IF(ICHAR1.EQ.'W')GOTO3160
CCCCC IF(ICHAR1.EQ.'X')GOTO3160
CCCCC IF(ICHAR1.EQ.'Y')GOTO3160
CCCCC IF(ICHAR1.EQ.'Z')GOTO3160
      GOTO3160
 
 3110 CONTINUE
      JFILE=1
      GOTO3190
 3120 CONTINUE
      JFILE=2
      GOTO3190
 3130 CONTINUE
      JFILE=3
      GOTO3190
 3140 CONTINUE
      JFILE=4
      GOTO3190
 3150 CONTINUE
      JFILE=5
      GOTO3190
 3160 CONTINUE
      JFILE=6
      GOTO3190
C
 3190 CONTINUE
C
C               *******************************
C               **  STEP 32--                **
C               **  COPY OVER FILE VARIABLES **
C               *******************************
C
      ISTEPN='32'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(JFILE.EQ.1)GOTO3210
      IF(JFILE.EQ.2)GOTO3220
      IF(JFILE.EQ.3)GOTO3230
      IF(JFILE.EQ.4)GOTO3240
      IF(JFILE.EQ.5)GOTO3250
      GOTO3260
C
 3210 CONTINUE
      IOUNIT=IHE1NU
      IFILE=IHE1NA
      ISTAT=IHE1ST
      IFORM=IHE1FO
      IACCES=IHE1AC
      IPROT=IHE1PR
      ICURST=IHE1CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO3291
C
 3220 CONTINUE
      IOUNIT=IHE2NU
      IFILE=IHE2NA
      ISTAT=IHE2ST
      IFORM=IHE2FO
      IACCES=IHE2AC
      IPROT=IHE2PR
      ICURST=IHE2CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO3291
C
 3230 CONTINUE
      IOUNIT=IHE3NU
      IFILE=IHE3NA
      ISTAT=IHE3ST
      IFORM=IHE3FO
      IACCES=IHE3AC
      IPROT=IHE3PR
      ICURST=IHE3CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO3291
C
 3240 CONTINUE
      IOUNIT=IHE4NU
      IFILE=IHE4NA
      ISTAT=IHE4ST
      IFORM=IHE4FO
      IACCES=IHE4AC
      IPROT=IHE4PR
      ICURST=IHE4CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO3291
C
 3250 CONTINUE
      IOUNIT=IHE5NU
      IFILE=IHE5NA
      ISTAT=IHE5ST
      IFORM=IHE5FO
      IACCES=IHE5AC
      IPROT=IHE5PR
      ICURST=IHE5CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO3291
C
 3260 CONTINUE
      IOUNIT=IHE6NU
      IFILE=IHE6NA
      ISTAT=IHE6ST
      IFORM=IHE6FO
      IACCES=IHE6AC
      IPROT=IHE6PR
      ICURST=IHE6CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO3291
C
 3291 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HEL2')GOTO3299
      WRITE(ICOUT,3293)IOUNIT
 3293 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3294)IFILE
 3294 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3295)ISTAT,IFORM,IACCES,IPROT,ICURST
 3295 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3296)IBUGS2,ISUBRO,ISUBN0,IERRFI
 3296 FORMAT('IBUGS2,ISUBRO,ISUBN0,IERRFI = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 3299 CONTINUE
C
C               ****************************************
C               **  STEP 33--                         **
C               **  CHECK TO SEE IF HELP FILE EXISTS  **
C               ****************************************
C
      ISTEPN='33'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO3300
      GOTO3390
 3300 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3311)
 3311 FORMAT('***** ERROR IN DPHELP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3312)
 3312 FORMAT('      THE DESIRED HELP INFORMATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3313)
 3313 FORMAT('      CANNOT BE GIVEN BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3314)
 3314 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3315)
 3315 FORMAT('      WHICH STORES SUCH HELP INFORMATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3316)
 3316 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3317)ISTAT,IHELST
 3317 FORMAT('ISTAT,IHELST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3318)IFILE(1:50)
 3318 FORMAT('IFILE(1:50) = ',A50)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 3390 CONTINUE
C
C               *********************
C               **  STEP 34--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='34'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               **************************************************
C               **  STEP 41--                                   **
C               **  BASED ON THE FIRST WORD OR                  **
C               **  THE FIRST CHARACTER OF THE FIRST WORD,      **
C               **  DETERMINE THE SECTION NUMBER WITHIN A FILE  **
C               **  THAT SHOULD BE SEARCHED.                    **
C               **************************************************
C
      ISTEPN='42'
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC JCHAR1=ICHAR(ICHAR1)
      CALL DPCOAN(ICHAR1,JCHAR1)
C
      IF(JFILE.EQ.1)GOTO4110
      IF(JFILE.EQ.2)GOTO4120
      IF(JFILE.EQ.3)GOTO4130
      IF(JFILE.EQ.4)GOTO4140
      IF(JFILE.EQ.5)GOTO4150
      GOTO4160
C
 4110 CONTINUE
      IF(IWORD1.EQ.'OVER')JSEC=1
      IF(IWORD1.EQ.'GRAP')JSEC=2
      IF(IWORD1.EQ.'DIAG')JSEC=3
      IF(IWORD1.EQ.'ANAL')JSEC=4
      IF(IWORD1.EQ.'PLOT'.AND.IWORD2.EQ.'CONT')JSEC=5
      IF(IWORD1.EQ.'SUPP')JSEC=6
      IF(IWORD1.EQ.'OUTP')JSEC=7
      IF(IWORD1.EQ.'KEYW')JSEC=8
      IF(IWORD1.EQ.'FUNC')JSEC=9
      IF(IWORD1.EQ.'MATH'.AND.IWORD2.EQ.'FUNC')JSEC=10
      IF(IWORD1.EQ.'TRIG')JSEC=11
      IF(IWORD1.EQ.'PROB')JSEC=12
      IF(IWORD1.EQ.'LET '.AND.IWORD2.EQ.'SUBC')JSEC=13
      IF(IWORD1.EQ.'LET '.AND.IWORD2.EQ.'SUB-')JSEC=13
      IF(IWORD1.EQ.'LET '.AND.IWORD2.EQ.'SUB ')JSEC=13
      IF(IWORD1.EQ.'STAT')JSEC=14
      IF(IWORD1.EQ.'MATH'.AND.IWORD2.EQ.'OPER')JSEC=15
CCCCC MARCH 1996.  A MATRIX OPERATIONS SECTION ADDED, ADD 1 TO
CCCCC FOLLOWING SECTION NUMBERS.
      IF(IWORD1.EQ.'MATR'.AND.IWORD2.EQ.'OPER')JSEC=16
CCCCC IF(IWORD1.EQ.'RAND')JSEC=16
CCCCC IF(IWORD1.EQ.'TEXT'.AND.IWORD2.EQ.'SUBC')JSEC=17
CCCCC IF(IWORD1.EQ.'TEXT'.AND.IWORD2.EQ.'SUB-')JSEC=17
CCCCC IF(IWORD1.EQ.'TEXT'.AND.IWORD2.EQ.'SUB ')JSEC=17
CCCCC IF(IWORD1.EQ.'CAPI')JSEC=18
CCCCC IF(IWORD1.EQ.'CAPS')JSEC=18
CCCCC IF(IWORD1.EQ.'CAP ')JSEC=18
CCCCC IF(IWORD1.EQ.'SUBS'.AND.IWOR12.EQ.'CRIP')JSEC=19
CCCCC IF(IWORD1.EQ.'SUBS'.AND.IWOR12.EQ.'SET ')JSEC=ISECNA+18
CCCCC IF(IWORD1.EQ.'GREE')JSEC=20
CCCCC IF(IWORD1.EQ.'MATH'.AND.IWORD2.EQ.'SYMB')JSEC=21
CCCCC IF(IWORD1.EQ.'MISC')JSEC=22
CCCCC IF(IWORD1.EQ.'CHAR'.AND.IWORD2.EQ.'TYPE')JSEC=23
CCCCC IF(IWORD1.EQ.'LINE'.AND.IWORD2.EQ.'TYPE')JSEC=24
CCCCC IF(IWORD1.EQ.'COLO'.AND.IWORD2.EQ.'TYPE')JSEC=25
      IF(IWORD1.EQ.'RAND')JSEC=17
      IF(IWORD1.EQ.'TEXT'.AND.IWORD2.EQ.'SUBC')JSEC=18
      IF(IWORD1.EQ.'TEXT'.AND.IWORD2.EQ.'SUB-')JSEC=18
      IF(IWORD1.EQ.'TEXT'.AND.IWORD2.EQ.'SUB ')JSEC=18
      IF(IWORD1.EQ.'CAPI')JSEC=19
      IF(IWORD1.EQ.'CAPS')JSEC=19
      IF(IWORD1.EQ.'CAP ')JSEC=19
      IF(IWORD1.EQ.'SUBS'.AND.IWOR12.EQ.'CRIP')JSEC=20
      IF(IWORD1.EQ.'SUBS'.AND.IWOR12.EQ.'SET ')JSEC=ISECNA+18
      IF(IWORD1.EQ.'GREE')JSEC=21
      IF(IWORD1.EQ.'MATH'.AND.IWORD2.EQ.'SYMB')JSEC=22
      IF(IWORD1.EQ.'MISC')JSEC=23
      IF(IWORD1.EQ.'CHAR'.AND.IWORD2.EQ.'TYPE')JSEC=24
      IF(IWORD1.EQ.'LINE'.AND.IWORD2.EQ.'TYPE')JSEC=25
      IF(IWORD1.EQ.'COLO'.AND.IWORD2.EQ.'TYPE')JSEC=26
      IF(IWORD1.EQ.'ASCI'.AND.IWORD2.EQ.'FILE')JSEC=27
      GOTO4190
C
 4120 CONTINUE
      IF(ICHAR1.EQ.'A')JSEC=1
      IF(ICHAR1.EQ.'B')JSEC=2
      IF(ICHAR1.EQ.'C')JSEC=3
      GOTO4190
C
 4130 CONTINUE
      IF(ICHAR1.EQ.'D')JSEC=1
      IF(ICHAR1.EQ.'E')JSEC=2
      IF(ICHAR1.EQ.'F')JSEC=3
      IF(ICHAR1.EQ.'G')JSEC=4
      IF(ICHAR1.EQ.'H')JSEC=5
      IF(ICHAR1.EQ.'I')JSEC=6
      IF(ICHAR1.EQ.'J')JSEC=7
      IF(ICHAR1.EQ.'K')JSEC=8
      GOTO4190
C
 4140 CONTINUE
      IF(ICHAR1.EQ.'L')JSEC=1
      IF(ICHAR1.EQ.'M')JSEC=2
      IF(ICHAR1.EQ.'N')JSEC=3
      IF(ICHAR1.EQ.'O')JSEC=4
      GOTO4190
C
 4150 CONTINUE
      IF(ICHAR1.EQ.'P')JSEC=1
      IF(ICHAR1.EQ.'Q')JSEC=2
      IF(ICHAR1.EQ.'R')JSEC=3
      IF(ICHAR1.EQ.'S')JSEC=4
      GOTO4190
C
 4160 CONTINUE
      JSEC=8
      IF(ICHAR1.EQ.'T')JSEC=1
      IF(ICHAR1.EQ.'U')JSEC=2
      IF(ICHAR1.EQ.'V')JSEC=3
      IF(ICHAR1.EQ.'W')JSEC=4
      IF(ICHAR1.EQ.'X')JSEC=5
      IF(ICHAR1.EQ.'Y')JSEC=6
      IF(ICHAR1.EQ.'Z')JSEC=7
      GOTO4190
C
 4190 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HEL2')GOTO4199
      WRITE(ICOUT,4191)
 4191 FORMAT('***** FROM 4191 IN MIDDLE OF DPHELP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4192)IWORD1,ICHAR1
 4192 FORMAT('IWORD1,ICHAR1 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4193)JFILE,JSEC
 4193 FORMAT('JFILE,JSEC = ',I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4194)IBUGS2,ISUBRO,ISUBN0,IERRFI
 4194 FORMAT('IBUGS2,ISUBRO,ISUBN0,IERRFI = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 4199 CONTINUE
C
 4209 CONTINUE
C
C               ************************************************************
C               **  STEP 42--                                             **
C               **  READ IN SECTION LOCATION INFORMATION
C               **  FROM THE BEGINNING LINES OF THE FILE.                 **
C               **  THE FIRST LINE CONTAINS THE                           **
C               **  NUMBER OF LINES IN THE FILE (ANUMLI) (F10.0 FORMAT).  **
C               **  THE SECOND LINE CONTAINS THE NUMBER OF                **
C               **  SECTIONS IN THE FILE (ANUMSE) (F10.0 FORMAT)          **
C               **  THE NEXT ANUMSE LINES CONTAIN                         **
C               **  THE STARTING LINE NUMBER OF EACH SECTION              **
C               **  IN THE FILE (ATABLN)   (F10.0 FORMAT), AND            **
C               **  THE IDENTIFIER (IF ANY) FOR EACH SECTION              **
C               **  IN THE FILE (ITABID(.) (A4 FORMAT).                   **
C               ************************************************************
C
      ISTEPN='42'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      READ(IOUNIT,4211)ANUMLI
 4211 FORMAT(F10.0)
      NUMLIN=ANUMLI+0.5
      READ(IOUNIT,4212)ANUMSE
 4212 FORMAT(F10.0)
      NUMSEC=ANUMSE+0.5
      IF(NUMSEC.LE.0)GOTO4290
      DO4220I=1,NUMSEC
      READ(IOUNIT,4221)ATABLN,ITABID(I)
 4221 FORMAT(F10.0,A4)
      ITABLN(I)=ATABLN+0.5
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1WRITE(ICOUT,4222)I,ATABLN,ITABLN(I),ITABID(I)
 4222 FORMAT('I,ATABLN,ITABLN(I),ITABID(I) = ',I8,E15.7,I8,2X,A4)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL DPWRST('XXX','BUG ')
 4220 CONTINUE
 4290 CONTINUE
C
C               *******************************************************
C               **  STEP 43--                                        **
C               **  BASED ON THE FILE, SECTION, & HEADER TABLE INFO, *
C               **  DO A TABLE LOOK-UP WHICH WILL SPECIFY            **
C               **  THE ABSOLUTE LINE NUMBER IN THE FILE             **
C               **  WHERE THE SECTION WITH THAT CODE WORD STARTS     **
C               *******************************************************
C
      ISTEPN='43'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTART=ITABLN(JSEC)
      JSECP1=JSEC+1
      ISTOP=NUMLIN
      IF(JSECP1.LE.NUMSEC)ISTOP=ITABLN(JSECP1)
      IF(ISTOP.LE.ISTART)ISTOP=NUMLIN
 
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HEL2')GOTO4390
      WRITE(ICOUT,4311)
 4311 FORMAT('***** FROM 4211 IN MIDDLE OF DPHEL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4313)JSEC,ISTART
 4313 FORMAT('JSEC,ISTART = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4314)JSECP1,ISTOP
 4314 FORMAT('JSECP1,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4390 CONTINUE
C
C               *************************************************
C               **  STEP 51--                                  **
C               **  READ DOWN IN THE FILE TO                   **
C               **  THE LINE BEFORE WHERE THE CHARACTER RESIDES**
C               *************************************************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      REWIND(IOUNIT)
C
      ISKIP=ISTART-1
      IF(ISKIP.LE.0)GOTO5190
      DO5100I=1,ISKIP
      READ(IOUNIT,5105,END=5280)
 5105 FORMAT()
 5100 CONTINUE
 5190 CONTINUE
C
C               ******************************************************
C               **  STEP 52.1--                                     **
C               **  LOOP THROUGH THE VARIOUS LINES OF THIS SECTION  **
C               **  OF THE FILE.                                    **
C               ******************************************************
C
      ISTEPN='52.1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5200I=ISTART,ISTOP
      I2=I
C
CCCCC THE FOLLOWING SECTION WAS FIXED AUGUST 1994
C               *****************************************
C               **  STEP 52.2--                        **
C               **  READ IN SUCCEEDING LINES UNTIL     **
C               **  GET A HIT BASED ON THE FIRST WORD  **
C               **  OF THE COMMAND.                    **
C               *****************************************
C
CCCCC FEBRUARY 2003: FOLLOWING PRODUCES TOO MUCH IRELEVANT OUTPUT
CCCCC ISTEPN='52.2'
CCCCC IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC FEBRUARY 2003: UP FROM 30 CHARACTERS TO 40 CHARACTERS AND
CCCCC FROM MAXIMUM OF FOUR WORDS TO MAXIMUM OF FIVE WORDS.
C
      ILIN30='                                        '
      READ(IOUNIT,5202,END=5280)ILIN30
 5202 FORMAT(A40)
      IF(ILIN30(1:4).EQ.'    ')GOTO5200
C
CCCCC COMPARE CHAR. 1 TO 4 OF THE HELP FILE LINE
CCCCC (ILIN30(1:4) AND ICTEST) WITH
CCCCC CHAR. 1 TO 4 OF THE FIRST WORD OF THE HELP COMMAND EXT (IWORD1)
C
      ICTEST=ILIN30(1:4)
      IF(ICTEST(4:4).EQ.' ' .OR. ICTEST(4:4).EQ.'-')ICTEST(4:4)=' '
      IF(ICTEST(3:3).EQ.' ' .OR. ICTEST(3:3).EQ.'-')ICTEST(3:4)='  '
      IF(ICTEST(2:2).EQ.' ' .OR. ICTEST(4:4).EQ.'-')ICTEST(2:4)='   '
C
      IF(ICTEST.EQ.IWORD1)GOTO5206
C
      GOTO5200
 5206 CONTINUE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5207)I,ILIN30(1:40)
 5207    FORMAT('I,ILIN30(1:40)=',I8,2X,A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5208)NUMARG,NUMAR2,IWORD1,ILIN30(1:4),ICTEST
 5208    FORMAT('NUMARG,NUMAR2,IWORD1,ILIN30(1:4),ICTEST = ',
     1   I8,I8,2X,A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC COMPARE CHAR. 5 TO 8 OF THE HELP FILE LINE
CCCCC (ILIN30(5:8) AND ICTEST) WITH
CCCCC CHAR. 5 TO 8 OF THE FIRST WORD OF THE HELP COMMAND EXT (IWOR12)
C
      ICTEST=ILIN30(5:8)
      IF(ILIN30(4:4).EQ.' ' .OR. ILIN30(4:4).EQ.'-')ICTEST='    '
      IF(ILIN30(3:3).EQ.' ' .OR. ILIN30(3:3).EQ.'-')ICTEST='    '
      IF(ILIN30(2:2).EQ.' ' .OR. ILIN30(2:2).EQ.'-')ICTEST='    '
      IF(ILIN30(1:1).EQ.' ' .OR. ILIN30(1:1).EQ.'-')ICTEST='    '
C
      IF(ICTEST(3:3).EQ.' ' .OR. ICTEST(3:3).EQ.'-')ICTEST(3:4)='  '
      IF(ICTEST(2:2).EQ.' ' .OR. ICTEST(2:2).EQ.'-')ICTEST(2:4)='   '
      IF(ICTEST(1:1).EQ.' ' .OR. ICTEST(1:1).EQ.'-')ICTEST(1:4)='    '
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')THEN
         WRITE(ICOUT,5209)IWOR12,ICTEST
 5209    FORMAT('IWOR12,ICTEST = ',A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC THE FOLLOWING LINE WAS CHANGED            DECEMBER 1994
CCCCC SO THAT    HELP CHAR    WOULD WORK        DECEMBER 1994
CCCCC IF(ICTEST.EQ.IWOR12)GOTO5210
CCCCC FIX SO THAT TEST DONE IF THERE IS A SECOND    JUNE 1999
CCCCC WORD TO RESOLVE NAME CONFLICTS                JUNE 1999
      IF(ICTEST(1:4).EQ.'    ')THEN
        GOTO5210
      ELSE
        IF(ICTEST.EQ.IWOR12)GOTO5210
        IF(ICTEST.NE.IWOR12)GOTO5200
      ENDIF
CCCCC GOTO5210
C
      GOTO5200
 5210 CONTINUE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')THEN
         WRITE(ICOUT,5211)NUMARG,NUMAR2,IWOR12,ILIN30(5:8),ICTEST
 5211    FORMAT('NUMARG,NUMAR2,IWOR12,ILIN30(5:8),ICTEST = ',
     1   I8,I8,2X,A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS FIXED    AUGUST 1994
C               ***********************************************
C               **  STEP 52.3--                              **
C               **  IF GOT A HIT ON THE FIRST 4-CHAR. WORD,  **
C               **  CHECK FOR A HIT ON ALL 4-CHAR WORDS      **
C               ***********************************************
C
      ISTEPN='52.3'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTRIN(1:40)=ILIN30(1:40)
C
      NUMWHF=1
      ILOC2=1
      ILOC3=1
      ILOC4=1
      ILOC5=1
      DO5220J=1,39
         JP1=J+1
         IF((ISTRIN(J:J).EQ.' ' .OR. ISTRIN(J:J).EQ.'-').AND.
     1       ISTRIN(JP1:JP1).NE.' ')THEN
            NUMWHF=NUMWHF+1
            IF(NUMWHF.EQ.2)ILOC2=JP1
            IF(NUMWHF.EQ.3)ILOC3=JP1
            IF(NUMWHF.EQ.4)ILOC4=JP1
            IF(NUMWHF.EQ.5)ILOC5=JP1
         ENDIF
 5220 CONTINUE
      ILOC2P=ILOC2+3
      ILOC3P=ILOC3+3
      ILOC4P=ILOC4+3
      ILOC5P=ILOC5+3
C
      IZ1=ILIN30(1:4)
      IZ2(1:4)='    '
      IF(NUMWHF.GE.2)IZ2(1:4)=ISTRIN(ILOC2:ILOC2P)
      IZ3(1:4)='    '
      IF(NUMWHF.GE.3)IZ3(1:4)=ISTRIN(ILOC3:ILOC3P)
      IZ4(1:4)='    '
      IF(NUMWHF.GE.4)IZ4(1:4)=ISTRIN(ILOC4:ILOC4P)
      IZ5(1:4)='    '
      IF(NUMWHF.GE.5)IZ5(1:4)=ISTRIN(ILOC5:ILOC5P)
C
      DO5225J=2,4
        IF(IZ1(J:J).EQ.' '.OR.IZ1(J:J).EQ.'-')IZ1(J:4)=' '
        IF(IZ2(J:J).EQ.' '.OR.IZ2(J:J).EQ.'-')IZ2(J:4)=' '
        IF(IZ3(J:J).EQ.' '.OR.IZ3(J:J).EQ.'-')IZ3(J:4)=' '
        IF(IZ4(J:J).EQ.' '.OR.IZ4(J:J).EQ.'-')IZ4(J:4)=' '
        IF(IZ5(J:J).EQ.' '.OR.IZ5(J:J).EQ.'-')IZ5(J:4)=' '
 5225 CONTINUE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')THEN
         WRITE(ICOUT,5231)
 5231    FORMAT('***** FROM 1731 IN MIDDLE OF DPHELP--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5232)IWORD1,IWOR12,IWORD2,IWORD3,IWORD4,IWORD5
 5232    FORMAT('IWORD1,IWOR12,IWORD2,IWORD3,IWORD4,IWORD5 = ',
     1   A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5233)ILIN30(1:40)
 5233    FORMAT('ILIN30(1:40) = ',A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5234)IZ1,IZ2,IZ3,IZ4,IZ5
 5234    FORMAT('IZ1,IZ2,IZ3,IZ4 = ',A4,2X,A4,2X,A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5235)ISTRIN
 5235    FORMAT('ISTRIN = ',A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5236)NUMARG,NUMAR2,NUMWHF
 5236    FORMAT('NUMARG,NUMAR2,NUMWHF = ',3I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5237)ILOC2,ILOC3,ILOC4,ILOC5
 5237    FORMAT('ILOC2,ILOC3,ILOC4,ILOC5 = ',4I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5238)ILOC2P,ILOC3P,ILOC4P,ILOC5P
 5238    FORMAT('ILOC2P,ILOC3P,ILOC4P,ILOC5P = ',4I8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1994
         IF(NUMAR2.NE.NUMWHF)GOTO5200
C
 5252 CONTINUE
      IF(NUMAR2.LE.1)GOTO5290
      IF(NUMWHF.LE.1)GOTO5290
C
      IF(IZ2.EQ.IWORD2)GOTO5253
C
      GOTO5200
C
 5253 CONTINUE
      IF(NUMAR2.LE.2)GOTO5290
      IF(NUMWHF.LE.2)GOTO5290
C
      IF(IZ3.EQ.IWORD3)GOTO5254
C
      GOTO5200
C
 5254 CONTINUE
      IF(NUMAR2.LE.3)GOTO5290
      IF(NUMWHF.LE.3)GOTO5290
C
      IF(IZ4.EQ.IWORD4)GOTO5255
C
      GOTO5200
C
 5255 CONTINUE
      IF(NUMAR2.LE.4)GOTO5290
      IF(NUMWHF.LE.4)GOTO5290
C
      IF(IZ5.EQ.IWORD5)GOTO5290
C
      GOTO5200
C
 5200 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS  CHANGED     AUGUST 1994 (JJF)
 5280 CONTINUE
      IERROR='YES'
      IF(IPASS.GE.2)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5281)
 5281    FORMAT('***** ERROR IN DPHELP--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5282)
 5282    FORMAT('      THE SPECIFIED COMMAND FOR WHICH')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5283)
 5283    FORMAT('      HELP WAS DESIRED WAS NOT FOUND')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5284)
 5284    FORMAT('      IN THE HELP FILE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5285)
 5285    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5286)(IANS(I),I=1,IWIDTH)
 5286    FORMAT('      ',120A1)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO6100
C
 5290 CONTINUE
C
C               ****************************************************
C               **  STEP 53--                                     **
C               **  IF HAVE A HIT ON ALL WORDS,                   **
C               **  THEN READ IN AND WRITE OUT                    **
C               **  THE ENTIRE TEXT DESCRIPTION ASSOCIATED WITH   **
C               **  THE DESIRED COMMAND.                          **
C               **  THIS DESCRIPTION WILL START ON THE NEXT LINE  **
C               **  AND WILL FINISH WHEN A LINE OF HYPHENS        **
C               **  IS ENCOUNTERED.                               **
C               ****************************************************
C
 5300 CONTINUE
      ISTEPN='53'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLPR=0
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      IRESP='YES'
      IF(NCPREH.LE.0)GOTO5319
      WRITE(ICOUT,5311)(ICPREH(J:J),J=1,NCPREH)
 5311 FORMAT(80A1)
CCCCC CALL DPWRST('XXX','BUG ')    SEPTEMBER 1993
      CALL DPWRST('XXX','WRIT')
 5319 CONTINUE
C
      WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')    SEPTEMBER 1993
      CALL DPWRST('XXX','WRIT')
CCCCC DO5320I=1,2
      DO5320I=1,100000
      READ(IOUNIT,5321,END=5390)(ICTEXT(J),J=1,20)
 5321 FORMAT(20A4)
      IF(ICTEXT(1).EQ.'----')GOTO5390
      IF(ICTEXT(1).EQ.'....')GOTO5390
C
CCCCC THE FOLLOWING 11 LINES WERE COMMENTED OUT JULY 1989
CCCCC IF(NUMLPR.LT.IHELMX)GOTO5329
CCCCC WRITE(ICOUT,5322)
C5322 FORMAT('                                      MORE...')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC READ(IRD,5323)
C5323 FORMAT()
CCCCC NUMLPR=0
CCCCC IF(NCPREH.LE.0)GOTO5327
CCCCC WRITE(ICOUT,5326)(ICPREH(J:J),J=1,NCPREH)
C5326 FORMAT(80A1)
CCCCC CALL DPWRST('XXX','BUG ')
C5327 CONTINUE
C5329 CONTINUE
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 1989
CCCCC (AND THEN FIXED NOVEMBER 1989--AS PER NELSON HSU)
CCCCC IF(NUMLPR.GE.IHELMX)
CCCCC1CALL DPMORE(NUMLPR,NCPREH,ICPREH,IBUGS2,IERRO)
CCCCC THE FOLLOWING 2 LINES WERE MODIFIED JULY 1990
CCCCC IF(NUMLPR.GE.IHELMX)
CCCCC1CALL DPMORE(NUMLPR,NCPREH,ICPREH,IBUGS2,IERROR)
      IF(NUMLPR.GE.IHELMX)
     1CALL DPMORE(NUMLPR,NCPREH,ICPREH,IRESP,IBUGS2,IERROR)
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1990
      IF(NUMLPR.GE.IHELMX)NUMLPR=0
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      IF(IRESP.EQ.'NO')GOTO5390
C
      DO5330J=1,20
      JREV=20-J+1
      IF(ICTEXT(JREV).NE.'    ')GOTO5335
 5330 CONTINUE
 5335 CONTINUE
      JMAX=JREV
C
      WRITE(ICOUT,5336)(ICTEXT(J),J=1,JMAX)
 5336 FORMAT(20A4)
CCCCC CALL DPWRST('XXX','BUG ')    SEPTEMBER 1993
      CALL DPWRST('XXX','WRIT')
      NUMLPR=NUMLPR+1
 5320 CONTINUE
C
 5390 CONTINUE
C
      IF(NCPOSH.LE.0)GOTO5399
      WRITE(ICOUT,5391)(ICPOSH(J:J),J=1,NCPOSH)
 5391 FORMAT(80A1)
CCCCC CALL DPWRST('XXX','BUG ')    SEPTEMBER 1993
      CALL DPWRST('XXX','WRIT')
 5399 CONTINUE
C
C               **************************************
C               **  STEP 61--                       **
C               **  CLOSE           THE HELP FILE.  **
C               **************************************
C
 6100 CONTINUE
C
      ISTEPN='61'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
CCCCC THE FOLLOWING LINE WAS FIXED    AUGUST 1994
CCCCC1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERRO2)
      IF(IERRFI.EQ.'YES')GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED         AUGUST 1994
CCCCC TO SEARCH A SYNONYM FILE (DPHE7F.TEX)   AUGUST 1994
C               ***********************************************
C               **  STEP 62--                                **
C               ** IF PASS 1 AND NOT FOUND IN FILES 1 TO 6,  **
C               ** THEN SCAN SYNONYM FILE FOR MATCH          **
C               ** AND TRY AGAIN IN FILES 1 TO 6             **
C               ***********************************************
C
 6200 CONTINUE
      IF(IPASS.EQ.1.AND.IERROR.EQ.'YES')THEN
         IOUNIT=IHE7NU
         IFILE=IHE7NA
         ISTAT=IHE7ST
         IFORM=IHE7FO
         IACCES=IHE7AC
         IPROT=IHE7PR
         ICURST=IHE7CS
         ISUBN0='HEL2'
         IERRFI='NO'
         IREWIN='ON'
         CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1   IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERRO2)
         IF(IERRFI.EQ.'YES')GOTO9000
C
CCCCC CORRECTIONS WERE MADE IN THE FOLLOWING SECTION DECEMBER 1994
         IMATCH=0
         DO6210I=1,5
            READ(IOUNIT,6211)ICJUNK
 6211       FORMAT(A1)
 6210    CONTINUE
         DO6220I=1,10000
            READ(IOUNIT,6221,END=6229)ILINE(1:80)
 6221       FORMAT(A80)
            IF(ILINE(1:4).EQ.IWORD1.AND.ILINE(5:8).EQ.IWOR12)THEN
               IF(ILINE(10:13).EQ.IWORD2)THEN
                  IF(ILINE(15:18).EQ.IWORD3)THEN
                     IF(ILINE(20:23).EQ.IWORD4)THEN
                        IF(ILINE(25:28).EQ.IWORD5)THEN
                          IMATCH=1
                          IWORD1=ILINE(41:44)
                          IWOR12=ILINE(45:48)
                          IWORD2=ILINE(50:53)
                          IWORD3=ILINE(55:58)
                          IWORD4=ILINE(60:63)
                          IWORD5=ILINE(65:68)
                          NUMAR2=5
                          IF(IWORD5.EQ.'    ')NUMAR2=4
                          IF(IWORD4.EQ.'    ')NUMAR2=3
                          IF(IWORD3.EQ.'    ')NUMAR2=2
                          IF(IWORD2.EQ.'    ')NUMAR2=1
                       ENDIF
                     ENDIF
                  ENDIF
               ENDIF
            ENDIF
 6220    CONTINUE
 6229    CONTINUE
C
         IENDFI='OFF'
         IREWIN='ON'
         CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1   IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERRO2)
         IF(IERRFI.EQ.'YES')GOTO9000
C
CCCCC THE FOLLOWING I/O SECTION WAS ADDED     DECEMBER 1994
         IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6231)
 6231       FORMAT('FROM DPHELP AT 6231--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6232)IWORD1,IWOR12,IWORD2,IWORD3,IWORD4
 6232       FORMAT(A4,2X,A4,2X,A4,2X,A4,2X,A4)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6233)NUMAR2,IMATCH
 6233       FORMAT('NUMAR2,IMATCH = ',2I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
         ENDIF
C
         IF(IMATCH.EQ.1)THEN
            IERROR='NO'
            GOTO1000
         ENDIF
      ENDIF
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HELP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHELP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR,IERRO2
 9012 FORMAT('IBUGS2,ISUBRO,IERROR,IERRO2 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 12 LINES WERE COMMENTED OUT APRIL 1992
CCCCC WRITE(ICOUT,9021)IHE1CO,IHE1AL
C9021 FORMAT('IHE1CO,IHE1AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9022)IHE2CO,IHE2AL
C9022 FORMAT('IHE2CO,IHE2AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9023)IHE3CO,IHE3AL
C9023 FORMAT('IHE3CO,IHE3AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9024)IHE4CO,IHE4AL
C9024 FORMAT('IHE4CO,IHE4AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9025)IHE5CO,IHE5AL
C9025 FORMAT('IHE5CO,IHE5AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9026)IHE6CO,IHE6AL
C9026 FORMAT('IHE6CO,IHE6AL = ',A12,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,9028)IBUGHE,IBUGH2,IFOUND,IERROR
C9028 FORMAT('IBUGHE,IBUGH2,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGS2,IFOUND,IERROR
 9028 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IOUNIT
 9031 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IFILE
 9032 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)ISTAT
 9033 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IFORM
 9034 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IACCES
 9035 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IPROT
 9036 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)ICURST
 9037 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)IENDFI
 9038 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IREWIN
 9039 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)ISUBN0
 9041 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IERRFI
 9042 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IWORD1,IWORD2,ICHAR1
 9043 FORMAT('IWORD1,IWORD2,ICHAR1 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)JFILE,JSEC,ISTART
 9044 FORMAT('JFILE,JSEC,ISTART = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)ISKIP,ISTART,ISTOP,JMAX
 9051 FORMAT('ISKIP,ISTART,ISTOP,JMAX = ',4I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE CHANGED AUGUST 1994
CCCCC WRITE(ICOUT,9060)IW1,ICTEST,IWORD1,IWOR12
C9060 FORMAT('IW1,ICTEST,IWORD1,IWOR12 = ',A4,2X,A4,2X,A4,2X,A4)
      WRITE(ICOUT,9060)ILIN30(1:30),ICTEST,IWORD1,IWOR12
 9060 FORMAT('ILIN30(1:30),ICTEST,IWORD1,IWOR12=',A30,2X,A4,A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)NUMSEC,NUMLIN,ISECNA
 9061 FORMAT('NUMSEC,NUMLIN,ISECNA = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)NUMARG,NUMAR2
 9062 FORMAT('NUMARG,NUMAR2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9063)IWORD1,IWORD2,IWORD3,IWORD4,IWOR12
 9063 FORMAT('IWORD1,IWORD2,IWORD3,IWORD4,IWOR12 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE CHANGED AUGUST 1994
CCCCC WRITE(ICOUT,9064)IW1,IW2,IW3,IW4,IW5
C9064 FORMAT('IW1,IW2,IW3,IW4,IW5 = ',A4,2X,A4,2X,A4,2X,A4,2X,A4)
      WRITE(ICOUT,9064)ILIN30(1:30)
 9064 FORMAT('ILIN30(1:30) = ',A30)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9065)IZ1,IZ2,IZ3,IZ4,IZ5
 9065 FORMAT('IZ1,IZ2,IZ3,IZ4,IZ5 = ',A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9066)ISTRIN
 9066 FORMAT('ISTRIN = ',A40)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9067)NUMWHF
 9067 FORMAT('NUMWHF = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9068)ILOC2,ILOC3,ILOC4,ILOC5
 9068 FORMAT('ILOC2,ILOC3,ILOC4,ILOC5 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9069)ILOC2P,ILOC3P,ILOC4P,ILOC5P
 9069 FORMAT('ILOC2P,ILOC3P,ILOC4P,ILOC5P = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9071)ICHAR1
 9071 FORMAT('ICHAR1 = ',A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9072)JCHAR1,JSEC,JSECP1
 9072 FORMAT('JCHAR1,JSEC,JSECP1 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9073)ITABLN(JSEC),ITABLN(JSECP1)
 9073 FORMAT('ITABLN(JSEC),ITABLN(JSECP1) = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9074)ITABID(JSEC),ITABID(JSECP1)
 9074 FORMAT('ITABID(JSEC),ITABID(JSECP1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9075)ISTART,ISTOP
 9075 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9077)I2
 9077 FORMAT('I2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9079)IBUGS2,ISUBRO,IERROR
 9079 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9081)IHELMX
 9081 FORMAT('IHELMX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPREH.LE.0)GOTO9084
      DO9082I=1,NCPREH
      WRITE(ICOUT,9083)I,ICPREH(I:I)
 9083 FORMAT('I,ICPREH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
 9082 CONTINUE
 9084 CONTINUE
      WRITE(ICOUT,9086)NCPOSH
 9086 FORMAT('NCPOSH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPOSH.LE.0)GOTO9089
      DO9087I=1,NCPOSH
      WRITE(ICOUT,9088)I,ICPOSH(I:I)
 9088 FORMAT('I,ICPOSH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
 9087 CONTINUE
 9089 CONTINUE
CCCCC THE FOLLOWING 3 LINES WERE ADDED JULY 1990
      WRITE(ICOUT,9091)IRESP
 9091 FORMAT('IRESP = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 3 LINES WERE ADDED AUGUST 1994
      WRITE(ICOUT,9093)IERROR,IERRO2,IPASS,IMATCH
 9093 FORMAT('IERROR,IERRO2,IPASS,IMATCH = ',A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9094)ILINE
 9094 FORMAT('ILINE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9095)IWORD1,IWOR12,IWORD2
 9095 FORMAT('IWORD1,IWOR12,IWORD2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9096)IWORD3,IWORD4
 9096 FORMAT('IWORD3,IWORD4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHELW(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,IANS,
     1IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--ACCESS THE ON-LINE DATAPLOT REFERENCE MANUAL VIA
C              A WEB BROWSER (DEFAULTS TO NETSCAPE).  A PDF READER,
C              TYPICALLY THE ADOBE "ACROREAD" IS USED.  CURRENTLY,
C              THIS IS ONLY SUPPORTED FOR UNIX SYSTEMS (THE PC
C              VERSION IS A LITTLE HARDER TO ACCESS IN COMMAND MODE).
C
C              THIS COMMAND TAKES THE FOLLOWING FORMS:
C                  WEB HELP           - GO TO MAIN DATAPLOT HOME PAGE
C                  WEB HELP HOME PAGE - GO TO MAIN DATAPLOT HOME PAGE
C                  WEB HELP REFERENCE MANUAL - GO TO MAIN PAGE OF
C                                              REFERENCE MANUAL
C                  WEB HELP <KEYWORD> - GO TO A PARTICULAR PDF FILE
C                                       IN THE ON-LINE MANUAL BASED
C                                       ON MATCHING <KEYWORD> TO A
C                                       FILE (REFMAN.TEX)
C     INPUT  ARGUMENTS--IANS    (A  HOLLERITH VECTOR)
C                     --IWIDTH (AN INTEGER VARIABLE)
C                     --IBROWS  (A CHARACTER VARIABLE THAT IDENTIFIES
C                               THE BROWSER TO USE)
C                     --IDPURL  (A CHARACTER VARIABLE THAT IDENTIFIES
C                               THE WEB URL OF THE DATAPLOT HOME PAGE)
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/4
C     ORIGINAL VERSION--APRIL     1997.
C     UPDATED         --NOVEMBER  1997. BETTER CHECKING FOR NAME CONFLICTS
C     UPDATED         --FEBRUARY  2003. CHECK FOR 5 WORDS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IANS
      CHARACTER*1 IQUOTE
      CHARACTER*40 ILINE1
      CHARACTER*40 ILINE2
      CHARACTER*500 ICALL
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 ISUBN0
      CHARACTER*4 IERRFI
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
C
      CHARACTER*4 IWORD1
      CHARACTER*4 IWORD2
      CHARACTER*4 IWORD3
      CHARACTER*4 IWORD4
      CHARACTER*4 IWORD5
      CHARACTER*4 IWOR12
C
      CHARACTER*4 IBRWFL
C
      CHARACTER*1 ICHAR1
C
      CHARACTER*4 ICTEST
      CHARACTER*4 ICTES2
C
      CHARACTER*4 IZ1
      CHARACTER*4 IZ2
      CHARACTER*4 IZ3
      CHARACTER*4 IZ4
      CHARACTER*4 IZ5
C
      CHARACTER*40 ISTRIN
      CHARACTER*4 IERRO2
      CHARACTER*1 ICJUNK
      CHARACTER*80 ILINE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
      DIMENSION IARGT(*)
      DIMENSION IANS(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.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='DPHE'
      ISUBN2='LW  '
      NUMLIN=(-999)
      NUMSEC=(-999)
      ISECNA=(-999)
C
      NUMAR2=(-999)
C
      IWORD1='    '
      IWORD2='    '
      IWORD3='    '
      IWORD4='    '
      IWORD5='    '
      IWOR12='    '
C
      ICTEST='    '
      ICTES2='    '
C
      ILINE1='                              '
C
      IZ1='    '
      IZ2='    '
      IZ3='    '
      IZ4='    '
      IZ5='    '
C
      JCHAR1=(-999)
      JSEC=(-999)
      JSECP1=(-999)
C
      ISKIP=(-999)
      ISTART=(-999)
      ISTOP=(-999)
      I2=(-999)
C
      ISTRIN='                              '
C
      NUMWHF=(-999)
      ILOC2=(-999)
      ILOC3=(-999)
      ILOC4=(-999)
      ILOC5=(-999)
C
      ILOC2P=(-999)
      ILOC3P=(-999)
      ILOC4P=(-999)
      ILOC5P=(-999)
C
      CALL DPCONA(39,IQUOTE)
C
      IFOUND='YES'
      IERROR='NO'
C
      ISHIFT=1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGS2,IERROR)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HELW')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHELW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IWIDTH
   54 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(IANS(I),I=1,IWIDTH)
   55 FORMAT('IANS(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)IBROWS(1:80)
   86 FORMAT('IBROWS = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IDPURL(1:80)
   88 FORMAT('IDPURL = ',A80)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IF(
     1       (IHOST1.EQ.'SUN') .OR.
     1       (IHOST1.EQ.'CRAY' .AND. IOPSY1.EQ.'UNIX') .OR.
     1       (IHOST1.EQ.'CONV') .OR.
     1       (IHOST1.EQ.'SGI ') .OR.
     1       (IHOST1.EQ.'HP-9') .OR.
     1       (IHOST1.EQ.'AIX ') .OR.
     1       (IHOST1.EQ.'LINU') .OR.
     1       (IOPSY1.EQ.'UNIX'))GOTO199
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO199
  100 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** FROM DPHELW--WEB HELP CURRENTLY ONLY SUPPORTED ',
     1'UNIX OR IBM-PC WINDOW 95/NT PLATFORMS.')
  199 CONTINUE
C
C               **********************************************************
C               **  STEP 21--                                           **
C               **  COPY OVER THE FIRST 4 WORDS AFTER THE WORDS WEB HELP**
C               **********************************************************
C
      IPASS=0
 1000 CONTINUE
      IPASS=IPASS+1
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPASS.LE.1)THEN
         IWORD1=IHARG(1)
         IWOR12=IHARG2(1)
         IWORD2=IHARG(2)
         IWORD3=IHARG(3)
         IWORD4=IHARG(4)
         IWORD5=IHARG(5)
         NUMAR2=NUMARG
      ENDIF
C
      IF(NUMAR2.LE.0)THEN
         NUMAR2=1
         IWORD1='HOME'
         IWOR12='PAGE'
      ENDIF
C
      IF(IWORD1.EQ.'HOME'.AND.IWOR12.EQ.'PAGE')GOTO5099
C
C             ********************************************************
C             **  STEP 22--                                         **
C             **  STRIP OUT THE FIRST CHARACTER OF THE FIRST WORD.  **
C             ********************************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELW')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICHAR1=IWORD1(1:1)
C
C               *******************************
C               **  STEP 32--                **
C               **  COPY OVER FILE VARIABLES **
C               *******************************
C
      ISTEPN='32'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 3210 CONTINUE
      IOUNIT=IHRMNU
      IFILE=IHRMNA
      ISTAT=IHRMST
      IFORM=IHRMFO
      IACCES=IHRMAC
      IPROT=IHRMPR
      ICURST=IHRMCS
      ISUBN0='HELW'
      IERRFI='NO'
C
 3291 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HELW')GOTO3299
      WRITE(ICOUT,3293)IOUNIT
 3293 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3294)IFILE
 3294 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3295)ISTAT,IFORM,IACCES,IPROT,ICURST
 3295 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3296)IBUGS2,ISUBRO,ISUBN0,IERRFI
 3296 FORMAT('IBUGS2,ISUBRO,ISUBN0,IERRFI = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 3299 CONTINUE
C
C               ****************************************
C               **  STEP 33--                         **
C               **  CHECK TO SEE IF HELP FILE EXISTS  **
C               ****************************************
C
      ISTEPN='33'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELW')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO3300
      GOTO3390
 3300 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3311)
 3311 FORMAT('***** ERROR IN DPHELW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3312)
 3312 FORMAT('      THE DESIRED HELP INFORMATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3313)
 3313 FORMAT('      CANNOT BE GIVEN BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3314)
 3314 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3315)
 3315 FORMAT('      WHICH STORES SUCH HELP INFORMATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3316)
 3316 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3317)ISTAT,IHRMST
 3317 FORMAT('ISTAT,IHELST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3318)IFILE(1:50)
 3318 FORMAT('IFILE(1:50) = ',A50)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 3390 CONTINUE
C
C               *********************
C               **  STEP 34--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='34'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ******************************************************
C               **  STEP 52.1--                                     **
C               **  LOOP THROUGH THE VARIOUS LINES OF THIS SECTION  **
C               **  OF THE FILE.                                    **
C               ******************************************************
C
 5099 CONTINUE
      ISTEPN='52.1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICALL=' '
      DO5100I=MAXBRO,1,-1
         NUMBRO=I
         IF(IBROWS(I:I).NE.' ')GOTO5109
 5100 CONTINUE
 5109 CONTINUE
      IF(NUMBRO.GT.0)THEN
        ICALL(1:NUMBRO)=IBROWS(1:NUMBRO)
        NCSTR=NUMBRO+1
        ICALL(NCSTR:NCSTR)=' '
      ELSE
        ICALL(1:9)='netscape '
        NCSTR=9
      ENDIF
C
      IBRWFL='NETS'
      IF(NUMBRO.GE.8)THEN
        DO5125I=1,NUMBRO-7
          IF(IBROWS(I:I+7).EQ.'IEXPLORE' .OR.
     1       IBROWS(I:I+7).EQ.'iexplore')THEN
             IBRWFL='IEXP'
             GOTO5128
          ENDIF
 5125   CONTINUE
 5128   CONTINUE
      ENDIF
C
      DO5110I=MAXURL,1,-1
         NUMURL=I
         IF(IDPURL(I:I).NE.' ')GOTO5119
 5110 CONTINUE
 5119 CONTINUE
C
C  IF "SET NETSCAPE OLD" COMMAND WAS ENTERED, THEN USE 
C  -remote NETSCAPE OPTION.  THIS ONLY APPLIES TO UNIX PLATFORMS.
C
      IF(IHOST1.EQ.'IBM-')THEN
        IF(IBRWFL.EQ.'NETS')THEN
          NCSTR=NCSTR+1
          NCSTR2=NCSTR+3
          ICALL(NCSTR:NCSTR2)=' -h '
          NCSTR=NCSTR2
        ENDIF
        GOTO5129 
      ENDIF
      IF(INETSW.EQ.'OLD'.AND.IHOST1.NE.'IBM-')THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+8
        ICALL(NCSTR:NCSTR2)=' -remote '
        NCSTR=NCSTR2+1
        ICALL(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+7
        ICALL(NCSTR:NCSTR2)='openURL('
        NCSTR=NCSTR2
      ENDIF
C
 5129 CONTINUE
      IF(NUMURL.GT.0)THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+NUMURL-1
        ICALL(NCSTR:NCSTR2)=IDPURL(1:NUMURL)
        N1URL=NCSTR
        N2URL=NCSTR2
        NCSTR=NCSTR2
      ELSE
        NCSTR=NCSTR+1
        N1URL=NCSTR
        NCSTR2=NCSTR+6
        ICALL(NCSTR:NCSTR2)='http://'
        NCSTR=NCSTR2
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+16
        ICALL(NCSTR:NCSTR2)='www.itl.nist.gov/'
        NCSTR=NCSTR2
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+28
        ICALL(NCSTR:NCSTR2)='itl/div898/software/dataplot/'
        NCSTR=NCSTR2
        N2URL=NCSTR2
      ENDIF
C
      IF(IWORD1.EQ.'HOME'.AND.IWOR12.EQ.'PAGE')GOTO5300
      ISTEPN='52.2'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      DO5200I=1,100000
      ILINE1=' '
      ILINE2=' '
      I2=I
C
C               *****************************************
C               **  STEP 52.2--                        **
C               **  READ IN SUCCEEDING LINES UNTIL     **
C               **  GET A HIT BASED ON THE FIRST WORD  **
C               **  OF THE COMMAND.                    **
C               *****************************************
C
CCCCC ISTEPN='52.2'
CCCCC IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      READ(IOUNIT,5202,END=5280)ILINE1,ILINE2
 5202 FORMAT(A40,A40)
      IF(ILINE1(1:4).EQ.'    ')GOTO5200
C
CCCCC COMPARE CHAR. 1 TO 4 OF THE HELP FILE LINE
CCCCC (ILINE1(1:4) AND ICTEST) WITH
CCCCC CHAR. 1 TO 4 OF THE FIRST WORD OF THE HELP COMMAND EXT (IWORD1)
C
CCCCC NOVEMBER 1997.  THIS SECTION REWRITTEN TO SIMPLIFY AND TO
CCCCC CHECK FOR NAME CONFLICTS (I.E., USE CHARACTERS 5-8 IF NEEDED).
      ICTEST=' '
      ICTES2=' '
      NBLANK=9
      DO5203II=1,8
        IF(ILINE1(II:II).EQ.' ')THEN
          NBLANK=II
          GOTO5204
        ENDIF
 5203 CONTINUE
 5204 CONTINUE
      IF(NBLANK.LE.5)THEN
        ICTEST(1:NBLANK-1)=ILINE1(1:NBLANK-1)
      ELSE
        ICTEST(1:4)=ILINE1(1:4)
        ICTES2(1:NBLANK-5)=ILINE1(5:NBLANK-1)
      ENDIF
C
      IF(ICTEST.NE.IWORD1.OR.ICTES2.NE.IWOR12)GOTO5200
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELW')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5207)I,ILINE1(1:40)
 5207    FORMAT('I,ILINE1(1:20)=',I8,2X,A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5208)NUMARG,NUMAR2,IWORD1,IWOR12,ICTEST,ICTES2
 5208    FORMAT('NUMARG,NUMAR2,IWORD1,IWOR12,ICTEST,ICTES2 = ',
     1   I8,I8,2X,A4,2X,A4,2X,A4,2x,A4)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***********************************************
C               **  STEP 52.3--                              **
C               **  IF GOT A HIT ON THE FIRST 4-CHAR. WORD,  **
C               **  CHECK FOR A HIT ON ALL 4-CHAR WORDS      **
C               ***********************************************
C
      ISTEPN='52.3'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELW')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTRIN(1:40)=ILINE1(1:40)
C
      NUMWHF=1
      ILOC2=1
      ILOC3=1
      ILOC4=1
      ILOC5=1
      DO5220J=1,39
         JP1=J+1
         IF(ISTRIN(J:J).EQ.' '.AND.ISTRIN(JP1:JP1).NE.' ')THEN
            NUMWHF=NUMWHF+1
            IF(NUMWHF.EQ.2)ILOC2=JP1
            IF(NUMWHF.EQ.3)ILOC3=JP1
            IF(NUMWHF.EQ.4)ILOC4=JP1
            IF(NUMWHF.EQ.5)ILOC5=JP1
         ENDIF
 5220 CONTINUE
      ILOC2P=ILOC2+3
      ILOC3P=ILOC3+3
      ILOC4P=ILOC4+3
      ILOC5P=ILOC5+3
C
      IZ1=ILINE1(1:4)
      IZ2(1:4)='    '
      IF(NUMWHF.GE.2)IZ2(1:4)=ISTRIN(ILOC2:ILOC2P)
      IZ3(1:4)='    '
      IF(NUMWHF.GE.3)IZ3(1:4)=ISTRIN(ILOC3:ILOC3P)
      IZ4(1:4)='    '
      IF(NUMWHF.GE.4)IZ4(1:4)=ISTRIN(ILOC4:ILOC4P)
      IZ5(1:4)='    '
      IF(NUMWHF.GE.5)IZ5(1:4)=ISTRIN(ILOC5:ILOC5P)
C
      DO5225J=2,4
        IF(IZ1(J:J).EQ.' ')IZ1(J:4)=' '
        IF(IZ2(J:J).EQ.' ')IZ2(J:4)=' '
        IF(IZ3(J:J).EQ.' ')IZ3(J:4)=' '
        IF(IZ4(J:J).EQ.' ')IZ4(J:4)=' '
        IF(IZ5(J:J).EQ.' ')IZ5(J:4)=' '
 5225 CONTINUE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELW')THEN
         WRITE(ICOUT,5231)
 5231    FORMAT('***** FROM 1731 IN MIDDLE OF DPHELW--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5232)IWORD1,IWOR12,IWORD2,IWORD3,IWORD4,IWORD5
 5232    FORMAT('IWORD1,IWOR12,IWORD2,IWORD3,IWORD4,IWORD5 = ',
     1   A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5233)ILINE1(1:40)
 5233    FORMAT('ILINE1(1:40) = ',A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5234)IZ1,IZ2,IZ3,IZ4,IZ5
 5234    FORMAT('IZ1,IZ2,IZ3,IZ4,IZ5 = ',A4,2X,A4,2X,A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5235)ISTRIN
 5235    FORMAT('ISTRIN = ',A40)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5236)NUMARG,NUMAR2,NUMWHF
 5236    FORMAT('NUMARG,NUMAR2,NUMWHF = ',3I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5237)ILOC2,ILOC3,ILOC4,ILOC5
 5237    FORMAT('ILOC2,ILOC3,ILOC4,ILOC5 = ',4I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5238)ILOC2P,ILOC3P,ILOC4P,ILOC5P
 5238    FORMAT('ILOC2P,ILOC3P,ILOC4P,ILOC5P = ',4I8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1994
         IF(NUMAR2.NE.NUMWHF)GOTO5200
C
 5252 CONTINUE
      IF(NUMAR2.LE.1)GOTO5290
      IF(NUMWHF.LE.1)GOTO5290
C
      IF(IZ2.EQ.IWORD2)GOTO5253
C
      GOTO5200
C
 5253 CONTINUE
      IF(NUMAR2.LE.2)GOTO5290
      IF(NUMWHF.LE.2)GOTO5290
C
      IF(IZ3.EQ.IWORD3)GOTO5254
C
      GOTO5200
C
 5254 CONTINUE
      IF(NUMAR2.LE.3)GOTO5290
      IF(NUMWHF.LE.3)GOTO5290
C
      IF(IZ4.EQ.IWORD4)GOTO5255
C
      GOTO5200
C
 5255 CONTINUE
      IF(NUMAR2.LE.3)GOTO5290
      IF(NUMWHF.LE.3)GOTO5290
C
      IF(IZ5.EQ.IWORD5)GOTO5290
C
      GOTO5200
C
 5200 CONTINUE
C
 5280 CONTINUE
      IERROR='YES'
      IF(IPASS.GE.2)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5281)
 5281    FORMAT('***** ERROR IN DPHELW--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5282)
 5282    FORMAT('      THE SPECIFIED COMMAND FOR WHICH')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5283)
 5283    FORMAT('      WEB HELP WAS DESIRED WAS NOT FOUND')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5284)
 5284    FORMAT('      IN THE HELP FILE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5285)
 5285    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5286)(IANS(I),I=1,IWIDTH)
 5286    FORMAT('      ',120A1)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO6100
C
 5290 CONTINUE
C
C               ****************************************************
C               **  STEP 53--                                     **
C               **  IF HAVE A HIT ON ALL WORDS,                   **
C               **  THEN USE DPSYS2 TO MAKE A SYSTEM CALL         **
C               **  TO INIATE NETSCAPE.                           **
C               **  CHECK IF URL BEGINS WITH http (A FEW SPECIAL  **
C               **  CASES GO TO NON-DATAPLOT WEB PAGE             **
C               ****************************************************
C
 5300 CONTINUE
      ISTEPN='53'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELW')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IWORD1.EQ.'HOME'.AND.IWOR12.EQ.'PAGE')THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+12
        ICALL(NCSTR:NCSTR2)='homepage.html'
        NCSTR=NCSTR2
        GOTO5349
      ENDIF
C
      DO5330J=40,1,-1
        NTEMP=J
        IF(ILINE2(J:J).NE.' ')GOTO5339
 5330 CONTINUE
 5339 CONTINUE
      IF(NTEMP.LE.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5351)
        CALL DPWRST('XXX','BUG ')
        ILINE2(1:13)='homepage.html'
        NTEMP=13
      ENDIF
 5351 FORMAT('***** WARNING: NO MATCH FOUND, DEFAULT TO DATAPLOT ',
     1'HOME PAGE.')
C
C  ABSOLUTE URL ADDRESS FOUND
C
      IF(ILINE2(1:5).EQ.'http:')THEN
        ICALL(N1URL:N2URL)=' '
        NCSTR=N1URL-1
      ENDIF
C
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+NTEMP-1
      ICALL(NCSTR:NCSTR2)=ILINE2(1:NTEMP)
      NCSTR=NCSTR2
 5349 CONTINUE
      IF(INETSW.EQ.'OLD'.AND.IHOST1.NE.'IBM-')THEN
        NCSTR=NCSTR+1
        ICALL(NCSTR:NCSTR)=')'
        NCSTR=NCSTR+1
        ICALL(NCSTR:NCSTR)=IQUOTE
      ENDIF
      IF(IHOST1.NE.'IBM-')THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+1
        ICALL(NCSTR:NCSTR2)=' &'
        NCSTR=NCSTR2
      ENDIF
C
      IF(INETSW.EQ.'NEW')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5411)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IHOST1.NE.'IBM-')THEN
          WRITE(ICOUT,5412)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5413)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5414)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5415)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
 5411 FORMAT('*****NOTE: IT MAY TAKE THE BROWSER A FEW MOMENTS TO ',
     1      'START UP.')
 5412 FORMAT('     IF YOU ARE USING THE NETSCAPE BROWSER, YOU CAN ',
     1       'SPEED UP SUBSEQUENT')
 5413 FORMAT('     USE OF WEB HELP BY ENTERING THE FOLLOWING DATAPLOT',
     1       ' COMMAND')
 5414 FORMAT('     (LEAVE THE BROWSER OPEN):')
 5415 FORMAT('         SET NETSCAPE OLD')
CCCCC BUG ON RS-6000.  CLOSE FILE BEFORE CALL DPSYS2.  FEBRUARY 2000.
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERRO2)
      CALL DPSYS2(ICALL,NCSTR,ISUBRO,IERROR)
      GOTO9000
C
 5390 CONTINUE
C
C               **************************************
C               **  STEP 61--                       **
C               **  CLOSE           THE HELP FILE.  **
C               **************************************
C
 6100 CONTINUE
C
      ISTEPN='61'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IWORD1.EQ.'HOME'.AND.IWOR12.EQ.'PAGE')GOTO6199
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERRO2)
      IF(IERRFI.EQ.'YES')GOTO9000
 6199 CONTINUE
C
C               ***********************************************
C               **  STEP 62--                                **
C               ** IF PASS 1 AND NOT FOUND IN FILES 1 TO 6,  **
C               ** THEN SCAN SYNONYM FILE FOR MATCH          **
C               ** AND TRY AGAIN IN FILES 1 TO 6             **
C               ***********************************************
C
 6200 CONTINUE
      IF(IPASS.EQ.1.AND.IERROR.EQ.'YES')THEN
         IOUNIT=IHE7NU
         IFILE=IHE7NA
         ISTAT=IHE7ST
         IFORM=IHE7FO
         IACCES=IHE7AC
         IPROT=IHE7PR
         ICURST=IHE7CS
         ISUBN0='HEL2'
         IERRFI='NO'
         IREWIN='ON'
         CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1   IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERRO2)
         IF(IERRFI.EQ.'YES')GOTO9000
C
         IMATCH=0
         DO6210I=1,5
            READ(IOUNIT,6211)ICJUNK
 6211       FORMAT(A1)
 6210    CONTINUE
         DO6220I=1,10000
            READ(IOUNIT,6221,END=6229)ILINE(1:80)
 6221       FORMAT(A80)
            IF(ILINE(1:4).EQ.IWORD1.AND.ILINE(5:8).EQ.IWOR12)THEN
               IF(ILINE(10:13).EQ.IWORD2)THEN
                  IF(ILINE(15:18).EQ.IWORD3)THEN
                     IF(ILINE(20:23).EQ.IWORD4)THEN
                        IF(ILINE(25:28).EQ.IWORD5)THEN
                          IMATCH=1
                          IWORD1=ILINE(41:44)
                          IWOR12=ILINE(45:48)
                          IWORD2=ILINE(50:53)
                          IWORD3=ILINE(55:58)
                          IWORD4=ILINE(60:63)
                          IWORD5=ILINE(65:68)
                          NUMAR2=5
                          IF(IWORD5.EQ.'    ')NUMAR2=4
                          IF(IWORD4.EQ.'    ')NUMAR2=3
                          IF(IWORD3.EQ.'    ')NUMAR2=2
                          IF(IWORD2.EQ.'    ')NUMAR2=1
                       ENDIF
                     ENDIF
                  ENDIF
               ENDIF
            ENDIF
 6220    CONTINUE
 6229    CONTINUE
C
         IENDFI='OFF'
         IREWIN='ON'
         CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1   IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERRO2)
         IF(IERRFI.EQ.'YES')GOTO9000
C
         IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'HELW')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6231)
 6231       FORMAT('FROM DPHELW AT 6231--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6232)IWORD1,IWOR12,IWORD2,IWORD3,IWORD4
 6232       FORMAT(A4,2X,A4,2X,A4,2X,A4,2X,A4)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6233)NUMAR2,IMATCH
 6233       FORMAT('NUMAR2,IMATCH = ',2I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
         ENDIF
C
         IF(IMATCH.EQ.1)THEN
            IERROR='NO'
            GOTO1000
         ENDIF
      ENDIF
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'HELW')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHELW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR,IERRO2
 9012 FORMAT('IBUGS2,ISUBRO,IERROR,IERRO2 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGS2,IFOUND,IERROR
 9028 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IOUNIT
 9031 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IFILE
 9032 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)ISTAT
 9033 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IFORM
 9034 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IACCES
 9035 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IPROT
 9036 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)ICURST
 9037 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)IENDFI
 9038 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IREWIN
 9039 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)ISUBN0
 9041 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IERRFI
 9042 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IWORD1,IWORD2,ICHAR1
 9043 FORMAT('IWORD1,IWORD2,ICHAR1 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9060)ILINE1(1:40),ICTEST,IWORD1,IWOR12
 9060 FORMAT('ILINE1(1:40),ICTEST,IWORD1,IWOR12=',A30,2X,A4,A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)NUMSEC,NUMLIN,ISECNA
 9061 FORMAT('NUMSEC,NUMLIN,ISECNA = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)NUMARG,NUMAR2
 9062 FORMAT('NUMARG,NUMAR2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9063)IWORD1,IWORD2,IWORD3,IWORD4,IWOR12
 9063 FORMAT('IWORD1,IWORD2,IWORD3,IWORD4,IWOR12 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9064)ILINE1(1:40)
 9064 FORMAT('ILINE1(1:40) = ',A40)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9065)IZ1,IZ2,IZ3,IZ4
 9065 FORMAT('IZ1,IZ2,IZ3,IZ4 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9066)ISTRIN
 9066 FORMAT('ISTRIN = ',A40)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9067)NUMWHF
 9067 FORMAT('NUMWHF = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9068)ILOC2,ILOC3,ILOC4
 9068 FORMAT('ILOC2,ILOC3,ILOC4 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9069)ILOC2P,ILOC3P,ILOC4P
 9069 FORMAT('ILOC2P,ILOC3P,ILOC4P = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9071)ICHAR1
 9071 FORMAT('ICHAR1 = ',A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9077)I2
 9077 FORMAT('I2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9079)IBUGS2,ISUBRO,IERROR
 9079 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9093)IERROR,IERRO2,IPASS
 9093 FORMAT('IERROR,IERRO2,IPASS = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9094)ILINE
 9094 FORMAT('ILINE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9095)IWORD1,IWOR12,IWORD2
 9095 FORMAT('IWORD1,IWOR12,IWORD2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9096)IWORD3,IWORD4,IWORD5
 9096 FORMAT('IWORD3,IWORD4,IWORD5 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9097)IBROWS(1:80)
 9097 FORMAT('IBROWS = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9098)IDPURL(1:80)
 9098 FORMAT('IDPURL = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9099)ICALL(1:80)
 9099 FORMAT('ICALL(1:80) = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9101)ICALL(81:160)
 9101 FORMAT('ICALL(81:160) = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9103)ICALL(161:240)
 9103 FORMAT('ICALL(161:240) = ',A80)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHEL1(ICOM,ICOM2,ICOMT,ICOMI,
     1IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IHELSW,
     1IHE1CO,IHE1AL,
     1IHE2CO,IHE2AL,
     1IHE3CO,IHE3AL,
     1IHE4CO,IHE4AL,
     1IHE5CO,IHE5AL,
     1IHE6CO,IHE6AL,
     1IHE7CO,IHE7AL,
     1IHE8CO,IHE8AL,
     1IHE9CO,IHE9AL,
     1IHELCO,IHELAL,
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IANS,IWIDTH,IBUGHE,IBUGH2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DETERMINE IF DATAPLOT'S HELP   SYSTEM
C              COMMAND IS BEING INVOKED AND/OR
C              DETERMINE IF A USER'S MENU DESIGNATION IS VALID.
C              THIS SUBROUTINE IN TURN CALLS DPHEL2
C              WHICH READS THE DESIGNATED MENU
C              FROM (ONE OF) DATAPLOT'S HELP   SUB-SYSTEM FILE(S),
C              AND WRITES THE MENU OUT TO SCREEN.
C     INPUT  ARGUMENTS--ICOM ETC.
C     OUTPUT ARGUMENTS--IHELSW, IHELCO, AND IHELAL
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--FEBRUARY  1985.
C     UPDATED         --JANUARY   1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 ICOM2
      CHARACTER*4 ICOMT
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
C
      CHARACTER*4 IHELSW
C
      CHARACTER*12 IHE1CO
      CHARACTER*4 IHE1AL
C
      CHARACTER*12 IHE2CO
      CHARACTER*4 IHE2AL
C
      CHARACTER*12 IHE3CO
      CHARACTER*4 IHE3AL
C
      CHARACTER*12 IHE4CO
      CHARACTER*4 IHE4AL
C
      CHARACTER*12 IHE5CO
      CHARACTER*4 IHE5AL
C
      CHARACTER*12 IHE6CO
      CHARACTER*4 IHE6AL
C
      CHARACTER*12 IHE7CO
      CHARACTER*4 IHE7AL
C
      CHARACTER*12 IHE8CO
      CHARACTER*4 IHE8AL
C
      CHARACTER*12 IHE9CO
      CHARACTER*4 IHE9AL
C
      CHARACTER*12 IHELCO
      CHARACTER*4 IHELAL
C
      CHARACTER*40 ICPREH
      CHARACTER*40 ICPOSH
C
      CHARACTER*4 IANS
      CHARACTER*4 IBUGHE
      CHARACTER*4 IBUGH2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
      CHARACTER*4 IFOSEC
      CHARACTER*4 IHELSV
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IANS(*)
C
C-----COMMON----------------------------------------------------------
C
CCCCC INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCONP.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='DPHE'
      ISUBN2='L1  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IHELAL='OFF'
C
      MAXCPS=12
C
      I2=(-999)
C
      IF(IBUGHE.EQ.'OFF'.AND.ISUBRO.NE.'HEL1')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHEL1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IHELSW
   52 FORMAT('IHELSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IHE1CO,IHE1AL
   61 FORMAT('IHE1CO,IHE1AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IHE2CO,IHE2AL
   62 FORMAT('IHE2CO,IHE2AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IHE3CO,IHE3AL
   63 FORMAT('IHE3CO,IHE3AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IHE4CO,IHE4AL
   64 FORMAT('IHE4CO,IHE4AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IHE5CO,IHE5AL
   65 FORMAT('IHE5CO,IHE5AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)IHE6CO,IHE6AL
   66 FORMAT('IHE6CO,IHE6AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)IHE7CO,IHE7AL
   67 FORMAT('IHE7CO,IHE7AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)IHE8CO,IHE8AL
   68 FORMAT('IHE8CO,IHE8AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IHE9CO,IHE9AL
   69 FORMAT('IHE9CO,IHE9AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)IHELCO,IHELAL
   70 FORMAT('IHELCO,IHELAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IWIDTH
   71 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)(IANS(I),I=1,80)
   72 FORMAT('(IANS(I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IBUGHE,IBUGH2,IERROR
   73 FORMAT('IBUGHE,IBUGH2,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IHELMX
   74 FORMAT('IHELMX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)NCPREH
   81 FORMAT('NCPREH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPREH.LE.0)GOTO84
      DO82I=1,NCPREH
      WRITE(ICOUT,83)I,ICPREH(I:I)
   83 FORMAT('I,ICPREH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   82 CONTINUE
   84 CONTINUE
      WRITE(ICOUT,86)NCPOSH
   86 FORMAT('NCPOSH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPOSH.LE.0)GOTO89
      DO87I=1,NCPOSH
      WRITE(ICOUT,88)I,ICPOSH(I:I)
   88 FORMAT('I,ICPOSH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   87 CONTINUE
   89 CONTINUE
   90 CONTINUE
C
C               **************************************************************
C               **  STEP 11--                                               **
C               **  DETERMINE IF HAVE AN HELP   COMMAND, OR                 **
C               **            IF HAVE A MENU RESPONSE NUMBER TO A MENU, OR  **
C               **            IF HAVE NEITHER.                              **
C               **************************************************************
C
 1100 CONTINUE
      ISTEPN='11'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'HELQ')GOTO1200
      IF(ICOM.EQ.'.')GOTO9000
      IF(ICOM.EQ.' ')GOTO9000
CCCCC IF(NUMARG.LE.0.AND.ICOM.EQ.' ')GOTO2100
      IF(NUMARG.LE.0.AND.ICOMT.EQ.'NUMB'.AND.ICOMI.EQ.0)GOTO2300
      IF(NUMARG.LE.0.AND.ICOMT.EQ.'NUMB'.AND.ICOMI.GT.0)GOTO1500
      IF(NUMARG.LE.0.AND.ICOMT.EQ.'NUMB'.AND.ICOMI.LT.0)GOTO1600
      GOTO9000
C
C               ***************************************
C               **  STEP 12--                        **
C               **  TREAT THE CASE WHEN HAVE         **
C               **  AN EXPLICIT    HELP     COMMAND  **
C               ***************************************
C
 1200 CONTINUE
      ISTEPN='12'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO2100
      IF(IHARG(1).EQ.'LAST')GOTO2100
      IF(IHARG(1).EQ.'?')GOTO2100
      IF(IHARG(1).EQ.'ALL')IHELAL='ON'
      IF(IHARG(1).EQ.'ALL')GOTO2100
C
      IF(IHARG(1).EQ.'UP')GOTO1300
      IF(IHARG(1).EQ.'PRIO')GOTO1300
      IF(IHARG(1).EQ.'PREV')GOTO1300
      IF(IHARG(1).EQ.'BEFO')GOTO1300
C
      GOTO1400
C
C               ****************************************
C               **  STEP 13  --                       **
C               **  TREAT THE    HELP   UP #    CASE  **
C               ****************************************
C
 1300 CONTINUE
      ISTEPN='13'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IHELCO.EQ.'0           ')IHELSW='TOP'
      IF(IHELCO.EQ.'0           ')GOTO2100
      IF(IHELCO.EQ.'            ')IHELSW='TOP'
      IF(IHELCO.EQ.'            ')GOTO2100
C
      NLOOP=1
      IF(NUMARG.GE.2.AND.IARGT(2).EQ.'NUMB')NLOOP=IARG(2)
      IF(NLOOP.LE.1)NLOOP=1
C
      DO1310ILOOP=1,NLOOP
C
      DO1320I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IHELCO(IREV:IREV).EQ.'.')GOTO1325
      IHELCO(IREV:IREV)=' '
 1320 CONTINUE
      GOTO1310
 1325 CONTINUE
      IHELCO(IREV:IREV)=' '
      GOTO1310
C
 1310 CONTINUE
      GOTO2100
C
C               *************************************
C               **  STEP 14--                      **
C               **  TREAT THE    HELP   #    CASE  **
C               *************************************
C
 1400 CONTINUE
      ISTEPN='14'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DATA')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'GRAP')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MATH')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'STAT')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'ENGI')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'BUSI')GOTO1490
      IF(NUMARG.LE.0)GOTO1490
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHELCO(1:4)=IH11(1:4)
      IHELCO(5:8)=IH12(1:4)
      IHELCO(9:12)='    '
C
 1490 CONTINUE
      GOTO2100
C
C               *****************************************
C               **  STEP 15--                          **
C               **  TREAT THE    #    CASE             **
C               **  (AS IN RESPONDING TO A MENU        **
C               **  BY SPECIFYING A MENU ITEM CHOICE)  **
C               *****************************************
C
 1500 CONTINUE
      ISTEPN='15'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IHELSW.EQ.'TOP')IHELCO='0           '
      IF(IHELSW.EQ.'TOP')GOTO2100
C
      IF(IHELCO(1:1).EQ.'0')GOTO1510
      GOTO1520
C
 1510 CONTINUE
      I2=0
      GOTO1530
C
 1520 CONTINUE
      DO1525I=1,MAXCPS
      I2=I
      IF(IHELCO(I2:I2).EQ.' ')GOTO1526
 1525 CONTINUE
      GOTO1539
 1526 CONTINUE
      IHELCO(I2:I2)='.'
      GOTO1530
C
 1530 CONTINUE
      DO1535J=1,4
      I2=I2+1
      IF(I2.GT.MAXCPS)GOTO1539
      IHELCO(I2:I2)=ICOM(J:J)
 1535 CONTINUE
 1539 CONTINUE
      GOTO2100
C
C               *****************************************
C               **  STEP 16--                          **
C               **  TREAT THE   -#    CASE             **
C               **  (AS IN CALLING FOR PRIOR MENUS     **
C               *****************************************
C
 1600 CONTINUE
      ISTEPN='16'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IHELCO.EQ.'0           ')IHELSW='TOP'
      IF(IHELCO.EQ.'0           ')GOTO2100
      IF(IHELCO.EQ.'            ')IHELSW='TOP'
      IF(IHELCO.EQ.'            ')GOTO2100
C
      NLOOP=1
      IF(ICOMT.EQ.'NUMB')NLOOP=(-ICOMI)
C
      IF(NLOOP.LE.0)GOTO1619
      DO1610ILOOP=1,NLOOP
C
      DO1620I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IHELCO(IREV:IREV).EQ.'.')GOTO1621
      IHELCO(IREV:IREV)=' '
 1620 CONTINUE
      GOTO1610
 1621 CONTINUE
      IHELCO(IREV:IREV)=' '
      GOTO1610
C
 1610 CONTINUE
C
 1619 CONTINUE
      GOTO2100
C
C               *************************************************
C               **  STEP 17--                                  **
C               **  STRIP OFF TRAILING PERIOD (IF ONE EXISTS)  **
C               *************************************************
C
 1700 CONTINUE
      ISTEPN='17'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1710I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IHELCO(IREV:IREV).NE.' ')GOTO1711
 1710 CONTINUE
      GOTO1790
 1711 CONTINUE
      IF(IHELCO(IREV:IREV).EQ.'.')IHELCO(IREV:IREV)=' '
      GOTO1790
 1790 CONTINUE
C
C               *********************************************
C               **  STEP 21--                              **
C               **  BRANCH BETWEEN THE OVERALL MENU        **
C               **  OR THE GENERAL MENU WITHIN EACH AREA.  **
C               *********************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUND='YES'
      IF(IHELCO.EQ.'            ')IHELCO='0           '
CCCCC IF(ICOM.EQ.'HELQ'.AND.NUMARG.LE.0)GOTO2200
      IF(ICOM.EQ.'HELQ'.AND.NUMARG.LE.0)GOTO2300
      IF(IHELSW.EQ.'TOP'.AND.NUMARG.LE.0.AND.
     1ICOM.EQ.' ')GOTO2200
      IF(IHELSW.EQ.'TOP'.AND.NUMARG.LE.0.AND.
     1ICOMT.EQ.'NUMB'.AND.ICOMI.LE.0)GOTO2200
      GOTO2300
C
C               **********************************************
C               **  STEP 22--                               **
C               **  WRITE (TO THE SCREEN) THE OVERALL MENU  **
C               **********************************************
C
 2200 CONTINUE
      ISTEPN='22'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHELSW='TOP'
C
      WRITE(ICOUT,2211)IESCC,IFFC
 2211 FORMAT(2A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)IESCC
 2212 FORMAT(A1,'8')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,2221)
 2221 FORMAT('Enter     HELP HELP       ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2222)
 2222 FORMAT('for a brief description of DATAPLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2223)
 2223 FORMAT('Help Subsystem scope and conventions.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2230)
 2230 FORMAT('     GENERAL TOPIC AREAS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2231)
 2231 FORMAT('      1. Data Analysis (partially implemented)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2232)
 2232 FORMAT('      2. Mathematics   (not yet   implemented)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2233)
 2233 FORMAT('      3. Graphics      (not yet   implemented)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2234)
 2234 FORMAT('      4. DATAPLOT      (not yet   implemented)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2241)
 2241 FORMAT('To select a menu item, enter 1 through 4.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               ****************************************
C               **  STEP 23--                         **
C               **  READ THE HELP   FILE              **
C               **  AND WRITE (TO THE SCREEN) A MENU  **
C               ****************************************
C
 2300 CONTINUE
      ISTEPN='23'
      IF(IBUGHE.EQ.'ON'.OR.ISUBRO.EQ.'HEL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO2310
C
      IF(NUMARG.EQ.1.AND.IARGT(1).EQ.'NUMB')GOTO2320
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DATA')GOTO2331
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'GRAP')GOTO2332
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'MATH')GOTO2333
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'STAT')GOTO2334
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ENGI')GOTO2335
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'BUSI')GOTO2336
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DATA')GOTO2341
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'GRAP')GOTO2342
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MATH')GOTO2343
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'STAT')GOTO2344
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'ENGI')GOTO2345
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BUSI')GOTO2346
C
      GOTO2360
C
C     TREAT THE CASE    HELP
C     WITH NO ARGUMENTS
C
 2310 CONTINUE
      IHELSW='DATA'
      IF(NUMARG.EQ.0)IHELCO='TOPALL      '
      GOTO2400
C
C     TREAT THE CASE LIKE    HELP 4
C
 2320 CONTINUE
CCCCC IF(IHELSW.NE.'TOP')GOTO2360
      IF(IHELCO.NE.'TOP')GOTO2360
      IF(IARG(1).EQ.1)GOTO2331
      IF(IARG(1).EQ.2)GOTO2332
      IF(IARG(1).EQ.3)GOTO2333
      IF(IARG(1).EQ.4)GOTO2334
      IF(IARG(1).EQ.5)GOTO2335
      IF(IARG(1).EQ.6)GOTO2336
      GOTO2360
C
C     TREAT THE 6 CASES WHERE THERE IS ONLY 1 ARGUMENT
C     AND THAT ARGUMENT IS EXPLICTLY ONE OF THE 6--
C     DATA, GRAP, MATH, STAT, ENGI, BUSI
C     (E.G, HELP MATH, HELP ENGINEERING)
C
 2331 CONTINUE
      IHELSW='DATA'
      IHELCO='TOP         '
      GOTO2400
 2332 CONTINUE
      IHELSW='GRAP'
      IHELCO='TOP         '
      GOTO2400
 2333 CONTINUE
      IHELSW='MATH'
      IHELCO='TOP         '
      GOTO2400
 2334 CONTINUE
      IHELSW='STAT'
      IHELCO='TOP         '
      GOTO2400
 2335 CONTINUE
      IHELSW='ENGI'
      IHELCO='TOP         '
      GOTO2400
 2336 CONTINUE
      IHELSW='BUSI'
      IHELCO='TOP         '
      GOTO2400
C
C     TREAT THE 6 CASES WHERE THERE ARE 2 OR MORE ARGUMENT
C     AND THE FIRST ARGUMENT IS EXPLICTLY ONE OF THE 6--
C     DATA, GRAP, MATH, STAT, ENGI, BUSI
C     (E.G, HELP MATH GOODIES, HELP ENGINEERING TOPICS)
C
 2341 CONTINUE
      IHELSW='DATA'
      GOTO2349
 2342 CONTINUE
      IHELSW='GRAP'
      GOTO2349
 2343 CONTINUE
      IHELSW='MATH'
      GOTO2349
 2344 CONTINUE
      IHELSW='STAT'
      GOTO2349
 2345 CONTINUE
      IHELSW='ENGI'
      GOTO2349
 2346 CONTINUE
      IHELSW='BUSI'
      GOTO2349
 2349 CONTINUE
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHELCO(1:4)=IH21(1:4)
      IHELCO(5:8)=IH22(1:4)
      GOTO2400
C
 2360 CONTINUE
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHELCO(1:4)=IH11(1:4)
      IHELCO(5:8)=IH12(1:4)
      GOTO2400
C
 2400 CONTINUE
C
      CALL DPHEL2(IHELSW,
     1IHELCO,IHELAL,
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IFOSEC,
     1IANS,IWIDTH,IBUGH2,ISUBRO,IFOUND,IERROR)
      IF(IFOSEC.EQ.'NO')GOTO2410
      IF(IHELSW.EQ.'DATA')IHE1CO=IHELCO
      IF(IHELSW.EQ.'MATH')IHE2CO=IHELCO
      IF(IHELSW.EQ.'GRAP')IHE3CO=IHELCO
      IF(IHELSW.EQ.'STAT')IHE4CO=IHELCO
      IF(IHELSW.EQ.'ENGI')IHE5CO=IHELCO
      IF(IHELSW.EQ.'BUSI')IHE6CO=IHELCO
      IF(IHELSW.EQ.'XXXX')IHE7CO=IHELCO
      IF(IHELSW.EQ.'XXXX')IHE8CO=IHELCO
      IF(IHELSW.EQ.'XXXX')IHE9CO=IHELCO
      GOTO9000
C
C     THE FOLLOWING SECTION IS EXECUTED ONLY IF
C     THE KEYWORD WAS NOT FOUND IN THE
C     CURRENT PRIMARY FILE.
C     IN SUCH CASE, LOOK IN OTHER FILES FOR
C     THE KEYWORD.
C
 2410 CONTINUE
      IHELSV=IHELSW
      DO2420I=1,6
      IF(I.EQ.1)IHELSW='DATA'
      IF(I.EQ.2)IHELSW='GRAP'
      IF(I.EQ.3)IHELSW='MATH'
      IF(I.EQ.4)IHELSW='STAT'
      IF(I.EQ.5)IHELSW='ENGI'
      IF(I.EQ.6)IHELSW='BUSI'
      CALL DPHEL2(IHELSW,
     1IHELCO,IHELAL,
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IFOSEC,
     1IANS,IWIDTH,IBUGH2,ISUBRO,IFOUND,IERROR)
      IF(IFOSEC.EQ.'NO')GOTO2420
      IF(IHELSW.EQ.'DATA')IHE1CO=IHELCO
      IF(IHELSW.EQ.'MATH')IHE2CO=IHELCO
      IF(IHELSW.EQ.'GRAP')IHE3CO=IHELCO
      IF(IHELSW.EQ.'STAT')IHE4CO=IHELCO
      IF(IHELSW.EQ.'ENGI')IHE5CO=IHELCO
      IF(IHELSW.EQ.'BUSI')IHE6CO=IHELCO
      IF(IHELSW.EQ.'XXXX')IHE7CO=IHELCO
      IF(IHELSW.EQ.'XXXX')IHE8CO=IHELCO
      IF(IHELSW.EQ.'XXXX')IHE9CO=IHELCO
      GOTO9000
 2420 CONTINUE
      IHELSW=IHELSV
      IF(IHELSW.EQ.'DATA')IHE1CO=IHELCO
      IF(IHELSW.EQ.'MATH')IHE2CO=IHELCO
      IF(IHELSW.EQ.'GRAP')IHE3CO=IHELCO
      IF(IHELSW.EQ.'STAT')IHE4CO=IHELCO
      IF(IHELSW.EQ.'ENGI')IHE5CO=IHELCO
      IF(IHELSW.EQ.'BUSI')IHE6CO=IHELCO
      IF(IHELSW.EQ.'XXXX')IHE7CO=IHELCO
      IF(IHELSW.EQ.'XXXX')IHE8CO=IHELCO
      IF(IHELSW.EQ.'XXXX')IHE9CO=IHELCO
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2421)
 2421 FORMAT('***** ERROR IN DPHEL1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2422)IHELCO(1:4),IHELCO(5:8)
 2422 FORMAT('      NO HELP INFORMATION FOUND FOR ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2423)
 2423 FORMAT('      ANYWHERE UNDER THE 6 HELP CATEGORIES.')
      CALL DPWRST('XXX','BUG ')
      IF(IHELSW.EQ.'TOP')WRITE(ICOUT,2430)
 2430 FORMAT('      CURRENT CATEGORY = ABOVE ALL 6')
      IF(IHELSW.EQ.'TOP')CALL DPWRST('XXX','BUG ')
      IF(IHELSW.EQ.'DATA')WRITE(ICOUT,2431)
 2431 FORMAT('      CURRENT CATEGORY = DATAPLOT')
      IF(IHELSW.EQ.'DATA')CALL DPWRST('XXX','BUG ')
      IF(IHELSW.EQ.'GRAP')WRITE(ICOUT,2432)
 2432 FORMAT('      CURRENT CATEGORY = GRAPHICS')
      IF(IHELSW.EQ.'GRAP')CALL DPWRST('XXX','BUG ')
      IF(IHELSW.EQ.'MATH')WRITE(ICOUT,2433)
 2433 FORMAT('      CURRENT CATEGORY = MATHEMATICS')
      IF(IHELSW.EQ.'MATH')CALL DPWRST('XXX','BUG ')
      IF(IHELSW.EQ.'STAT')WRITE(ICOUT,2434)
 2434 FORMAT('      CURRENT CATEGORY = STATISTICS/PROBABILITY')
      IF(IHELSW.EQ.'STAT')CALL DPWRST('XXX','BUG ')
      IF(IHELSW.EQ.'ENGI')WRITE(ICOUT,2435)
 2435 FORMAT('      CURRENT CATEGORY = ENGINEERING/SCIENCE')
      IF(IHELSW.EQ.'ENGI')CALL DPWRST('XXX','BUG ')
      IF(IHELSW.EQ.'BUSI')WRITE(ICOUT,2436)
 2436 FORMAT('      CURRENT CATEGORY = BUSINESS/ECONOMICS')
      IF(IHELSW.EQ.'BUSI')CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGHE.EQ.'OFF'.AND.ISUBRO.NE.'HEL1')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHEL1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IHELSW
 9012 FORMAT('IHELSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IHE1CO,IHE1AL
 9031 FORMAT('IHE1CO,IHE1AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IHE2CO,IHE2AL
 9032 FORMAT('IHE2CO,IHE2AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)IHE3CO,IHE3AL
 9033 FORMAT('IHE3CO,IHE3AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IHE4CO,IHE4AL
 9034 FORMAT('IHE4CO,IHE4AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IHE5CO,IHE5AL
 9035 FORMAT('IHE5CO,IHE5AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IHE6CO,IHE6AL
 9036 FORMAT('IHE6CO,IHE6AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)IHE7CO,IHE7AL
 9037 FORMAT('IHE7CO,IHE7AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)IHE8CO,IHE8AL
 9038 FORMAT('IHE8CO,IHE8AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IHE9CO,IHE9AL
 9039 FORMAT('IHE9CO,IHE9AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9040)IHELCO,IHELAL
 9040 FORMAT('IHELCO,IHELAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9049)IBUGHE,IBUGH2,IFOUND,IERROR
 9049 FORMAT('IBUGHE,IBUGH2,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9054)IHELMX
 9054 FORMAT('IHELMX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9055)IFOSEC
 9055 FORMAT('IFOSEC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9081)NCPREH
 9081 FORMAT('NCPREH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPREH.LE.0)GOTO9084
      DO9082I=1,NCPREH
      WRITE(ICOUT,9083)I,ICPREH(I:I)
 9083 FORMAT('I,ICPREH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
 9082 CONTINUE
 9084 CONTINUE
      WRITE(ICOUT,9086)NCPOSH
 9086 FORMAT('NCPOSH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPOSH.LE.0)GOTO9089
      DO9087I=1,NCPOSH
      WRITE(ICOUT,9088)I,ICPOSH(I:I)
 9088 FORMAT('I,ICPOSH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
 9087 CONTINUE
 9089 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHEL2(IHELSW,
     1IHELCO,IHELAL,
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IFOSEC,
     1IANS,IWIDTH,IBUGH3,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--READ THE DESIGNATED SECTION
C              FROM (ONE OF) DATAPLOT'S HELP SUB-SYSTEM FILE(S),
C              AND WRITE THE SECTION CONTENTS OUT TO SCREEN.
C     INPUT  ARGUMENTS--IHELSW (A HOLLARITH VARIABLE
C                       IDENTIFYING WHICH SUB-SYSTEM.
C                     --IHELCO (A HOLLARITH VARIABLE
C                       CONTAINING A SECTION IDENTIFICATION STRING.
C                     --IHELAL (A HOLLARITH VARIABLE (ON/OFF)
C                       CONTAINING A SWITCH SETTING AS TO WHETHER
C                       ALL OF THE TOPIC SECTION SHOULD BE PRINTED OUT.
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--FEBRAURY  1985.
C     UPDATED         --JANUARY   1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHELSW
      CHARACTER*12 IHELCO
      CHARACTER*4 IHELAL
      CHARACTER*40 ICPREH
      CHARACTER*40 ICPOSH
C
      CHARACTER*4 IFOSEC
C
      CHARACTER*4 IANS
      CHARACTER*4 IBUGH3
      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 ISUBN0
      CHARACTER*4 IERRFI
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
C
      CHARACTER*12 ITABID
C
      CHARACTER*80 ICTEXT
C
      CHARACTER*12 ITABII
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICRESP
C
      DIMENSION ITABID(500)
      DIMENSION ITABLN(500)
C
      DIMENSION IANS(*)
C
C-----COMMON----------------------------------------------------------
C
CCCCC INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCONP.INC'
CCCCC TEH FOLLOWING LINE WAS ADDED   JUNE 1993
      INCLUDE 'DPCODV.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
      NUMSEC=(-999)
      JSEC=(-999)
      ISKIP=(-999)
      ISTART=(-999)
      I2=(-999)
      ITABII='-99999999999'
C
      IFOUND='YES'
      IERROR='NO'
C
      ISUBN1='DPHE'
      ISUBN2='L2  '
C
      IFOSEC='-999'
      ICRESP='-999'
C
      IF(IBUGH3.EQ.'OFF'.AND.ISUBRO.NE.'HEL2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHEL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IHELSW
   52 FORMAT('IHELSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IHELCO,IHELAL
   53 FORMAT('IHELCO,IHELAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHELMX
   54 FORMAT('IHELMX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGH3,ISUBRO,IERROR
   55 FORMAT('IBUGH3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IFOSEC
   56 FORMAT('IFOSEC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)NCPREH
   81 FORMAT('NCPREH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPREH.LE.0)GOTO84
      DO82I=1,NCPREH
      WRITE(ICOUT,83)I,ICPREH(I:I)
   83 FORMAT('I,ICPREH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   82 CONTINUE
   84 CONTINUE
      WRITE(ICOUT,86)NCPOSH
   86 FORMAT('NCPOSH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPOSH.LE.0)GOTO89
      DO87I=1,NCPOSH
      WRITE(ICOUT,88)I,ICPOSH(I:I)
   88 FORMAT('I,ICPOSH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   87 CONTINUE
   89 CONTINUE
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGH3.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IHELSW.EQ.'TOP')GOTO1110
      IF(IHELSW.EQ.'DATA')GOTO1110
      IF(IHELSW.EQ.'GRAP')GOTO1120
      IF(IHELSW.EQ.'MATH')GOTO1130
      IF(IHELSW.EQ.'STAT')GOTO1140
      IF(IHELSW.EQ.'ENGI')GOTO1150
      IF(IHELSW.EQ.'BUSI')GOTO1160
      IF(IHELSW.EQ.'XXXX')GOTO1170
      IF(IHELSW.EQ.'XXXX')GOTO1180
      IF(IHELSW.EQ.'XXXX')GOTO1190
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1101)
 1101 FORMAT('***** INTERNAL ERROR IN DPHEL2 ',
     1'AT BRANCH POINT 1101--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)
 1102 FORMAT('      IHELSW SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)
 1103 FORMAT('      DATA, GRAP, MATH, STAT, ENGI, OR BUSI, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1104)
 1104 FORMAT('      BUT IS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1105)IHELSW
 1105 FORMAT('      IHELSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1110 CONTINUE
      IOUNIT=IHE1NU
      IFILE=IHE1NA
      ISTAT=IHE1ST
      IFORM=IHE1FO
      IACCES=IHE1AC
      IPROT=IHE1PR
      ICURST=IHE1CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO1191
C
 1120 CONTINUE
      IOUNIT=IHE2NU
      IFILE=IHE2NA
      ISTAT=IHE2ST
      IFORM=IHE2FO
      IACCES=IHE2AC
      IPROT=IHE2PR
      ICURST=IHE2CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO1191
C
 1130 CONTINUE
      IOUNIT=IHE3NU
      IFILE=IHE3NA
      ISTAT=IHE3ST
      IFORM=IHE3FO
      IACCES=IHE3AC
      IPROT=IHE3PR
      ICURST=IHE3CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO1191
C
 1140 CONTINUE
      IOUNIT=IHE4NU
      IFILE=IHE4NA
      ISTAT=IHE4ST
      IFORM=IHE4FO
      IACCES=IHE4AC
      IPROT=IHE4PR
      ICURST=IHE4CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO1191
C
 1150 CONTINUE
      IOUNIT=IHE5NU
      IFILE=IHE5NA
      ISTAT=IHE5ST
      IFORM=IHE5FO
      IACCES=IHE5AC
      IPROT=IHE5PR
      ICURST=IHE5CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO1191
C
 1160 CONTINUE
      IOUNIT=IHE6NU
      IFILE=IHE6NA
      ISTAT=IHE6ST
      IFORM=IHE6FO
      IACCES=IHE6AC
      IPROT=IHE6PR
      ICURST=IHE6CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO1191
C
 1170 CONTINUE
      IOUNIT=IHE7NU
      IFILE=IHE7NA
      ISTAT=IHE7ST
      IFORM=IHE7FO
      IACCES=IHE7AC
      IPROT=IHE7PR
      ICURST=IHE7CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO1191
C
 1180 CONTINUE
      IOUNIT=IHE8NU
      IFILE=IHE8NA
      ISTAT=IHE8ST
      IFORM=IHE8FO
      IACCES=IHE8AC
      IPROT=IHE8PR
      ICURST=IHE8CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO1191
C
 1190 CONTINUE
      IOUNIT=IHE9NU
      IFILE=IHE9NA
      ISTAT=IHE9ST
      IFORM=IHE9FO
      IACCES=IHE9AC
      IPROT=IHE9PR
      ICURST=IHE9CS
      ISUBN0='HEL2'
      IERRFI='NO'
      GOTO1191
C
 1191 CONTINUE
      IF(IBUGH3.EQ.'OFF'.AND.ISUBRO.NE.'HEL2')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)IBUGH3,ISUBRO,ISUBN0,IERRFI
 1196 FORMAT('IBUGH3,ISUBRO,ISUBN0,IERRFI = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  CHECK TO SEE IF THIS HELP   FILE EXISTS  **
C               ***********************************************
C
      ISTEPN='12'
      IF(IBUGH3.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPHEL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE HELP SUB-SYSTEM')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE ENTERED FOR THIS TOPIC BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES HELP INFORMATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT YET AVAILABLE FOR THIS TOPIC.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,IHELSW
 1217 FORMAT('ISTAT,IHELSW = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               *********************
C               **  STEP 20--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='20'
      IF(IBUGH3.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGH3,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ************************************************************
C               **  STEP 41--                                             **
C               **  READ IN FILE INFORMATION                              **
C               **  FROM THE BEGINNING LINES OF THE FILE.                 **
C               **  THESE LEAD LINES CONTAIN                              **
C               **  THE STARTING LINE NUMBER OF EACH SECTION              **
C               **  IN THE FILE (ATABLN)   (F10.0 FORMAT), AND            **
C               **  THE IDENTIFIER          FOR EACH SECTION              **
C               **  IN THE FILE (ITABID(.) (A12 FORMAT).                  **
C               ************************************************************
C
      READ(IOUNIT,4101,END=4110)
 4101 FORMAT()
      READ(IOUNIT,4101,END=4110)
      GOTO4119
 4110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4111)
 4111 FORMAT('***** INTERNAL ERROR IN DPHEL2 ',
     1'AT BRANCH POINT 4111--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4112)
 4112 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4113)
 4113 FORMAT('      WHILE CARRYING OUT THE SKIP OF 2 LINES AT THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4114)
 4114 FORMAT('      BEGINNING OF ONE OF THE DATAPLOT HELP FILES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4115)IFILE
 4115 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4119 CONTINUE
C
      NUMSEC=0
      DO4120I=1,100000
      READ(IOUNIT,4121,END=4180)ATABLN,ITABID(I)
 4121 FORMAT(F10.0,A12)
      IF(ITABID(I).EQ.'            ')GOTO4129
      NUMSEC=NUMSEC+1
      ITABLN(I)=ATABLN+0.5
      IF(IBUGH3.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1WRITE(ICOUT,4122)I,ATABLN,ITABLN(I),ITABID(I)
 4122 FORMAT('I,ATABLN,ITABLN(I),ITABID(I) = ',I8,E15.7,I8,2X,A12)
      IF(IBUGH3.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1CALL DPWRST('XXX','BUG ')
 4120 CONTINUE
 4129 CONTINUE
      ANUMSE=NUMSEC
      GOTO4190
C
 4180 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4181)
 4181 FORMAT('***** INTERNAL ERROR IN DPHEL2 ',
     1'AT BRANCH POINT 4181--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4182)
 4182 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4183)
 4183 FORMAT('      WHILE READING THE LOOK-UP TABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4184)
 4184 FORMAT('      WITHIN ONE OF THE DATAPLOT HELP FILES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4185)IFILE
 4185 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4190 CONTINUE
C
C               *******************************************************
C               **  STEP 42--                                        **
C               **  BASED ON THE CODE STRING IN IHELCO               **
C               **  DO A TABLE LOOK-UP WHICH WILL SPECIFY            **
C               **  THE ABSOLUTE LINE NUMBER IN THE FILE             **
C               **  WHERE THE SECTION WITH THAT CODE WORD STARTS     **
C               *******************************************************
C
      ISTEPN='42'
      IF(IBUGH3.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO4200I=1,NUMSEC
      I2=I
      ITABII=ITABID(I)
      IF(IHELCO(1:4).EQ.ITABII(1:4))GOTO4210
 4200 CONTINUE
CCCCC JSEC=1
      IFOSEC='NO'
      GOTO9000
 4210 CONTINUE
      IFOSEC='YES'
      JSEC=I2
C
      ISTART=ITABLN(JSEC)
C
      IF(IBUGH3.EQ.'OFF'.AND.ISUBRO.NE.'HEL2')GOTO4290
      WRITE(ICOUT,4211)
 4211 FORMAT('***** FROM 4211 IN MIDDLE OF DPHEL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4213)JSEC,ISTART
 4213 FORMAT('JSEC,ISTART = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4290 CONTINUE
C
C               *************************************************
C               **  STEP 43--                                  **
C               **  READ DOWN IN THE FILE TO                   **
C               **  THE LINE BEFORE WHERE THE SECTION STARTS   **
C               *************************************************
C
      ISTEPN='43'
      IF(IBUGH3.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      REWIND(IOUNIT)
C
      ISKIP=ISTART-1
      IF(ISKIP.LE.0)GOTO4319
      DO4310I=1,ISKIP
      READ(IOUNIT,4315,END=4380)
 4315 FORMAT()
 4310 CONTINUE
 4319 CONTINUE
      GOTO4390
C
 4380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4381)
 4381 FORMAT('***** INTERNAL ERROR IN DPHEL2 ',
     1'AT BRANCH POINT 4381--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4382)
 4382 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4383)
 4383 FORMAT('      WHILE CARRYING OUT SKIPS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4384)
 4384 FORMAT('      WITHIN ONE OF THE DATAPLOT HELP FILES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4385)IFILE
 4385 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4390 CONTINUE
C
C               ***************************************************
C               **  STEP 45--                                    **
C               **  FOR THIS TARGET SECTION--                    **
C               **     1) SKIP OVER 2 HEADER LINES               **
C               **     2) READ IN (AND WRITE OUT) THE TEXT       **
C               **        FOR THE SECTION--                      **
C               **        (THIS IS WHAT THE ANALYST WILL SEE     **
C               **        ON THE SCREEN).                        **
C               **        THE LAST LINE OF THE TEXT IS           **
C               **        A LINE OF HYPHENS (THIS LINE IS        **
C               **        NOT PRINTED OUT).                      **
C               **     3) READ IN (AND STORE) THE NUMBER OF      **
C               **        MENU ITEMS THAT WERE OFFERED           **
C               **     4) READ IN (AND STORE) THE CODE WORD      **
C               **        (= SUBSEQUENT BRANCH POINT)            **
C               **        FOR EACH MENU ITEM                     **
C               ***************************************************
C
      ISTEPN='45'
      IF(IBUGH3.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      READ(IOUNIT,4505,END=4580)
 4505 FORMAT()
      READ(IOUNIT,4505,END=4580)
C
CCCCC WRITE(ICOUT,4511)IESCC,IFFC
C4511 FORMAT(2A1)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,4512)IESCC
C4512 FORMAT(A1,'8')
CCCCC CALL DPWRST('XXX','BUG ')
C
CCCCC WRITE(ICOUT,4513)IHELCO
C4513 FORMAT(58X,A12)
CCCCC CALL DPWRST('XXX','BUG ')
C
      NUMLPR=0
      IF(NCPREH.LE.0)GOTO4519
      WRITE(ICOUT,4511)(ICPREH(J:J),J=1,NCPREH)
 4511 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
 4519 CONTINUE
C
      DO4520I=1,100000
C
      READ(IOUNIT,4521,END=4580)ICTEXT
 4521 FORMAT(A80)
CCCCC IF(ICTEXT(1:5).EQ.'SSSSS')GOTO4590   DECEMBER 1986
CCCCC IF(ICTEXT(1:5).EQ.'EEEEE')GOTO4590   DECEMBER 1986
      IF(ICTEXT(1:5).EQ.'-----')GOTO4590
      IF(ICTEXT(1:5).EQ.'.....')GOTO4590
C
      IF(NUMLPR.LT.IHELMX)GOTO4529
CCCCC THE FOLLOWING LINE WAS ADDED  JUNE 1993
      IF(TCMENU.EQ.'ON')GOTO4529
      WRITE(ICOUT,4522)
 4522 FORMAT('                                      MORE...')
      CALL DPWRST('XXX','BUG ')
      READ(IRD,4523)ICRESP
 4523 FORMAT(A4)
      IF(ICRESP.EQ.'STOP')GOTO4590
      IF(ICRESP.EQ.'stop')GOTO4590
      IF(ICRESP.EQ.'HALT')GOTO4590
      IF(ICRESP.EQ.'halt')GOTO4590
      IF(ICRESP.EQ.'EXIT')GOTO4590
      IF(ICRESP.EQ.'exit')GOTO4590
      IF(ICRESP.EQ.'END')GOTO4590
      IF(ICRESP.EQ.'end')GOTO4590
      IF(ICRESP.EQ.'QUIT')GOTO4590
      IF(ICRESP.EQ.'quit')GOTO4590
      IF(ICRESP.EQ.'BYE')GOTO4590
      IF(ICRESP.EQ.'bye')GOTO4590
      IF(ICRESP.EQ.'NO')GOTO4590
      IF(ICRESP.EQ.'no')GOTO4590
      NUMLPR=0
      IF(NCPREH.LE.0)GOTO4527
      WRITE(ICOUT,4526)(ICPREH(J:J),J=1,NCPREH)
 4526 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
 4527 CONTINUE
 4529 CONTINUE
C
      DO4530J=1,80
      JREV=80-J+1
      IF(ICTEXT(JREV:JREV).NE.' ')GOTO4535
 4530 CONTINUE
      JREV=1
 4535 CONTINUE
      IF(JREV.LE.0)WRITE(ICOUT,999)
      IF(JREV.LE.0)CALL DPWRST('XXX','BUG ')
      IF(JREV.GE.1)WRITE(ICOUT,4536)(ICTEXT(K:K),K=1,JREV)
C4536 FORMAT(80A1)
      IF(JREV.GE.1)CALL DPWRST('XXX','BUG ')
 4536 FORMAT(1H ,80A1)
      NUMLPR=NUMLPR+1
C
 4520 CONTINUE
C
 4580 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4581)
 4581 FORMAT('***** INTERNAL ERROR IN DPHEL2 ',
     1'AT BRANCH POINT 4581--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4582)
 4582 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4583)
 4583 FORMAT('      WHILE READING WITHIN THE TARGET SECTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4584)
 4584 FORMAT('      WITHIN ONE OF THE DATAPLOT HELP FILES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4585)IFILE
 4585 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4586)JSEC,ISTART
 4586 FORMAT('JSEC,ISTART = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO5000
 4589 CONTINUE
C
 4590 CONTINUE
C
      IF(NCPOSH.LE.0)GOTO4599
      WRITE(ICOUT,4591)(ICPOSH(J:J),J=1,NCPOSH)
 4591 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
 4599 CONTINUE
C
C               **************************************
C               **  STEP 50--                       **
C               **  CLOSE        THIS HELP   FILE.  **
C               **************************************
C
 5000 CONTINUE
C
      ISTEPN='50'
      IF(IBUGH3.EQ.'ON'.OR.ISUBRO.EQ.'HEL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGH3,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGH3.EQ.'OFF'.AND.ISUBRO.NE.'HEL2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHEL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGH3,ISUBRO,IERROR
 9012 FORMAT('IBUGH3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOSEC
 9013 FORMAT('IFOSEC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHELMX,NUMLPR
 9014 FORMAT('IHELMX,NUMLPR = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICRESP
 9015 FORMAT('ICRESP = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IENDFI
 9028 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)ISKIP,ISTART,I2
 9051 FORMAT('ISKIP,ISTART,I2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IHELSW
 9052 FORMAT('IHELSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9054)IHELCO,IHELAL
 9054 FORMAT('IHELCO,IHELAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)NUMSEC
 9061 FORMAT('NUMSEC = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)JSEC,ITABLN(JSEC),ITABID(JSEC)
 9062 FORMAT('JSEC,ITABLN(JSEC),ITABID(JSEC) = ',2I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9063)ITABII
 9063 FORMAT('ITABII = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9081)NCPREH
 9081 FORMAT('NCPREH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPREH.LE.0)GOTO9084
      DO9082I=1,NCPREH
      WRITE(ICOUT,9083)I,ICPREH(I:I)
 9083 FORMAT('I,ICPREH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
 9082 CONTINUE
 9084 CONTINUE
      WRITE(ICOUT,9086)NCPOSH
 9086 FORMAT('NCPOSH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPOSH.LE.0)GOTO9089
      DO9087I=1,NCPOSH
      WRITE(ICOUT,9088)I,ICPOSH(I:I)
 9088 FORMAT('I,ICPOSH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
 9087 CONTINUE
 9089 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHEX2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A HEXAGON
C              WITH ONE END OF THE DIAGONAL AT (X1,Y1)
C              AND THE OTHER END AT (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(10)
      DIMENSION PY(10)
CCCCC DIMENSION PX3(10)
CCCCC DIMENSION PY3(10)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'HEX2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHEX2--')
      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 HEXAGON            **
C               *********************************
C
      DELX=X2-X1
      DELY=Y2-Y1
      LEN=SQRT((X2-X1)**2+(Y2-Y1)**2)
      ALEN=LEN
      R=ALEN/2.0
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      K=0
C
      X=0.0
      Y=0.0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO3010I=181,541,60
      IREV=541-I+181
      PHI2=IREV-1
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=R*COS(PHI2)+R
      Y=R*SIN(PHI2)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 3010 CONTINUE
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
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.'HEX2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHEX2--')
      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 DPHEXA(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 HEXAGONS
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 OPPOSING DIAGONAL ENDS
C           OF THE HEXAGON.
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 HEXAGON 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 HEXAGON 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 HEXAGON 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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
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.'HEXA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHEXA--')
      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='HEXA'
      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 DPHEXA--')
      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 HEXAGON ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE POINT AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND WITH OPPOSITE POINT AT THE POINT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      HEXAGON 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      HEXAGON 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 DPHEX2(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.'HEXA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHEXA--')
      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 DPHIS2(Y,X,N,ICASPL,IRELAT,IDATSW,CLWID,XSTART,XSTOP,
CCCCC MARCH 1996.  ADD FOLLOWING LINE
     1XTEMP1,MAXOBV,
     1IRHSTG,IHSTCW,IASHWT,M,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C                   1) A HISTOGRAM,
C                   2) A RELATIVE HISTOGRAM
C                      (THAT IS, WITH AREA = 1).
C                   3) A CUMULATIVE HISTOGRAM
C                   4) A RELATIVE CUMULATIVE HISTOGRAM
C                      (THAT IS, WITH MAX BAR HEIGHT = 1).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --FEBRUARY  1988.  (RELATIVE HISTOGRAM AREA CORRECTION)
C     UPDATED         --JANUARY   1989.  DOUBLE PRECISION (MANY PLACES)
C     UPDATED         --JUNE      1994.  FIX RELATIVE HIST AREA
C     UPDATED         --MARCH     1996.  FIX RELATIVE HIST AREA BASED
C                                        ON IRHSTG SWITCH.
C     UPDATED         --DECEMBER  1999.  CHECK FOR POINTS OUTSIDE INTERVAL
C     UPDATED         --SEPTEMBER 2004.  SUPPORT FOR ALTERNATIVE
C                                        CLASS WIDTH ALGORITHMS
C                                        (IHSTCW)
C     UPDATED         --SEPTEMBER 2004.  SUPPORT FOR "AVERAGE SHIFTED
C                                        HISTOGRAM" (IASHWT)
C     UPDATED         --SEPTEMBER 2005.  NO ERROR IF ALL ELEMENTS THE
C                                        SAME
C     UPDATED         --NOVEMBER  2005.  FIX BUG INTRODUCED BY 9/2005
C                                        UPDATE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IRELAT
      CHARACTER*4 IDATSW
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRIT2
CCCCC MARCH 1996.  ADD FOLLOWING LINE
      CHARACTER*4 IRHSTG
      CHARACTER*4 IHSTCW
      CHARACTER*4 IASHWT
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
 
      DOUBLE PRECISION DCLWID
      DOUBLE PRECISION DXSTAR
      DOUBLE PRECISION DXSTOP
      DOUBLE PRECISION DCLMNJ
      DOUBLE PRECISION DCLMDJ
      DOUBLE PRECISION DCLMXJ
      DOUBLE PRECISION DJ
      DOUBLE PRECISION DXI
      DOUBLE PRECISION DDELI
      DOUBLE PRECISION DABSDE
      DOUBLE PRECISION DTOTWI
      DOUBLE PRECISION DD21
      DOUBLE PRECISION DD2N
      DOUBLE PRECISION DBETA
CCCCC DOUBLE PRECISION DBAMNJ
CCCCC DOUBLE PRECISION DBAMXJ
C
      EXTERNAL DBETA
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
      DIMENSION XTEMP1(*)
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
      DATA PI /3.141593/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPHI'
      ISUBN2='S2  '
C
      IERROR='NO'
C
      K=(-999)
      DCLMDJ=(-999.0D0)
C
      KP3=0
C
      AN3=0.0
      DENOM=0.0
C
      DCLWID=CLWID
      DXSTAR=XSTART
      DXSTOP=XSTOP
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN DPHIS2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,32)
   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 1;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)N
   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
CCCCC IF(N.GE.2)GOTO49
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,46)
CCC46 FORMAT('***** ERROR IN DPHIS2--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,47)
CCC47 FORMAT('      THE NUMBER OF OBSERVATIONS')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,48)
CCC48 FORMAT('      WAS EXACTLY EQUAL TO 1.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
CCC49 CONTINUE
C
CCCCC SEPTEMBER 2005.  IF ALL ELEMENTS THE SAME, THEN PRINT WARNING
CCCCC                  AND HANDLE AS A SPECIAL CASE.
C
      HOLD=X(1)
      DO60I=1,N
        IF(X(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** WARNING IN DPHIS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL INPUT HORIZONTAL AXIS ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC NOVEMBER 2005.  MOVE THIS LINE SINCE SECTION BELOW IS
CCCCC                 SPECIFICALLY FOR CASE WHERE ALL ELEMENTS
CCCCC                 ARE IDENTICAL.
CCC69 CONTINUE
C
      IF(IDATSW.EQ.'RAW')THEN
        N2=3
        X2(1)=HOLD-1.0
        X2(2)=HOLD
        X2(3)=HOLD+1.0
        IF(IRELAT.EQ.'ON')THEN
          Y2(1)=0.0
          Y2(2)=1.0
          Y2(3)=0.0
        ELSE
          Y2(1)=0.0
          Y2(2)=REAL(N)
          Y2(3)=0.0
        ENDIF
        NPLOTV=2
        GOTO9000
      ENDIF
C
   69 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('***** AT THE BEGINNING OF DPHIS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IDATSW
   71 FORMAT('IDATSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)N,CLWID,XSTART,XSTOP
   72 FORMAT('N,CLWID,XSTART,XSTOP = ',I6,3E15.7)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      WRITE(ICOUT,74)I,Y(I),X(I)
   74 FORMAT('I, Y(I), X(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   80 CONTINUE
C
C               **********************************************
C               **  STEP 2--                                **
C               **  IF NECESSARY,                           **
C               **  DETERMINE CLASS WIDTH,                  **
C               **  START VALUE, STOP VALUE,                **
C               **  AND NUMBER OF CLASSES.                  **
C               **********************************************
C
      IF(IDATSW.EQ.'RAW')GOTO110
      IF(IDATSW.EQ.'FREQ')GOTO150
C
  110 CONTINUE
      IF(ICASPL.EQ.'ASHR')THEN
        CALL DPBINA(X,N,CLWID,XSTART,XSTOP,M,
     1              XTEMP1,MAXOBV,
     1              IRELAT,IASHWT,IHSTCW,
     1              Y2,X2,N2,IBUGG3,IERROR)
        DO112I=1,N2
          D2(I)=1.0
  112   CONTINUE
        GOTO9000
      ELSE
        IF(CLWID.EQ.CPUMIN.OR.XSTART.EQ.CPUMIN.OR.
     1     XSTOP.EQ.CPUMAX)THEN
           IWRIT2='OFF'
           CALL MEAN(X,N,IWRIT2,XMEAN,IBUGG3,IERROR)
           CALL SD(X,N,IWRIT2,XSD,IBUGG3,IERROR)
C
CCCCC SEPTEMBER 2004.  SUPPORT ALTERNATIVE ALGORITHMS FOR
CCCCC CLASS WIDTH.  THESE ALTERNATIVES GIVEN IN DAVID SCOTT,
CCCCC 1992, "MULTIVARIATE DENSITY ESTIMATION: THEORY, PRACTICE,
CCCCC AND VISUALIZATION", WILEY.
C
           IF(IHSTCW.EQ.'DEFA')THEN
             IF(CLWID.EQ.CPUMIN)DCLWID=0.3*XSD
           ELSEIF(IHSTCW.EQ.'NORM')THEN
             IF(CLWID.EQ.CPUMIN)DCLWID=3.5*XSD/(REAL(N)**(1./3.))
           ELSEIF(IHSTCW.EQ.'NCOR')THEN
             IF(CLWID.EQ.CPUMIN)THEN
               CALL STMOM3(X,N,IWRIT2,XSKEW,IBUGG3,IERROR)
               CALL STMOM4(X,N,IWRIT2,XKURT,IBUGG3,IERROR)
               TERM1=3.5*XSD/(REAL(N)**(1./3.))
               IF(XSKEW.GT.0.0 .AND. XSKEW.LT.3.0)THEN
                 TERM2=1.0/(1.0 - 0.0060*XSKEW + 0.27*XSKEW**2 -
     1                 0.0069*XSKEW**3)
               ELSE
                 TERM2=1.0
               ENDIF
               XKURT=XKURT - 3.0
               IF(XKURT.GT.0.0 .AND. XKURT.LT.6.0)THEN
                 TERM3=1.0 - 0.2*(1.0 - EXP(-0.7*XKURT))
               ELSE
                 TERM3=1.0
               ENDIF
               DCLWID=DBLE(TERM1*TERM2*TERM3)
             ENDIF
           ELSEIF(IHSTCW.EQ.'IQ  ')THEN
             IF(CLWID.EQ.CPUMIN)THEN
               CALL LOWQUA(X,N,IWRIT2,XTEMP1,MAXOBV,XLOWQ,
     1                     IBUGG3,IERROR)
               CALL UPPQUA(X,N,IWRIT2,XTEMP1,MAXOBV,XUPPQ,
     1                     IBUGG3,IERROR)
               XIQ=XUPPQ - XLOWQ
               DCLWID=2.603*XIQ/(REAL(N)**(1./3.))
             ENDIF
           ELSE
             IF(CLWID.EQ.CPUMIN)DCLWID=0.3*XSD
           ENDIF
C
           IF(XSTART.EQ.CPUMIN)DXSTAR=XMEAN-6.0*XSD
           IF(XSTOP.EQ.CPUMAX)DXSTOP=XMEAN+6.0*XSD
        ENDIF
      ENDIF
      GOTO180
C
  150 CONTINUE
      CALL SORT(X,N,D2)
      NM1=N-1
      DCLWID=D2(2)-D2(1)
      DO160I=1,NM1
      IP1=I+1
      DDELI=D2(IP1)-D2(I)
      IF(DDELI.LT.DCLWID)DCLWID=DDELI
  160 CONTINUE
      DD21=D2(1)
      DD2N=D2(N)
      DXSTAR=DD21-(DCLWID/2.0D0)
      DXSTOP=DD2N+(DCLWID/2.0D0)
      GOTO180
C
  180 CONTINUE
      DTOTWI=DXSTOP-DXSTAR
      ANUMCL=DTOTWI/DCLWID
      NUMCLA=ANUMCL+1.0
C
      J=NUMCLA-1
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      DABSDE=DABS(DCLMXJ-DXSTOP)
      IF(DABSDE.LE.0.0001D0)NUMCLA=NUMCLA-1
C
C               *******************************************************
C               **  STEP 3--                                         **
C               **  DETERMINE THE FREQUENCY (COUNTS) FOR EACH CLASS  **
C               *******************************************************
C
      DO300J=1,NUMCLA
      D2(J)=0.0
  300 CONTINUE
C
      IF(IDATSW.EQ.'RAW')GOTO410
      IF(IDATSW.EQ.'FREQ')GOTO510
C
  410 CONTINUE
      IBELOW=0
      IABOVE=0
      DO420I=1,N
      DXI=X(I)
      IF(DXI.LT.DXSTAR)THEN
        IBELOW=IBELOW+1
        GOTO420
      ENDIF
      IF(DXI.GT.DXSTOP)THEN
        IABOVE=IABOVE+1
        GOTO420
      ENDIF
      DO430J=1,NUMCLA
      J2=J
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      IF(DCLMNJ.LE.DXI.AND.DXI.LT.DCLMXJ)GOTO440
  430 CONTINUE
      GOTO420
  440 CONTINUE
      D2(J2)=D2(J2)+1.0
  420 CONTINUE
C
C     FOR THIS RAW DATA CASE,
C     TREAT THE SPECIAL CASE OF EQUALITY
C     WITH THE UPPER LIMIT OF THE LAST (RIGHT-MOST) CLASS
C
      J=NUMCLA
      DO450I=1,N
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      DXI=X(I)
      IF(DXI.EQ.DCLMXJ)D2(J)=D2(J)+1.0
  450 CONTINUE
      GOTO590
C
  510 CONTINUE
      IBELOW=0
      IABOVE=0
      DO520I=1,N
      DXI=X(I)
      IF(DXI.LT.DXSTAR)THEN
        IBELOW=IBELOW+1
        GOTO520
      ENDIF
      IF(DXI.GT.DXSTOP)THEN
        IABOVE=IABOVE+1
        GOTO520
      ENDIF
      DO530J=1,NUMCLA
      J2=J
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      IF(DCLMNJ.LE.DXI.AND.DXI.LT.DCLMXJ)GOTO540
  530 CONTINUE
      GOTO520
  540 CONTINUE
      D2(J2)=D2(J2)+Y(I)
  520 CONTINUE
C
C     FOR THIS FREQUENCY DATA CASE,
C     TREAT THE SPECIAL CASE OF EQUALITY
C     WITH THE UPPER LIMIT OF THE LAST (RIGHT-MOST) CLASS
C     (ALTHOUGH THIS SHOULD NOT HAPPEN WITH THE IDATSW = 'FREQ' CASE.)
C
      J=NUMCLA
      DO550I=1,N
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      DXI=X(I)
      IF(DXI.EQ.DCLMXJ)D2(J)=D2(J)+Y(I)
  550 CONTINUE
      GOTO590
C
  590 CONTINUE
      IF(IBELOW.GE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1591)IBELOW,DXSTAR
 1591 FORMAT('***** WARNING: ',I8,' DATA POINTS ARE BELOW THE ',
     1       'MINIMUM CLASS VALUE OF ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(IABOVE.GE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1691)IABOVE,DXSTOP
 1691 FORMAT('***** WARNING: ',I8,' DATA POINTS ARE ABOVE THE ',
     1       'MAXIMUM CLASS VALUE OF ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(IBUGG3.EQ.'OFF')GOTO595
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,591)
  591 FORMAT('***** IN THE MIDDLE    OF DPHIS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,592)DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA
  592 FORMAT('DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA= ',
     14D11.4,F10.0,I8)
      CALL DPWRST('XXX','BUG ')
      DO593J=1,NUMCLA
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      FJ=D2(J)
      WRITE(ICOUT,594)J,DCLMNJ,DCLMXJ,FJ
  594 FORMAT('J,DCLMNJ,DCLMXJ,FJ = ',I8,2D15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
  593 CONTINUE
  595 CONTINUE
C
C               **********************************
C               **  STEP 4--                    **
C               **  DETERMINE PLOT COORDINATES  **
C               **********************************
C
CCCCC IF(DBAWID.EQ.CPUMIN)DBAWID=DCLWID
C
      IF(ICASPL.EQ.'HIST')GOTO1100
      IF(ICASPL.EQ.'CUMH')GOTO1200
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPHIS2 ',
     1'AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      ICASPL SHOULD BE EITHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      HIST   OR    CUMH, BUT IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)ICASPL
 1014 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1100 CONTINUE
      SUM=0.0
      DO1110J=1,NUMCLA
      FJ=D2(J)
      SUM=SUM+FJ
 1110 CONTINUE
      AN3=SUM
C
      DENOM=1.0
C     RELATIVE HISTOGRAM CORRECTION MADE FEBRUARY 26, 1988
CCCCC IF(IRELAT.EQ.'ON')DENOM=AN3         COMMENTED OUT JUNE 1994
CCCCC IF(IRELAT.EQ.'ON')DENOM=AN3*DCLWID  COMMENTED OUT FEB 1988
CCCCC THE FOLLOWING LINE FIXES THE RELATIVE HISTOGRAM AREA JUNE 1994
CCCCC IF(IRELAT.EQ.'ON')DENOM=AN3*DCLWID
CCCCC IF(IRELAT.EQ.'ON')DENOM=AN3
CCCCC MARCH 1996.  ABOVE LINE COMMENTED OUT.  NOTE THAT THERE ARE 2
CCCCC WAYS TO DEFINE HEIGHT FOR RELATIVE HISTOGRAM.  ONE WAY DEFINES
CCCCC THE AREA SO THAT THE AREA SUMS TO 1 (I.E., THE INTEGRAL) AS IN
CCCCC A PROBABILITY DENSITY FUNCTION.  THE OTHER WAY IS SO THAT THE
CCCCC THE HEIGHTS SUM TO 1, I.E., THE HEIGHT IS THE PERCENT OF THE
CCCCC TOTAL.  THE IRHSTG SWITCH NOW DETERMINES WHICH METHOD IS USED.
C
      IF(IRELAT.EQ.'ON')THEN
        IF(IRHSTG.EQ.'PERC')THEN
          DENOM=AN3
        ELSE
          DENOM=AN3*DCLWID
        ENDIF
      ENDIF
C
      DO1120J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
      K=J
C
CCCCC DJ=J
CCCCC DCLMDJ=DXSTAR+(DJ-0.5D0)*DCLWID
CCCCC DBAMNJ=DCLMDJ-DBAWID/2.0D0
CCCCC DBAMXJ=DCLMDJ+DBAWID/2.0D0
      DJ=J
      DCLMDJ=DXSTAR+(DJ-0.5D0)*DCLWID
C
      FJ=D2(J)
C
CCCCC X2(K)=DBAMNJ
CCCCC X2(KP1)=DBAMNJ
CCCCC X2(KP2)=DBAMXJ
CCCCC X2(KP3)=DBAMXJ
      X2(K)=DCLMDJ
C
CCCCC Y2(K)=0.0
CCCCC Y2(KP1)=FJ/DENOM
CCCCC Y2(KP2)=FJ/DENOM
CCCCC Y2(KP3)=0.0
      Y2(K)=FJ/DENOM
C
 1120 CONTINUE
CCCCC N2=KP3
      N2=K
      NPLOTV=2
C
      DO1130J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
      K=J
C
CCCCC D2(K)=1.0
CCCCC D2(KP1)=1.0
CCCCC D2(KP2)=1.0
CCCCC D2(KP3)=1.0
      D2(K)=1.0
C
 1130 CONTINUE
      GOTO9000
C
 1200 CONTINUE
      SUM=0.0
      DO1210J=1,NUMCLA
      FJ=D2(J)
      SUM=SUM+FJ
 1210 CONTINUE
      AN3=SUM
C
      DENOM=1.0
C     RELATIVE HISTOGRAM CORRECTION MADE FEBRUARY 26, 1988
CCCCC IF(IRELAT.EQ.'ON')DENOM=AN3
CCCCC IF(IRELAT.EQ.'ON')DENOM=AN3*DCLWID
CCCCC MARCH 1996.  ABOVE LINE COMMENTED OUT.  NOTE THAT THERE ARE 2
CCCCC WAYS TO DEFINE HEIGHT FOR RELATIVE HISTOGRAM.  ONE WAY DEFINES
CCCCC THE AREA SO THAT THE AREA SUMS TO 1 (I.E., THE INTEGRAL) AS IN
CCCCC A PROBABILITY DENSITY FUNCTION.  THE OTHER WAY IS SO THAT THE
CCCCC THE HEIGHTS SUM TO 1, I.E., THE HEIGHT IS THE PERCENT OF THE
CCCCC TOTAL.  THE IRHSTG SWITCH NOW DETERMINES WHICH METHOD IS USED.
C
      IF(IRELAT.EQ.'ON')THEN
        IF(IRHSTG.EQ.'PERC')THEN
          DENOM=AN3
        ELSE
          DENOM=AN3*DCLWID
        ENDIF
      ENDIF
C
C
      SUM=0.0
      DO1220J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
      K=J
C
CCCCC DJ=J
CCCCC DCLMDJ=DXSTAR+(DJ-0.5D0)*DCLWID
CCCCC DBAMNJ=DCLMDJ-DBAWID/2.0
CCCCC DBAMXJ=DCLMDJ+DBAWID/2.0
      DJ=J
      DCLMDJ=DXSTAR+(DJ-0.5D0)*DCLWID
C
      FJ=D2(J)
      SUM=SUM+FJ
      CUMFJ=SUM
C
CCCCC X2(K)=DBAMNJ
CCCCC X2(KP1)=DBAMNJ
CCCCC X2(KP2)=DBAMXJ
CCCCC X2(KP3)=DBAMXJ
      X2(K)=DCLMDJ
C
CCCCC Y2(K)=0.0
CCCCC Y2(KP1)=CUMFJ/DENOM
CCCCC Y2(KP2)=CUMFJ/DENOM
CCCCC Y2(KP3)=0.0
      Y2(K)=CUMFJ/DENOM
C
 1220 CONTINUE
CCCCC N2=KP3
      N2=K
      NPLOTV=2
C
      DO1230J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
      K=J
C
CCCCC D2(K)=1.0
CCCCC D2(KP1)=1.0
CCCCC D2(KP2)=1.0
CCCCC D2(KP3)=1.0
      D2(K)=1.0
C
 1230 CONTINUE
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHIS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IRELAT,IERROR,N2
 9012 FORMAT('ICASPL,IRELAT,IERROR,N2 = ',A4,2X,A4,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDATSW,AN3,DENOM
 9013 FORMAT('IDATSW,AN3,DENOM = ',A4,2X,E15.8,E15.8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)N,DCLWID,DXSTAR,DXSTOP
 9017 FORMAT('N,DCLWID,DXSTAR,DXSTOP = ',I6,3D15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHIST(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,
CCCCC MARCH 1996.  ADD FOLLOWING LINE
     1IRHSTG,IHSTCW,IASHWT,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 4 PLOTS--
C              1) HISTOGRAM;
C              2) RELATIVE HISTOGRAM;
C              3) CUMULATIVE HISTOGRAM;
C              4) RELATIVE CUMULATIVE HISTOGRAM;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --MARCH     1996. ADD IRHSTG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IRELAT
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IDATSW
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC MARCH 1996.  ADD FOLLOWING LINE
      CHARACTER*4 IRHSTG
CCCCC SEPTEMBER 2004.  ADD FOLLOWING LINE
      CHARACTER*4 IHSTCW
      CHARACTER*4 IASHWT
C
C---------------------------------------------------------------------
C
      DIMENSION CLLIMI(*)
      DIMENSION CLWIDT(*)
CCCCC DIMENSION BAWIDT(*)
C
      INCLUDE 'DPCOPA.INC'
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION XTEMP1(MAXOBV)
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),XTEMP1(1))
CCCCC END CHANGE
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPHI'
      ISUBN2='ST  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=1
C
      ICOLR=0
C
C               *******************************************
C               **  TREAT THE HISTOGRAM AND RELATED      **
C               **  STATISTICAL DISTRIBUTION PLOTS CASE  **
C               *******************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHIST--')
      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(ICOM.EQ.'HIST')GOTO110
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'HIST')GOTO120
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CUMU'.AND.IHARG(1).EQ.'HIST')GOTO130
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'CUMU'.AND.IHARG(2).EQ.'HIST')
     1GOTO140
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CUMU'.AND.IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'HIST')
     1GOTO140
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AVER'.AND.IHARG(1).EQ.'SHIF'.AND.IHARG(2).EQ.'HIST')
     1GOTO145
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'ASH '.AND.IHARG(1).EQ.'HIST')
     1GOTO135
      IF(ICOM.EQ.'ASH ')GOTO115
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ICASPL='HIST'
      IRELAT='OFF'
      GOTO180
C
  115 CONTINUE
      ICASPL='ASHR'
      IRELAT='ON'
      GOTO180
C
  120 CONTINUE
      ICASPL='HIST'
      IRELAT='ON'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  130 CONTINUE
      ICASPL='CUMH'
      IRELAT='OFF'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  135 CONTINUE
      ICASPL='ASHR'
      IRELAT='ON'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  140 CONTINUE
      ICASPL='CUMH'
      IRELAT='ON'
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  145 CONTINUE
      ICASPL='ASHR'
      IRELAT='ON'
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')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,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (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 DPHIST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A HISTOGRAM ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A RELATIVE HISTOGRAM ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,323)
  323 FORMAT('      (FOR WHICH A CUMULATIVE HISTOGRAM ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,324)
  324 FORMAT('      (FOR WHICH A RELATIVE CUMULATIVE HISTOGRAM ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'ON')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 DPHIST')
      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 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='5'
      IF(IBUGG2.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
      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(IBUGG2.EQ.'ON')WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT
  511 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NRIGHT.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPHIST--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,552)
  552 FORMAT('      FOR A HISTOGRAM, ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,553)
  553 FORMAT('      FOR A RELATIVE HISTOGRAM, ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,554)
  554 FORMAT('      FOR A CUMULATIVE HISTOGRAM, ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,555)
  555 FORMAT('      FOR A RELATIVE CUMULATIVE HISTOGRAM, ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'ON')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 OR 2  ;')
      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
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPHIST--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,572)
  572 FORMAT('      FOR A HISTOGRAM, ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,573)
  573 FORMAT('      FOR A RELATIVE HISTOGRAM, ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,574)
  574 FORMAT('      FOR A CUMULATIVE HISTOGRAM, ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,575)
  575 FORMAT('      FOR A RELATIVE CUMULATIVE HISTOGRAM, ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)
  578 FORMAT('      WHEN HAVE 2 VARIABLES SPECIFIED, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS IN THE 2 VARIABLES MUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      BE THE SAME.  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  (HORIZ. AXIS VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHRIGH,IHRIG2,NRIGHT
  586 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *****************************************
C               **  STEP 6--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  (BASED ON THE QUALIFIER)           **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
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,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.LE.1)GOTO651
      GOTO652
C
  651 CONTINUE
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)X1(J)=TAGPLO(I)
      GOTO660
C
  652 CONTINUE
      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)
      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)
      GOTO660
C
  660 CONTINUE
      NLOCAL=J
C
C               ****************************************************************
C               **  STEP 7--
C               **  DETERMINE IF THE ANALYST
C               **  HAS SPECIFIED    1)  THE CLASS WIDTH,
C               **                   2)  THE MIN POINT OF THE FIRST CELL,
C               **                   3)  THE MAX POINT OF THE LAST  CELL,
C               **  FOR THE DISTRIBUTIONAL ANALYSIS.
C               **  IF NON-DEFAULT, USE THE SPECIFIED VALUES.
C               **  IF DEFAULT, USE THE DEFAULT VALUES--
C               **     1)  CLASS WIDTH = .3 OF A SAMPLE STANDARD DEVIATION;
C               **     2)  START = SAMPLE MEAN - 6*(SAMPLE STANDARD DEVIATION);
C               **     3)  STOP  = SAMPLE MEAN + 6*(SAMPLE STANDARD DEVIATION);
C               **  NOTE THAT THE DEFAULT SETTINGS ARE IN FACT
C               ****************************************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CLWID=CLWIDT(1)
CCCCC BAWID=BAWIDT(1)
      XSTART=CLLIMI(1)
      XSTOP=CLLIMI(2)
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
        IF(NLOCAL.LE.100)THEN
          M=4
        ELSEIF(NLOCAL.LE.1000)THEN
          M=8
        ELSE
          M=16
        ENDIF
      ELSE
        M=INT(VALUE(ILOCP)+0.5)
        IF(M.LE.0)M=1
        IF(M.GT.64)M=64
      ENDIF
C
C
C               *****************************************************
C               **  STEP 8--                                       **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
C               **  RESET THE VECTOR D(.) TO ALL ONES.             **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
C               *****************************************************
C
      CALL DPHIS2(Y1,X1,NLOCAL,ICASPL,IRELAT,IDATSW,CLWID,XSTART,XSTOP,
CCCCC MARCH 1996.  ADD FOLLOWING LINE
     1XTEMP1,MAXOBV,
     1IRHSTG,IHSTCW,IASHWT,M,
     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)IRELAT,CLWID,XSTART,XSTOP
 9014 FORMAT('IRELAT,CLWID,XSTART,XSTOP = ',A4,2X,3E15.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 DPHOCO(IANS2,N2,IVALID,VALCON,IBUGA3,IERROR)
C
C     PURPOSE--DETERMINE IF THE STRING DEFINED IN IANS2(.)
C              IS A VALID NUMBER REPRESENTATION
C              AND IF SO, COMPUTE THE VALUE OF THE NUMBER.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JULY      1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS2
      CHARACTER*4 IVALID
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IFLUNK
      CHARACTER*4 ITYPE2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IANS2(*)
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='DPHO'
      ISUBN2='CO  '
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 DPHOCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N2
   52 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)(IANS2(I),I=1,N2)
   53 FORMAT('IANS2(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IVALID='NO'
C
C               ********************************************************
C               **  STEP 7--                                          **
C               **  CONVERT (IF POSSIBLE) THE STRING INTO A FLOATING  **
C               **  POINT ARGUMENT.                                   **
C               **  OUTPUT THIS FLOATING POINT VALUE IN FLOAT.        **
C               ********************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      AMIN=-1000000.
      AMAX=+1000000.
      IFLUNK='NO'
      IVALID='YES'
      ITYPE2='NUMB'
      VALCON=CPUMIN
C
      ISTAR2=1
      ISTOP2=N2
C
      ILOC=0
      IDECPT=0
      DO3060I=ISTAR2,ISTOP2
      IF(IANS2(I).EQ.'.')ILOC=I
      IF(IANS2(I).EQ.'.')IDECPT=IDECPT+1
 3060 CONTINUE
      IF(IDECPT.GE.2)GOTO3900
      IF(IDECPT.EQ.1)GOTO3150
      DO3100I=ISTAR2,ISTOP2
      IREV=ISTOP2-(I-ISTAR2)
      IF(IANS2(IREV).EQ.' ')GOTO3100
      IF(IANS2(IREV).EQ.'0')GOTO3110
      IF(IANS2(IREV).EQ.'1')GOTO3110
      IF(IANS2(IREV).EQ.'2')GOTO3110
      IF(IANS2(IREV).EQ.'3')GOTO3110
      IF(IANS2(IREV).EQ.'4')GOTO3110
      IF(IANS2(IREV).EQ.'5')GOTO3110
      IF(IANS2(IREV).EQ.'6')GOTO3110
      IF(IANS2(IREV).EQ.'7')GOTO3110
      IF(IANS2(IREV).EQ.'8')GOTO3110
      IF(IANS2(IREV).EQ.'9')GOTO3110
      IFLUNK='YES'
      IF(IANS2(IREV).EQ.'+')GOTO3900
      IF(IANS2(IREV).EQ.'-')GOTO3900
      GOTO3900
 3100 CONTINUE
      IFLUNK='YES'
      GOTO3900
 3110 ILOC=IREV+1
 3150 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3111)ILOC,IDECPT
 3111 FORMAT('ILOC = ',I8,'    IDECPT = ',I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C     SECONDLY, COMPUTE THE INTEGER PART OF THE VALUE
C
      SIGN=1.0
      IDIGI=0
      ISIGN=0
      SUMI=0
      ILOCM1=ILOC-1
      IF(ILOCM1.LT.ISTAR2)GOTO3250
      DO3200I=ISTAR2,ILOCM1
      IREV=ILOCM1-(I-ISTAR2)
      IF(IANS2(IREV).EQ.' ')GOTO3200
      IF(IANS2(IREV).EQ.'0')GOTO3210
      IF(IANS2(IREV).EQ.'1')GOTO3211
      IF(IANS2(IREV).EQ.'2')GOTO3232
      IF(IANS2(IREV).EQ.'3')GOTO3213
      IF(IANS2(IREV).EQ.'4')GOTO3214
      IF(IANS2(IREV).EQ.'5')GOTO3215
      IF(IANS2(IREV).EQ.'6')GOTO3216
      IF(IANS2(IREV).EQ.'7')GOTO3217
      IF(IANS2(IREV).EQ.'8')GOTO3218
      IF(IANS2(IREV).EQ.'9')GOTO3219
      IF(IANS2(IREV).EQ.'+')GOTO3220
      IF(IANS2(IREV).EQ.'-')GOTO3221
      IFLUNK='YES'
      GOTO3900
 3210 ITERM=0
      GOTO3225
 3211 ITERM=1
      GOTO3225
 3232 ITERM=2
      GOTO3225
 3213 ITERM=3
      GOTO3225
 3214 ITERM=4
      GOTO3225
 3215 ITERM=5
      GOTO3225
 3216 ITERM=6
      GOTO3225
 3217 ITERM=7
      GOTO3225
 3218 ITERM=8
      GOTO3225
 3219 ITERM=9
      GOTO3225
 3220 ISIGN=ISIGN+1
      GOTO3200
 3221 ISIGN=ISIGN+1
      SIGN=-SIGN
      GOTO3200
 3225 IDIGI=IDIGI+1
      TERM=ITERM
      IEXP=IDIGI-1
      SUMI=SUMI+TERM*(10.0**IEXP)
 3200 CONTINUE
 3250 CONTINUE
      IF(ISIGN.GE.2)GOTO3900
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3255)IDIGI,SUMI
 3255 FORMAT('IDIGI = ',I8,'    SUMI = ',F20.10)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C     THIRDLY, COMPUTE THE DECIMAL PART OF THE VALUE
C
      IDIGD=0
      SUMD=0.0
      ILOCP1=ILOC+1
      IF(ILOCP1.GT.ISTOP2)GOTO3350
      DO3300I=ILOCP1,ISTOP2
      IF(IANS2(I).EQ.' ')GOTO3300
      IF(IANS2(I).EQ.'0')GOTO3310
      IF(IANS2(I).EQ.'1')GOTO3311
      IF(IANS2(I).EQ.'2')GOTO3312
      IF(IANS2(I).EQ.'3')GOTO3333
      IF(IANS2(I).EQ.'4')GOTO3314
      IF(IANS2(I).EQ.'5')GOTO3315
      IF(IANS2(I).EQ.'6')GOTO3316
      IF(IANS2(I).EQ.'7')GOTO3317
      IF(IANS2(I).EQ.'8')GOTO3318
      IF(IANS2(I).EQ.'9')GOTO3319
      IFLUNK='YES'
      GOTO3900
 3310 ITERM=0
      GOTO3325
 3311 ITERM=1
      GOTO3325
 3312 ITERM=2
      GOTO3325
 3333 ITERM=3
      GOTO3325
 3314 ITERM=4
      GOTO3325
 3315 ITERM=5
      GOTO3325
 3316 ITERM=6
      GOTO3325
 3317 ITERM=7
      GOTO3325
 3318 ITERM=8
      GOTO3325
 3319 ITERM=9
      GOTO3325
 3325 IDIGD=IDIGD+1
      TERM=ITERM
      SUMD=SUMD+TERM/(10.0**IDIGD)
 3300 CONTINUE
 3350 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3355)IDIGD,SUMD
 3355 FORMAT('IDIGD = ',I8,'    SUMD = ',F20.10)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IDIGT=IDIGI+IDIGD
      IF(IDIGT.LE.0)GOTO3900
      VALCON=SUMI+SUMD
      IF(SIGN.LT.0.0)VALCON=-VALCON
      IF(AMIN.LE.VALCON.AND.VALCON.LE.AMAX)GOTO3000
      GOTO3900
C
 3900 CONTINUE
      IF(IFLUNK.EQ.'YES')ITYPE2='WORD'
 3000 CONTINUE
 3999 CONTINUE
      GOTO8000
C
C               ******************************
C               **  STEP 7--                **
C               **  DEFINE IF VALID OR NOT  **
C               ******************************
C
 8000 CONTINUE
      IF(IFLUNK.EQ.'YES')IVALID='NO'
      IF(IFLUNK.EQ.'NO')IVALID='YES'
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHOCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IVALID,VALCON
 9012 FORMAT('IVALID,VALCON = ',A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFLUNK,ITYPE2
 9013 FORMAT('IFLUNK,ITYPE2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IERROR
 9015 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHOMO(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A HOMOGENEITY PLOT--
C              A PLOT OF SUBSET STANDARD DEVIATION VERSUS SUBSET MEAN
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--MARCH     1986.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
CCCCC CHARACTER*4 IH
CCCCC CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
C
      DIMENSION XIDTEM(MAXOBV)
      DIMENSION TEMP(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPHO'
      ISUBN2='MO  '
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 HOMOGENEITY PLOT CASE  **
C               *******************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHOMO--')
      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
      ICASPL='HOMO'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO111
      GOTO119
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO119
C
  119 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               ***********************************************************
C               **  STEP 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=2
      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 DPHOMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A HOMOGENEITY PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)MINN2
  326 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,329)(IANS(I),I=1,IWIDTH)
  329 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPHOMO')
      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 (IT MUST), 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 AND                 **
C               **  STANDARD DEVIATIONS ARE TO BE COMPUTED.
C               **  THE VALUES IN THE SECOND VARIABLE                     **
C               **  ARE THE X VALUES FOR EACH MEAN, STANDARD DEVIATION,   **
C               **  ETC.  IN THE RESULTING I   PLOT     .                 **
C               **  THE VALUES IN THE SECOND VARIABLE                     **
C               **  NEED NOT HAVE BEEN PREVIOUSLY                         **
C               **  SORTED OR HAVE COMMON VALUES ADJACENT.                **
C               **  IF WE HAVE THE 2-VARIABLE CASE,                       **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.        **
C               ************************************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.2)GOTO530
      GOTO510
C
  510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPHOMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,512)
  512 FORMAT('      FOR A HOMOGENEITY PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,518)
  518 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,519)
  519 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,520)
  520 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,521)
  521 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,522)NUMV2
  522 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,523)
  523 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,524)(IANS(I),I=1,IWIDTH)
  524 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  530 CONTINUE
      IHHOR=IHARG(2)
      IHHOR2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH=IVALUE(ILOCV)
      NHOR=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,531)IHHOR,ICOLH,NHOR
  531 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NHOR.NE.NLEFT)GOTO570
      GOTO590
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPHOMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A HOMOGENEITY PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,580)
  580 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      THE FIRST  VARIABLE  (RESPONSE VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,NLEFT
  584 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)
  585 FORMAT('      THE SECOND VARIABLE  (HORIZ. AXIS VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHHOR,NHOR
  586 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *************************************************
C               **  STEP 6--                                   **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
      IF(NUMV2.LE.1)GOTO660
C
      IJ=MAXN*(ICOLH-1)+I
      IF(ICOLH.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLH.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLH.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLH.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLH.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLH.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLH.EQ.MAXCP6)X1(J)=TAGPLO(I)
C
  660 CONTINUE
      NLOCAL=J
C
C               *************************************************************
C               **  STEP 8--                                               **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                  **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.                     **
C               **  DEFINE THE VECTOR D(.) TO 1'S, 2'S, AND 3'S            **
C               **  FOR THE PLOTTED VALUE, THE LOWER CONFIDENCE LINE,      **
C               **  AND THE UPPER CONFIDENCE LINE.                         **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  809 CONTINUE
      CALL DPHOM2(Y1,X1,NLOCAL,NUMV2,ICASPL,ISIZE,
     1XIDTEM,TEMP,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHOMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISIZE
 9014 FORMAT('ISIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHOM2(Y,X,N,NUMV2,ICASPL,ISIZE,
     1XIDTEM,TEMP,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN HOMOGENEITY PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
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     1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION XIDTEM(*)
      DIMENSION TEMP(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPHO'
      ISUBN2='M2  '
C
      I2=0
      AN=0.0
C
      N50=1
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPHOM2--')
      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 DPHOM2--')
      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 DPHOM2--')
      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 DPHOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,NUMV2
   71 FORMAT('N,ICASPL,NUMV2 = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO72I=1,N
      WRITE(ICOUT,73)I,Y(I),X(I)
   73 FORMAT('I, Y(I), X(I) = ',I8,2F15.7)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES           **
C               **  FOR VARIABLE 2 (THE GROUP VARIABLE).              **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS             **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE           **
C               **  WHICH IS AN ERROR CONDITION FOR A HOMOGENEITY PLOT .       *
*
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMSET=0
      DO160I=1,N
      IF(NUMSET.EQ.0)GOTO165
      DO170J=1,NUMSET
      IF(X(I).EQ.XIDTEM(J))GOTO160
  170 CONTINUE
  165 CONTINUE
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=X(I)
  160 CONTINUE
      CALL SORT(XIDTEM,NUMSET,XIDTEM)
C
      XID1=XIDTEM(1)
      XID2=XIDTEM(NUMSET)
C
  190 CONTINUE
C
      IF(NUMSET.EQ.0)WRITE(ICOUT,191)
  191 FORMAT('ERROR IN DPHOM2   SUBROUTINE--NUMSET = 0')
      IF(NUMSET.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.0)GOTO9000
      IF(NUMSET.EQ.0)IERROR='YES'
C
      IF(NUMSET.EQ.N)WRITE(ICOUT,192)
  192 FORMAT('ERROR IN DPHOM2   SUBROUTINE--NUMSET = N')
      IF(NUMSET.EQ.N)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.N)IERROR='YES'
      IF(NUMSET.EQ.N)GOTO9000
C
C               ***************************************************
C               **  STEP 4--                                     **
C               **  DETERMINE PLOT COORDINATES                   **
C               ***************************************************
C
 1100 CONTINUE
C
      ISTEPN='4'
      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
C
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,1121)ISET,XIDTEM(ISET),NI
 1121 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NI.LE.1)GOTO1110
      CALL SORT(TEMP,NI,TEMP)
      IWRITE='OFF'
      SUM=0.0
      CALL MEAN(TEMP,NI,IWRITE,XMEAN,IBUGG3,IERROR)
      CALL SD(TEMP,NI,IWRITE,XSD,IBUGG3,IERROR)
      J=J+1
      Y2(J)=XSD
      X2(J)=XMEAN
      D2(J)=1.0
C
 1110 CONTINUE
C
      N2=J
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,N,NUMSET,N2,IERROR
 9012 FORMAT('ICASPL,N,NUMSET,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMV2
 9013 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)AN,NI
 9014 FORMAT('AN,NI = ',E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHORI(IHARG,IARGT,ARG,NUMARG,
     1PDEFHG,
     1PTEXHG,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE HORIZONTAL GAP FOR TEXT CHARACTERS.
C              THE HORIZONTAL GAP FOR TEXT CHARACTERS WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PTEXHG.
C     NOTE--THE HORIZONTAL GAP IS IN STANDARDIZED UNITS (0.0 TO 100.0).
C     NOTE--THE HORIZONTAL GAP IS THE BETWEEN-CHARACTER SPACING (DISTANCE)
C           FROM THE END OF ONE CHARACTER
C           TO THE BEGINNING OF THE NEXT CHARACTER.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PDEFHG
C                     --IBUGD2
C     OUTPUT ARGUMENTS--PTEXHG
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHORI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PDEFHG
   53 FORMAT('PDEFHG = ',E15.7)
      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),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
   90 CONTINUE
C
C               *************************************
C               **  TREAT THE HORIZONTAL GAP CASE  **
C               *************************************
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(NUMARG.EQ.1.AND.IHARG(NUMARG).EQ.'GAP')GOTO1150
      IF(NUMARG.EQ.1.AND.IHARG(NUMARG).EQ.'SPAC')GOTO1150
      IF(NUMARG.EQ.1.AND.IHARG(NUMARG).EQ.'DIST')GOTO1150
      IF(NUMARG.EQ.1.AND.IHARG(NUMARG).EQ.'LENG')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
C
      IF(NUMARG.GE.1.AND.IARGT(NUMARG).EQ.'NUMB')
     1GOTO1160
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPHORI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR HORIZONTAL GAP ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE IT IS DESIRED THAT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE TEXT CHARACTERS HAVE A HORIZONTAL SPACING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      OF 2 (WHERE THE HORIZONTAL SCREEN UNITS RANGE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      FROM 0 TO 100,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('           HORIZONTAL SPACING 5 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PTEXHG=PDEFHG
      GOTO1180
C
 1160 CONTINUE
      PTEXHG=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE HORIZONTAL SPACING (FOR TEXT CHARACTERS)  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PTEXHG
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      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 DPHORI--')
      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)PTEXHG
 9013 FORMAT('PTEXHG = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHOSL(IHARG,NUMARG,IDEFHL,
     1IHOSLI,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TYPE OF COMMUNICATIONS LINK
C              (E.G., NBS NETWORK, PHONE LINES, ETC.)
C              BETWEEN HOST AND TERMINAL.
C              THE HOST LINK INFORMATION
C              WILL BE PLACED IN THE VARIOUS ELEMENTS OF THE
C              IHOSLI(.) VECTOR.
C              AS MUCH DETAIL AS NECESSARY
C              MAY BE USED TO DESCRIBE
C              THE HOST LINK.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFHL (A  HOLLERITH VECTOR)
C     OUTPUT ARGUMENTS--IHOSLI (A HOLLERITH VECTOR
C                              WHICH CONTAINS THE HOST
C                              SPECIFICATIONS.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
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 IDEFHL
      CHARACTER*4 IHOSLI
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IDEFHL(*)
      DIMENSION IHOSLI(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      GOTO1110
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1130
      GOTO1150
C
 1130 CONTINUE
      DO1135I=1,10
      IHOSLI(I)=IDEFHL(I)
 1135 CONTINUE
      GOTO1180
C
 1150 CONTINUE
 
      IF(IHARG(2).EQ.'OFF')GOTO1160
      IF(IHARG(2).EQ.'AUTO')GOTO1160
      IF(IHARG(2).EQ.'DEFA')GOTO1160
      GOTO1170
C
 1160 CONTINUE
      DO1165I=1,10
      IHOSLI(I)=IDEFHL(I)
 1165 CONTINUE
      GOTO1180
C
 1170 CONTINUE
      K=1
      DO1175I=1,10
      K=K+1
      IF(K.LE.NUMARG)IHOSLI(I)=IHARG(K)
      IF(K.GT.NUMARG)IHOSLI(I)=' '
 1175 CONTINUE
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('THE HOST LINK (= COMMUNICATIONS LINK) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)(IHOSLI(I),I=1,10)
 1186 FORMAT('HAS JUST BEEN SET TO ',
     1A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPHOST(IHARG,NUMARG,IDEFHO,
     1IHOST,IHOST1,IHOST2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MANUFACTURER, MODEL, ETC. FOR THE
C              HOST COMPUTER.
C              THE HOST INFORMATION
C              WILL BE PLACED IN THE VARIOUS ELEMENTS OF THE
C              IHOST(.) VECTOR.
C              AS MUCH DETAIL (FOR EXAMPLE, MODEL NUMBER,
C              OPERATING SYSTEM, ETC.) MAY BE USED TO DESCRIBE
C              THE HOST COMPUTER.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFHO (A  HOLLERITH VECTOR)
C     OUTPUT ARGUMENTS--IHOST  (A HOLLERITH VECTOR
C                              WHICH CONTAINS THE HOST
C                              SPECIFICATIONS.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
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 IDEFHO
      CHARACTER*4 IHOST
      CHARACTER*4 IHOST1
      CHARACTER*4 IHOST2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IDEFHO(*)
C
      DIMENSION IHOST(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      GOTO1110
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1130
      IF(IHARG(1).NE.'MANU')GOTO1120
      IF(IHARG(1).EQ.'MANU')GOTO1150
C
 1120 CONTINUE
      IF(IHARG(1).EQ.'ON')GOTO1130
      IF(IHARG(1).EQ.'OFF')GOTO1130
      IF(IHARG(1).EQ.'AUTO')GOTO1130
      IF(IHARG(1).EQ.'DEFA')GOTO1130
      GOTO1140
C
 1130 CONTINUE
      DO1135I=1,10
      IHOST(I)=IDEFHO(I)
 1135 CONTINUE
      GOTO1180
C
 1140 CONTINUE
      K=0
      DO1145I=1,10
      K=K+1
      IF(K.LE.NUMARG)IHOST(I)=IHARG(K)
      IF(K.GT.NUMARG)IHOST(I)=' '
 1145 CONTINUE
      GOTO1180
C
 1150 CONTINUE
      IF(IHARG(2).EQ.'ON')GOTO1160
      IF(IHARG(2).EQ.'OFF')GOTO1160
      IF(IHARG(2).EQ.'AUTO')GOTO1160
      IF(IHARG(2).EQ.'DEFA')GOTO1160
      GOTO1170
C
 1160 CONTINUE
      DO1165I=1,10
      IHOST(I)=IDEFHO(I)
 1165 CONTINUE
      GOTO1180
C
 1170 CONTINUE
      K=1
      DO1175I=1,10
      K=K+1
      IF(K.LE.NUMARG)IHOST(I)=IHARG(K)
      IF(K.GT.NUMARG)IHOST(I)=' '
 1175 CONTINUE
      GOTO1180
C
 1180 CONTINUE
      IHOST1=IHOST(1)
      IHOST2=IHOST(2)
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)(IHOST(I),I=1,10)
 1185 FORMAT('THE HOST HAS JUST BEEN SET TO ',
     1A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPHRIZ(IHARG,NUMARG,IHORSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE HORIZONTAL SWITCH IHORSW
C              (DETERMINES WHETHER PLOTS DRAWN HORIZONTALLY OR
C              VERTICALLY.  USEFUL FOR SPIKES (TO DO DOT CHARTS
C              SUGGESTED BY CLEVLEAND), BAR CHARTS, DOING CHARTS
C              IN "PORTRAIT" MODE).
C              HANGING HISTOGRAMS).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IHORSW  ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHORSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1199
      IF(NUMARG.GE.2)GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      IHORSW='ON'
      GOTO1180
C
 1160 CONTINUE
      IHORSW='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IHORSW
 1181 FORMAT('THE HORIZONTAL SWITCH HAS JUST BEEN TURNED ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPHTCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICONT,IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A HOTELLING MULTIVARIATE CONTROL CHART --
C              ESSENTIALLY COMPUTES A HOTELLING T-SQUARE (1-SAMPLE)
C              STATISTIC FOR EACH SUBGROUP.  THESE HOTELLING VALUES
C              ARE PLOTTTED AS A CONTROL CHART.
C     FEBRUARY 2003:
C     SUPPORT FOUR DISTINCT CASES FOR HOTELLING CONTROL CHARTS.
C       1) PHASE I HOTELLING CONTROL CHART Y1 ... YK GROUP
C       2) PHASE I HOTELLING INDIVIDUAL CONTROL CHART Y1 ... YK
C       3) PHASE II HOTELLING CONTROL CHART Y1 ... YK GROUP HIST
C       4) PHASE II HOTELLING INDIVIDUAL CONTROL CHART Y1 ... YK GROUP
C     IF PHASE <I/II> OMITTED, ASSUME A PHASE I CHART.
C     WRITTEN BY--ALAN HECKERT
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
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/9
C     ORIGINAL VERSION--SEPTEMBER 1998.
C     UPDATED         --MARCH     2003. SUPPORT FOR 4 TYPES OF CHARTS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
      CHARACTER*4 IFLGGR
      CHARACTER*4 IFLGHI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
C  MAXHOT IS THE MAXIMUM NUMBER OF VARIABLES TO USE IN CREATING THE
C  HOTELLING CHART
C
      PARAMETER(MAXHOT=15)
C
      DIMENSION IVARN1(MAXHOT)
      DIMENSION IVARN2(MAXHOT)
      DIMENSION ILIS(MAXHOT)
C
      DIMENSION X1(MAXOBV)
      DIMENSION XHIST(MAXOBV)
      DIMENSION XIDTEM(MAXOBV)
      DIMENSION XIDTE2(MAXOBV)
      DIMENSION TEMP(MAXOBV)
      DIMENSION XMEANS(MAXOBV)
      DIMENSION XGROUP(MAXOBV)
C
      DIMENSION INDEX(MAXOBV)
      DIMENSION NIJUNK(MAXOBV)
      DIMENSION IGRPST(MAXOBV)
C
      DOUBLE PRECISION DMEAN(MAXOBV)
C
      DIMENSION Z(MAXOBV,MAXHOT)
      DIMENSION ZHIST(MAXOBV,MAXHOT)
      DIMENSION ZMEANS(MAXOBV,MAXHOT)
      DIMENSION S(MAXHOT,MAXHOT)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Z(1,1))
C
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),ZHIST(1,1))
      EQUIVALENCE (G2RBAG(IGAR27),ZMEANS(1,1))
      EQUIVALENCE (G2RBAG(IGAR49),X1(1))
      EQUIVALENCE (G2RBAG(IGAR50),XHIST(1))
      EQUIVALENCE (G2RBAG(IGAR51),XIDTEM(1))
      EQUIVALENCE (G2RBAG(IGAR52),XIDTE2(1))
      EQUIVALENCE (G2RBAG(IGAR53),TEMP(1))
      EQUIVALENCE (G2RBAG(IGAR54),XMEANS(1))
      EQUIVALENCE (G2RBAG(IGAR55),S(1,1))
      EQUIVALENCE (G2RBAG(IGAR56),XGROUP(1))
C
      INCLUDE 'DPCOZD.INC'
      EQUIVALENCE (DGARBG(IDGAR1),DMEAN(1))
C
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (IGARBG(IIGAR1),INDEX(1))
      EQUIVALENCE (IGARBG(IIGAR2),NIJUNK(1))
      EQUIVALENCE (IGARBG(IIGAR3),IGRPST(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPHT'
      ISUBN2='CC  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=1
C
      ICOLH=0
C
      IFLGGR='ON'
      IFLGHI='OFF'
C
C               **********************************************
C               **  TREAT THE HOTELLING CONTROL CHART CASE  **
C               **********************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'HTCC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHTCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG2,IBUGG3,IBUGQ,ISUBRO
   52 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='HTCC'
C
CCCCC FEBRUARY 2003: CHECK FOR THE FOLLOWING:
CCCCC     HOTELLING CONTROL CHART (= PHASE I, GROUP)
CCCCC     MULTIVARIATE CONTROL CHART (= PHASE I, GROUP)
CCCCC     PHASE <I/ONE/1> HOTELLING CONTROL CHART
CCCCC     PHASE <II/TWO/2> HOTELLING CONTROL CHART
CCCCC     PHASE <I/ONE/1> HOTELLING INDIVIDUAL CONTROL CHART
CCCCC     PHASE <II/TWO/2> HOTELLING INDIVIDUAL CONTROL CHART
CCCCC THE WORDS "CONTROL" AND "CHART" ARE OPTIONAL.
C
      IF(ICOM.EQ.'PHAS')THEN
        IF(IHARG(1).EQ.'I'.OR.IHARG(1).EQ.'ONE'.OR.IHARG(1).EQ.'1')THEN
          ICASPL='HT1G'
          ILASTC=1
          IF(IHARG(2).EQ.'HOTE' .OR. IHARG(2).EQ.'MULT')ILASTC=2
          CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
        ELSEIF(IHARG(1).EQ.'II'.OR.IHARG(1).EQ.'TWO'.OR.
     1         IHARG(1).EQ.'2')THEN
          ICASPL='HT2G'
          ILASTC=1
          IF(IHARG(2).EQ.'HOTE' .OR. IHARG(2).EQ.'MULT')ILASTC=2
          CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
        ENDIF
      ELSEIF(ICOM.EQ.'HOTE' .OR. ICOM.EQ.'MULT')THEN
        IF(IHARG(1).EQ.'PHAS' .AND. (IHARG(2).EQ.'I' .OR.
     1     IHARG(2).EQ.'ONE' .OR. IHARG(2).EQ.'1'))THEN
          ILASTC=2
          CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
          ICASPL='HT1G'
        ELSEIF(IHARG(1).EQ.'PHAS' .AND. (IHARG(2).EQ.'II' .OR.
     1     IHARG(2).EQ.'TWO' .OR. IHARG(2).EQ.'2'))THEN
          ILASTC=2
          CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
          ICASPL='HT2G'
        ELSE
          ICASPL='HT1G'
        ENDIF
      ELSE
        IFOUND='NO'
        GOTO9000
      ENDIF
C
C  NOW CHECK FOR WORD "INDIVIDUAL"
C
      IF(IHARG(1).EQ.'INDI')THEN
        IF(ICASPL.EQ.'HT1G')ICASPL='HT1I'
        IF(ICASPL.EQ.'HT2G')ICASPL='HT2I'
        ILASTC=1
        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ENDIF
C
C  NOW CHECK FOR WORD "CONTROL" OR WORD "CHART"
C
      IF(IHARG(1).EQ.'CONT')THEN
        ILASTC=1
        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ENDIF
C
      IF(IHARG(1).EQ.'CHAR')THEN
        ILASTC=1
        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ENDIF
C
      IFOUND='YES'
      IFLGGR='OFF'
      IF(ICASPL.EQ.'HT1G' .OR. ICASPL.EQ.'HT2G')IFLGGR='ON'
      IFLGHI='OFF'
      IF(ICASPL.EQ.'HT2I' .OR. ICASPL.EQ.'HT2G')IFLGHI='ON'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 11--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1180
      DO1100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO1110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO1110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1120
 1100 CONTINUE
      GOTO1180
 1110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1190
 1120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1190
C
 1180 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'HTCC')GOTO1195
      WRITE(ICOUT,1191)NUMARG,ILOCQ,ICASEQ
 1191 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1195 CONTINUE
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **  IF THE   TO   FEATURE IS USED IN THE        **
C               **  ARGUMENT LIST, TRANSLATE THE   TO           **
C               **  EXPLICIT VARIABLE NAMES                     **
C               **  MINIMUM NUMBER OF VARIABLES:                **
C               **     ICASPL=HT1G:   2 + 1 + 0 = 3             **
C               **     ICASPL=HT2G:   2 + 1 + 1 = 3             **
C               **     ICASPL=HT1I:   2 + 0 + 0 = 2             **
C               **     ICASPL=HT2I:   2 + 0 + 1 = 3             **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=ILOCQ-1
      CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXHOT,
     1IHNAME,IHNAM2,IUSE,NUMNAM,
     1IVARN1,IVARN2,NUMVAR,IBUGG2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      MINVAR=2
      IF(IFLGGR.EQ.'ON')MINVAR=MINVAR+1
      IF(IFLGHI.EQ.'ON')MINVAR=MINVAR+1
C
      IF(NUMVAR.LT.MINVAR)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1211)
 1211   FORMAT('***** ERROR IN DPHTCC--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1212)MINVAR
 1212   FORMAT('      THERE MUST BE AT LEAST ',I8,' VARIABLES ')
        CALL DPWRST('XXX','BUG ')
        NUMGRP=0
        IF(IFLGGR.EQ.'ON')NUMGRP=1
        NUMHIS=0
        IF(IFLGHI.EQ.'ON')NUMHIS=1
        WRITE(ICOUT,1214)NUMGRP,NUMHIS
 1214   FORMAT('      (AT LEAST TWO RESPONSE VARIABLES, ',I2,
     1         'GROUP ID VARIABLES, AND ',I2,' HISTORY VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1221)
 1221   FORMAT('      FOR THE HOTELLING CONTROL CHART.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1223)NUMVAR
 1223   FORMAT('      ONLY ',I8,' VARIABLES WERE SPECIFIED.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
 1290 CONTINUE
C
C               ***************************************
C               **  STEP 13--                        **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               **  ALSO CHECK TO ASSURE THAT EACH   **
C               **  OF THE VARIABLES HAS AT LEAST    **
C               **  2 OBSERVATIONS.                  **
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFLAG=0
      DO1300I=1,NUMVAR
C
        IHRIGH=IVARN1(I)
        IHRIG2=IVARN2(I)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        NRIGHT=IN(ILOCV)
        IF(I.EQ.1)THEN
          NTEMP=NRIGHT
        ELSE
          IF(NRIGHT.NE.NTEMP)IFLAG=1
        ENDIF
        ILIS(I)=ILOCV
        IF(NRIGHT.GE.MINN2)GOTO1390
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1311)
 1311   FORMAT('***** ERROR IN DPHTCC--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1312)
 1312   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1325)
 1325   FORMAT('      A HOTELLING CONTROL CHART WAS TO HAVE BEEN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1326)MINN2
 1326   FORMAT('      FORMED MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1327)
 1327   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1328)
 1328   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1329)(IANS(J),J=1,MIN(IWIDTH,80))
 1329     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
 1390 CONTINUE
C
 1300 CONTINUE
C
C
C               ******************************************************
C               **  STEP 1.4--                                      **
C               **  CHECK THAT VARIABLES HAVE THE SAME NUMBER OF    **
C               **  ELEMENTS.                                       **
C               ******************************************************
C
 1400 CONTINUE
      ISTEPN='1.4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFLAG.EQ.0)GOTO1490
C
 1410 CONTINUE
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPHTCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      THE NUMBER OF OBSERVATIONS IN ALL VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      DO1417I=1,NUMVAR
        I2=ILIS(I)
        WRITE(ICOUT,1416)IVARN1(I2),IVARN2(I2),IN(I2)
 1416   FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1         ' OBSERVATIONS;')
        CALL DPWRST('XXX','BUG ')
 1417 CONTINUE
      WRITE(ICOUT,1420)
 1420 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,1421)(IANS(I),I=1,MIN(100,IWIDTH))
 1421   FORMAT('      ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               *************************************************
C               **  STEP 21--                                  **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FOR  EACH OF THE RESPONSE VARIABLES   **
C               **  EXTRACT THE DATA SUBSET                    **
C               **  (USUALLY ONLY 1 OBSERVATION)               **
C               **  AND ALSO EXTRACT THE                       **
C               **  MIN AND MAX FOR THE FULL VARIABLE          **
C               *************************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2110
      IF(ICASEQ.EQ.'SUBS')GOTO2120
      IF(ICASEQ.EQ.'FOR')GOTO2130
C
 2110 CONTINUE
      DO2115I=1,NRIGHT
      ISUB(I)=1
 2115 CONTINUE
      NQ=NRIGHT
      GOTO2190
C
 2120 CONTINUE
      NIOLD=NRIGHT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2190
C
 2130 CONTINUE
      NIOLD=NRIGHT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2190
C
 2190 CONTINUE
C
C               *************************************************
C               **  STEP 22--                                  **
C               **  FOR EACH OF THE RESPONSE VARIABLES,        **
C               **  EXTRACT THE DATA SUBSET                    **
C               **  (FREQUENTLY ONLY 1 OBSERVATION)            **
C               **  AND ALSO EXTRACT THE                       **
C               **  MIN AND MAX FOR THE FULL VARIABLE          **
C               *************************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMRSP=NUMVAR
      IF(IFLGGR.EQ.'ON')NUMRSP=NUMRSP-1
      IF(IFLGHI.EQ.'ON')NUMRSP=NUMRSP-1
      NGROUP=0
      IF(IFLGGR.EQ.'ON')NGROUP=NUMRSP+1
      NHIST=0
      IF(IFLGHI.EQ.'ON')THEN
        NHIST=NUMRSP+1
        IF(IFLGGR.EQ.'ON')NHIST=NHIST+1
      ENDIF
C
      DO2200K=1,NUMVAR
        IHRIGH=IVARN1(K)
        IHRIG2=IVARN2(K)
C
        DO2210I=1,NUMNAM
          I2=I
          IF(IHRIGH.EQ.IHNAME(I).AND.IHRIG2.EQ.IHNAM2(I).AND.
     1       IUSE(I).EQ.'V')GOTO2219
 2210   CONTINUE
        WRITE(ICOUT,2211)
 2211   FORMAT('***** INTERNAL ERROR IN DPHTCC AT POINT 2210--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2212)IHRIGH,IHRIG2
 2212   FORMAT('      THE VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2213)
 2213   FORMAT('      NOT NOW FOUND IN INTERNAL NAME LIST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2214)
 2214   FORMAT('      ALTHOUGH IT WAS FOUND EARLIER.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2215)
 2215   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2216)(IANS(I),I=1,MIN(80,IWIDTH))
 2216     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
 2219   CONTINUE
C
        ILISTR=I2
        ICOLR=IVALUE(ILISTR)
        NRIGHT=IN(ILISTR)
C
        J=0
        IMAX=NRIGHT
        IF(NQ.LT.NRIGHT)IMAX=NQ
        IF(K.LE.NUMRSP)THEN
          DO2240I=1,IMAX
            IF(ISUB(I).EQ.0)GOTO2240
            J=J+1
            IJ=MAXN*(ICOLR-1)+I
            IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')THEN
              WRITE(ICOUT,2241)I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX
 2241         FORMAT('I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX = ',8I8)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            IF(ICOLR.LE.MAXCOL)Z(J,K)=V(IJ)
            IF(ICOLR.EQ.MAXCP1)Z(J,K)=PRED(I)
            IF(ICOLR.EQ.MAXCP2)Z(J,K)=RES(I)
            IF(ICOLR.EQ.MAXCP3)Z(J,K)=YPLOT(I)
            IF(ICOLR.EQ.MAXCP4)Z(J,K)=XPLOT(I)
            IF(ICOLR.EQ.MAXCP5)Z(J,K)=X2PLOT(I)
            IF(ICOLR.EQ.MAXCP6)Z(J,K)=TAGPLO(I)
 2240     CONTINUE
        ELSEIF(K.EQ.NGROUP)THEN
          DO2250I=1,IMAX
            IF(ISUB(I).EQ.0)GOTO2250
            J=J+1
            IJ=MAXN*(ICOLR-1)+I
            IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')THEN
              WRITE(ICOUT,2251)I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX
 2251         FORMAT('I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX = ',8I8)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            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)
 2250     CONTINUE
        ELSEIF(K.EQ.NHIST)THEN
          DO2260I=1,IMAX
            IF(ISUB(I).EQ.0)GOTO2260
            J=J+1
            IJ=MAXN*(ICOLR-1)+I
            IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')THEN
              WRITE(ICOUT,2261)I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX
 2261         FORMAT('I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX = ',8I8)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            IF(ICOLR.LE.MAXCOL)XHIST(J)=V(IJ)
            IF(ICOLR.EQ.MAXCP1)XHIST(J)=PRED(I)
            IF(ICOLR.EQ.MAXCP2)XHIST(J)=RES(I)
            IF(ICOLR.EQ.MAXCP3)XHIST(J)=YPLOT(I)
            IF(ICOLR.EQ.MAXCP4)XHIST(J)=XPLOT(I)
            IF(ICOLR.EQ.MAXCP5)XHIST(J)=X2PLOT(I)
            IF(ICOLR.EQ.MAXCP6)XHIST(J)=TAGPLO(I)
 2260     CONTINUE
        ENDIF
        NLOCAL=J
        NSUB=NLOCAL
C
 2200 CONTINUE
      NZ=NUMVAR
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,IERROR)
      IF(IERROR.EQ.'NO')CCUSL=VALUE(ILOCP)
      IERROR='NO'
C
      CCLSL=CPUMAX
      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,IERROR)
      IF(IERROR.EQ.'NO')CCLSL=VALUE(ILOCP)
      IERROR='NO'
C
      ALPHA=0.05
      IH='ALPH'
      IH2='A   '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'NO')THEN
        IF(VALUE(ILOCP).GT.0.0 .AND. VALUE(ILOCP).LT.0.50)
     1     ALPHA=VALUE(ILOCP)
      ENDIF
      IERROR='NO'
C
C               *******************************************************
C               **  STEP 31--                                        **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS            **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.               **
C               **  DEFINE THE VECTOR D(.) SO THAT EACH ANDREW'S     **
C               **  CURVE HAS ITS OWNS TAG NUMBER.                   **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).    **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).    **
C               *******************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'HTCC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPHTC2(Z,ZHIST,ZMEANS,S,MAXOBV,MAXHOT,NLOCAL,NUMVAR,
     1X1,XHIST,XIDTEM,XIDTE2,TEMP,XMEANS,DMEAN,INDEX,NIJUNK,
     1IGRPST,XGROUP,
     1ICASPL,ICONT,CCUSL,CCLSL,ALPHA,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'HTCC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPHTCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG2,IBUGG3,IBUGQ,ISUBRO
 9012 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NSUB
 9021 FORMAT('NSUB = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NSUB.LE.0)GOTO9024
      DO9022I=1,NSUB
      WRITE(ICOUT,9023)I,(Z(I,K),K=1,NUMVAR)
 9023 FORMAT('I,Z(I,K) = ',I8,20E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9024 CONTINUE
      WRITE(ICOUT,9041)NZ
 9041 FORMAT('NZ = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)NPLOTP
 9051 FORMAT('NPLOTP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9054
      DO9052I=1,NPLOTP
      WRITE(ICOUT,9053)I,Y(I),X(I),D(I)
 9053 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9052 CONTINUE
 9054 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHTC2(Z,ZHIST,ZMEANS,SPOOL,MAXROM,MAXHOT,N,NUMVAR,
     1X,XHIST,XIDTEM,XIDTE2,TEMP,XMEANS,DMEAN,INDEX,NIJUNK,
     1IGRPST,XGROUP,
     1ICASPL,ICONT,CCUSL,CCLSL,ALPHA,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A HOTELLING MULTIVARIATE CONTROL CHART
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
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--RYAN, "STATISTICAL METHODS FOR QUALITY CONTROL"
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/9
C     ORIGINAL VERSION--SEPTEMBER 1998.
C     UPDATED         --MARCH     2003. SUPPORT EXTENDED TO FOUR
C                                       CASES:
C                                       PHASE I GROUP
C                                       PHASE I INDIVIDUAL
C                                       PHASE II GROUP
C                                       PHASE II INDIVIDUAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Z(MAXROM,MAXHOT)
      DIMENSION ZHIST(MAXROM,MAXHOT)
      DIMENSION ZMEANS(MAXROM,MAXHOT)
      DIMENSION SPOOL(MAXHOT,MAXHOT)
      DIMENSION X(*)
      DIMENSION XHIST(*)
      DIMENSION XGROUP(*)
      DIMENSION XIDTEM(*)
      DIMENSION XIDTE2(*)
      DIMENSION XMEANS(*)
      DIMENSION TEMP(*)
      DIMENSION INDEX(*)
      DIMENSION NIJUNK(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
      DIMENSION IGRPST(*)
      DOUBLE PRECISION DMEAN(*)
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='DPHT'
      ISUBN2='C2  '
      IWRITE='OFF '
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.GE.2)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPHTC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST TWO;')
      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(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'HTC2')THEN
        WRITE(ICOUT,70)
   70   FORMAT('AT THE BEGINNING OF DPHTC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)N,NUMVAR,ICASPL,ICONT
   71   FORMAT('N,NUMVAR,ICASPL,ICONT = ',2I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        DO79I=1,N
          WRITE(ICOUT,73)I,X(I),XHIST(I),(Z(I,J),J=1,3)
   73     FORMAT('X(I),XHIST(I),Z(I,J=1,3) = ',I8,5F12.5)
          CALL DPWRST('XXX','BUG ')
   79   CONTINUE
      ENDIF
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
      NC1=NUMVAR
      IF(ICASPL.EQ.'HT1G' .OR. ICASPL.EQ.'HT2G')NC1=NC1-1
      IF(ICASPL.EQ.'HT2G' .OR. ICASPL.EQ.'HT2I')NC1=NC1-1
      NR1=N
      N2=N
C
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'HTC2')THEN
        WRITE(ICOUT,80)
   80   FORMAT('AT THE BEGINNING OF DPHTC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,81)NR1,NC1,N2
   81   FORMAT('NR1,NC1,N2 = ',3I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **********************************************
C               **  STEP 5.1--                              **
C               **  TREAT THE PHASE I (GROUP) HOTELLING     **
C               **  CONTROL CHART CASE                      **
C               **********************************************
C
      IF(ICASPL.EQ.'HT1G')THEN
        ISTEPN='5.1'
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        CALL VARPO2(Z,ZMEANS,SPOOL,MAXROM,MAXHOT,NR1,NC1,MAXHOT,
     1              X,XIDTEM,NIJUNK,NGROUP,DMEAN,IBUGG3,IERROR)
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5161)
 5161     FORMAT('**** HOTELLING PHASE I CONTROL CHART ',
     1           'FOR SUBGROUPS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5164)
 5164     FORMAT('     COVARIANCE MATRIX MAXIMUM OF 5 COLUMNS ',
     1           'PRINTED)')
          CALL DPWRST('XXX','BUG ')
          DO5166J=1,NC1
            WRITE(ICOUT,5168)(SPOOL(J,L),L=1,MIN(NC1,5))
            CALL DPWRST('XXX','BUG ')
 5166     CONTINUE
 5168     FORMAT(6X,5E15.7)
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        CALL SGECO(SPOOL,MAXHOT,NC1,INDEX,RCOND,TEMP)
C
        IF(1.0+RCOND.EQ.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5101)
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5102)
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5103)
          CALL DPWRST('XXX','ERRO ')
          IERROR='YES'
          GOTO9000
        ENDIF
 5101   FORMAT('*** ERROR FROM DPHTC2: UNABLE TO COMPUTE THE INVERSE ',
     1         'OF THE POOLED COVARIANCE MATRIX.')
 5102   FORMAT('    PROBLEM: SOME COLUMNS ARE LINEARLY DEPDENDENT ON ',
     1         ' OTHER COLUMNS.')
 5103   FORMAT('    SUGGESTED SOLUTION: WORK WITH A SUBSET OF THE ',
     1       'ORIGINAL COLUMNS.')
C
        IJOB=1
        CALL SGEDI(SPOOL,MAXHOT,NC1,INDEX,TEMP,XMEANS,IJOB)
C
        CALL GRPMEA(Z,ZMEANS,MAXROM,MAXHOT,NR1,NC1,
     1            X,XIDTEM,NIJUNK,N2,NGROUP,XMEANS,IBUGG3,IERROR)
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          DO5151J=1,NC1
            WRITE(ICOUT,5153)J,XMEANS(J)
 5153       FORMAT('     MEAN FOR VARIABLE ',I8,' = ',E15.7)
          CALL DPWRST('XXX','BUG  ')
 5151     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        ISTEPN='51A'
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        NP=NUMVAR-1
        NK=NGROUP
        J=0
        DO5110ISET=1,NGROUP
c
          DO5120L=1,NC1
            TEMP(L)=ZMEANS(ISET,L) - XMEANS(L)
 5120     CONTINUE
          CALL QUAFRM(SPOOL,MAXHOT,MAXHOT,NC1,NC1,TEMP,IWRITE,
     1                XQUAD,IBUGG3,IERROR)
          NI=NIJUNK(ISET)
          ANI=REAL(NI)
C
          C=REAL(NK*NI*NP - NK*NP - NI*NP + NP)/
     1      REAL(NK*NI - NK - NP + 1)
          ALPHA=2.0*0.00135*REAL(NP)
          IDEG2=NK*NI-NK-NP+1
C
          IF(NI.LE.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5131)
 5131       FORMAT('***** INTERNAL ERROR IN DPHTC2--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5132)
 5132       FORMAT('NI FOR SOME CLASS = 0')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5133)ISET,XIDTEM(ISET),NI
 5133       FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ELSEIF(IDEG2.LE.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5136)
 5136       FORMAT('***** ERROR IN DPHTC2--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5137)ISET
 5137       FORMAT('      ZERO OR NEGATIVE DEGREES OF FREEDOM FOR THE ',
     1             'F-CDF VALUE FOR SET ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5138)NI
 5138       FORMAT('      GROUP SIZE (NI)          = ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5139)NK
 5139       FORMAT('      NUMBER OF SETS (NK)      = ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5141)NP
 5141       FORMAT('      NUMBER OF VARIABLES (NP) = ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5143)IDEG2
 5143       FORMAT('      DEGREES OF FREEDOM = NK*NI-NK-NP+1 = ',I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
C
          ALPHA2=1.0-ALPHA
          CALL FPPF(ALPHA2,NP,IDEG2,PPF)
C
          YTEMP=ANI*XQUAD
          YUPPER=C*PPF
C
          J=J+1
          Y2(J)=YTEMP
          X2(J)=XIDTEM(ISET)
          D2(J)=1.0
C
CCCCC     J=J+1
CCCCC     Y2(J)=0.0
CCCCC     X2(J)=XIDTEM(ISET)
CCCCC     D2(J)=2.0
C
          J=J+1
          Y2(J)=YUPPER
          X2(J)=XIDTEM(ISET)
          D2(J)=2.0
C
          IF(CCUSL.EQ.CPUMIN)GOTO5172
          J=J+1
          Y2(J)=CCUSL
          X2(J)=XIDTEM(ISET)
          D2(J)=3.0
 5172     CONTINUE
C
 5110   CONTINUE
        N2=J
        NPLOTV=3
C
C               **********************************************
C               **  STEP 5.2--                              **
C               **  TREAT THE PHASE II (GROUP) HOTELLING    **
C               **  CONTROL CHART CASE                      **
C               **********************************************
C
      ELSEIF(ICASPL.EQ.'HT2G')THEN
        ISTEPN='5.2'
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC FIRST STEP: DETERMINE WHICH VALUES REPRESENT "HISTORICAL"
CCCCC AND WHICH REPRESENT "FUTURE".  THE ZHIST MATRIX WILL CONSIST
CCCCC OF THOSE GROUPS THAT ARE "HISTORICAL" AND ALSO THAT WERE NOT
CCCCC DISCARDED.  NOTE THAT IF EVEN ONE VALUE IN A GROUP IS DISCARDED,
CCCCC THEN ENTIRE GROUP IS DISCARDED.
C
        CALL DISTIN(X,NR1,IWRITE,TEMP,NGRP,IBUGG3,IERROR)
C
        IROW=0
        NA=0
        DO5209I=1,NGRP
          ISTAT=0
          AGROUP=TEMP(I)
          DO5201J=1,NR1
            IF(X(J).EQ.AGROUP)THEN
              ATEMP=XHIST(J)
              IF(ABS(ATEMP).LE.0.5)THEN
                CONTINUE
              ELSEIF(ATEMP.GT.0.5)THEN
                IF(ISTAT.EQ.0)ISTAT=1
              ELSEIF(ATEMP.LT.-0.5)THEN
                ISTAT=-1
              ENDIF
            ENDIF
 5201     CONTINUE
          IGRPST(I)=ISTAT
          IF(ISTAT.LT.0)NA=NA+1
          IF(ISTAT.EQ.0)THEN
            DO5203J=1,NR1
              IF(X(J).EQ.AGROUP)THEN
                IROW=IROW+1
                DO5205L=1,NC1
                  ZHIST(IROW,L)=Z(J,L)
                  XGROUP(IROW)=AGROUP
 5205           CONTINUE
              ENDIF
 5203       CONTINUE
          ENDIF
 5209   CONTINUE
        NHIST=IROW
C
        CALL VARPO2(ZHIST,ZMEANS,SPOOL,MAXROM,MAXHOT,NHIST,NC1,MAXHOT,
     1              XGROUP,XIDTEM,NIJUNK,NGROUP,DMEAN,IBUGG3,IERROR)
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5261)
 5261     FORMAT('**** HOTELLING PHASE II CONTROL CHART ',
     1           'FOR SUBGROUPS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5263)NHIST
 5263     FORMAT('     NUMBER OF HISTORICAL OBSERVATIONS   = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5264)
 5264     FORMAT('     COVARIANCE MATRIX (USING HISTORICAL ',
     1           'OBSERVATIONS, MAXIMUM OF 5 COLUMNS PRINTED)')
          CALL DPWRST('XXX','BUG ')
          DO5266J=1,NC1
            WRITE(ICOUT,5268)(SPOOL(J,L),L=1,MIN(NC1,5))
            CALL DPWRST('XXX','BUG ')
 5266     CONTINUE
 5268     FORMAT(6X,5E15.7)
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        CALL SGECO(SPOOL,MAXHOT,NC1,INDEX,RCOND,TEMP)
C
        IF(1.0+RCOND.EQ.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5211)
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5212)
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5213)
          CALL DPWRST('XXX','ERRO ')
          IERROR='YES'
          GOTO9000
        ENDIF
 5211   FORMAT('*** ERROR FROM DPHTC2: UNABLE TO COMPUTE THE INVERSE ',
     1         'OF THE POOLED COVARIANCE MATRIX.')
 5212   FORMAT('    PROBLEM: SOME COLUMNS ARE LINEARLY DEPDENDENT ON ',
     1         ' OTHER COLUMNS.')
 5213   FORMAT('    SUGGESTED SOLUTION: WORK WITH A SUBSET OF THE ',
     1       'ORIGINAL COLUMNS.')
C
        IJOB=1
        CALL SGEDI(SPOOL,MAXHOT,NC1,INDEX,TEMP,XMEANS,IJOB)
C
C  CALL GRPMEA TWICE.  FIRST TIME TO GET MEAN OF MEANS
C  (XMEANS) BASED ON HISTORICAL DATA ONLY.  SECOND TIME TO GET GROUP
C  MEANS (ZMEANS) FOR ALL SUBGROUPS (HISTORICAL AND FUTURE).
C
        CALL GRPMEA(ZHIST,ZMEANS,MAXROM,MAXHOT,NHIST,NC1,
     1            XGROUP,XIDTEM,NIJUNK,N2,NGROUP,TEMP,IBUGG3,IERROR)
C
        CALL GRPMEA(Z,ZMEANS,MAXROM,MAXHOT,NR1,NC1,
     1            X,XIDTEM,NIJUNK,N2,NGROUP,XMEANS,IBUGG3,IERROR)
        DO5218J=1,NGROUP
          XMEANS(J)=TEMP(J)
 5218   CONTINUE
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          DO5251J=1,NC1
            WRITE(ICOUT,5253)J,XMEANS(J)
 5253       FORMAT('     MEAN FOR VARIABLE ',I8,' (USING HISTORICAL ',
     1             'OBSERVATIONS) = ',E15.7)
          CALL DPWRST('XXX','BUG ')
 5251     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        ISTEPN='52A'
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        NP=NUMVAR-2
        NK=NGROUP
        ALPHA=2.0*0.00135*REAL(NP)
        ALPHA2=1.0-ALPHA
        J=0
        DO5290ISET=1,NGROUP
C
CCCCCC    DON'T PLOT HISTORICAL DATA
C
          DTAG=1.0
          IF(IGRPST(ISET).GT.0)DTAG=2.0
          IF(IGRPST(ISET).LT.0)GOTO5290
C
          DO5220L=1,NC1
            TEMP(L)=ZMEANS(ISET,L) - XMEANS(L)
 5220     CONTINUE
          CALL QUAFRM(SPOOL,MAXHOT,MAXHOT,NC1,NC1,TEMP,IWRITE,
     1                XQUAD,IBUGG3,IERROR)
          NI=NIJUNK(ISET)
          ANI=REAL(NI)
C
          C=REAL(NP*(NK-NA+1)*(NI-1))/REAL((NK-NA)*NI-NK+NA-NP+1)
          IDEG2=(NK-NA)*NI - NK + NA - NP + 1
C
          IF(NI.LE.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5231)
 5231       FORMAT('***** INTERNAL ERROR IN DPHTC2--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5232)
 5232       FORMAT('NI FOR SOME CLASS = 0')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5233)ISET,XIDTEM(ISET),NI
 5233       FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ELSEIF(IDEG2.LE.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5236)
 5236       FORMAT('***** ERROR IN DPHTC2--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5237)ISET
 5237       FORMAT('      ZERO OR NEGATIVE DEGREES OF FREEDOM FOR THE ',
     1             'F-CDF VALUE FOR SET ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5238)NI
 5238       FORMAT('      GROUP SIZE (NI)          = ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5239)NK
 5239       FORMAT('      NUMBER OF SETS (NK)      = ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5241)NP
 5241       FORMAT('      NUMBER OF VARIABLES (NP) = ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5243)IDEG2
 5243       FORMAT('      DEGREES OF FREEDOM = NK*NI-NK-NP+1 = ',I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
C
          CALL FPPF(ALPHA2,NP,IDEG2,PPF)
C
          YTEMP=ANI*XQUAD
          YUPPER=C*PPF
C
          J=J+1
          Y2(J)=YTEMP
          X2(J)=XIDTEM(ISET)
          D2(J)=DTAG
C
CCCCC     J=J+1
CCCCC     Y2(J)=0.0
CCCCC     X2(J)=XIDTEM(ISET)
CCCCC     D2(J)=3.0
C
          J=J+1
          Y2(J)=YUPPER
          X2(J)=XIDTEM(ISET)
          D2(J)=3.0
C
          IF(CCUSL.EQ.CPUMIN)GOTO5272
          J=J+1
          Y2(J)=CCUSL
          X2(J)=XIDTEM(ISET)
          D2(J)=4.0
 5272     CONTINUE
C
 5290   CONTINUE
        N2=J
        NPLOTV=3
C
C               **********************************************
C               **  STEP 5.3--                              **
C               **  TREAT THE PHASE I (INDIVIDUAL) HOTELLING**
C               **  CONTROL CHART CASE                      **
C               **********************************************
C
      ELSEIF(ICASPL.EQ.'HT1I')THEN
        ISTEPN='5.3'
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IWRITE='OFF'
C
        CALL COVMAT(Z,SPOOL,DMEAN,MAXROM,NR1,NUMVAR,MAXHOT)
        DO5303L=1,NUMVAR
          DO5305J=1,NR1
            TEMP(J)=Z(J,L)
 5305     CONTINUE
          CALL MEAN(TEMP,NR1,IWRITE,RIGHT,IBUGG3,IERROR)
          XMEANS(L)=RIGHT
 5303   CONTINUE
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5361)
 5361     FORMAT('**** HOTELLING PHASE I CONTROL CHART ',
     1           'FOR INDIVIDUAL OBSERVATIONS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5364)
 5364     FORMAT('     COVARIANCE MATRIX (MAXIMUM OF 5 COLUMNS ',
     1           'PRINTED)')
          CALL DPWRST('XXX','BUG ')
          DO5366J=1,NC1
            WRITE(ICOUT,5368)(SPOOL(J,L),L=1,MIN(NC1,5))
            CALL DPWRST('XXX','BUG ')
 5366     CONTINUE
 5368     FORMAT(6X,5E15.7)
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          DO5351J=1,NC1
            WRITE(ICOUT,5353)J,XMEANS(J)
 5353       FORMAT('     MEAN FOR VARIABLE ',I8,' = ',E15.7)
            CALL DPWRST('XXX','BUG ')
 5351     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        CALL SGECO(SPOOL,MAXHOT,NC1,INDEX,RCOND,TEMP)
C
        IF(1.0+RCOND.EQ.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5371)
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5372)
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5373)
          CALL DPWRST('XXX','ERRO ')
          IERROR='YES'
          GOTO9000
        ENDIF
 5371   FORMAT('*** ERROR FROM DPHTC2: UNABLE TO COMPUTE THE INVERSE ',
     1         'OF THE COVARIANCE MATRIX.')
 5372   FORMAT('    PROBLEM: SOME COLUMNS ARE LINEARLY DEPDENDENT ON ',
     1         ' OTHER COLUMNS.')
 5373   FORMAT('    SUGGESTED SOLUTION: WORK WITH A SUBSET OF THE ',
     1       'ORIGINAL COLUMNS.')
C
        IJOB=1
        CALL SGEDI(SPOOL,MAXHOT,NC1,INDEX,TEMP,ZMEANS,IJOB)
C
        ISTEPN='53A'
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')THEN
          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
          DO5381J=1,NC1
            WRITE(ICOUT,5383)J,(SPOOL(J,L),L=1,NC1)
            CALL DPWRST('XXX','ERRO ')
 5381     CONTINUE
 5383     FORMAT('SPOOL: ROW ',I8,' = ',15F15.7)
        ENDIF
C
        NP=NC1
        AM=REAL(NR1)
        AFACT=(AM-1.0)**2/AM
        A=REAL(NP)/2.0
        B=(AM-REAL(NP)-1.0)/2.0
        ALPHA2=ALPHA/2.0
        CALL BETPPF(ALPHA2,A,B,YLOWER)
        YLOWER=AFACT*YLOWER
        ALPHA2=1.0 - ALPHA/2.0
        CALL BETPPF(ALPHA2,A,B,YUPPER)
        YUPPER=AFACT*YUPPER
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')THEN
          WRITE(ICOUT,5391)ISET,XQUAD,AM,AFACT,ALPHA
 5391     FORMAT('ISET,XQUAD,AM,AFACT = ',I8,4F15.7)
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5393)A,B,YLOWER,YUPPER
 5393     FORMAT('A,B,YLOWER,YUPPER = ',4F15.7)
          CALL DPWRST('XXX','ERRO ')
        ENDIF
C
        J=0
        DO5310ISET=1,NR1
C
          DO5320L=1,NC1
            TEMP(L)=Z(ISET,L) - XMEANS(L)
 5320     CONTINUE
          CALL QUAFRM(SPOOL,MAXHOT,MAXHOT,NC1,NC1,TEMP,IWRITE,
     1                XQUAD,IBUGG3,IERROR)
C
          YTEMP=XQUAD
C
          J=J+1
          Y2(J)=YTEMP
          X2(J)=REAL(ISET)
          D2(J)=1.0
C
CCCCC     J=J+1
CCCCC     Y2(J)=0.0
CCCCC     X2(J)=REAL(ISET)
CCCCC     D2(J)=2.0
C
          J=J+1
          Y2(J)=YUPPER
          X2(J)=REAL(ISET)
          D2(J)=2.0
C
          J=J+1
          Y2(J)=YLOWER
          X2(J)=REAL(ISET)
          D2(J)=3.0
C
          IF(CCUSL.EQ.CPUMIN)GOTO5352
          J=J+1
          Y2(J)=CCUSL
          X2(J)=REAL(ISET)
          D2(J)=4.0
 5352     CONTINUE
C
          IF(CCLSL.EQ.CPUMAX)GOTO5354
          J=J+1
          Y2(J)=CCLSL
          X2(J)=REAL(ISET)
          D2(J)=5.0
 5354     CONTINUE
C
 5310   CONTINUE
        N2=J
        NPLOTV=3
C
C               **********************************************
C               **  STEP 5.4--                              **
C               **  TREAT THE PHASE II (INDIVIDUAL) HOTELLING*
C               **  CONTROL CHART CASE                      **
C               **********************************************
C
      ELSEIF(ICASPL.EQ.'HT2I')THEN
        ISTEPN='5.4'
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IWRITE='OFF'
C
C  USE X2 TO DETERMINE WHICH DATA POINTS ARE HISTORICAL AND
C  WHICH ARE FUTURE
C
        IROW=0
        DO5401I=1,NR1
          IF(ABS(XHIST(I)).LE.0.5)THEN
            IROW=IROW+1
            DO5402J=1,NC1
              ZHIST(IROW,J)=Z(I,J)
 5402       CONTINUE
          ENDIF
 5401   CONTINUE
        NHIST=IROW
C
        IF(NHIST.LE.2)THEN
          WRITE(ICOUT,5421)
 5421     FORMAT('**** ERROR FROM PHASE II HOTELLING INDIVIDUAL ',
     1           'CONTROL CHART')
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5423)NHIST
 5423     FORMAT('     INSUFFICIENT NUMBER OF HISTORICAL VALUES FOUND ',
     1           '(',I8,' FOUND)')
          CALL DPWRST('XXX','ERRO ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        CALL COVMAT(ZHIST,SPOOL,DMEAN,MAXROM,NHIST,NC1,MAXHOT)
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')THEN
          ISTEPN='54A'
          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
          WRITE(ICOUT,5487)NHIST
 5487     FORMAT('NHIST = ',I8)
          CALL DPWRST('XXX','ERRO ')
          DO5486J=1,NC1
            WRITE(ICOUT,5488)J,(SPOOL(J,L),L=1,MIN(NC1,15))
            CALL DPWRST('XXX','ERRO ')
 5486     CONTINUE
 5488     FORMAT('COV: ROW ',I8,' = ',15F15.7)
        ENDIF
C
        DO5403L=1,NC1
          DO5405J=1,NHIST
            TEMP(J)=ZHIST(J,L)
 5405     CONTINUE
          CALL MEAN(TEMP,NHIST,IWRITE,RIGHT,IBUGG3,IERROR)
          XMEANS(L)=RIGHT
 5403   CONTINUE
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5461)
 5461     FORMAT('**** HOTELLING PHASE II CONTROL CHART ',
     1           'FOR INDIVIDUAL OBSERVATIONS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5463)NHIST
 5463     FORMAT('     NUMBER OF HISTORICAL OBSERVATIONS   = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5464)
 5464     FORMAT('     COVARIANCE MATRIX (USING HISTORICAL ',
     1           'OBSERVATIONS, MAXIMUM OF 5 COLUMNS PRINTED)')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          DO5466J=1,NC1
            WRITE(ICOUT,5468)(SPOOL(J,L),L=1,MIN(NC1,5))
            CALL DPWRST('XXX','BUG ')
 5466     CONTINUE
 5468     FORMAT(6X,5E15.7)
          DO5451J=1,NC1
            WRITE(ICOUT,5453)J,XMEANS(J)
 5453       FORMAT('     MEAN FOR VARIABLE ',I8,' (USING HISTORICAL ',
     1             'OBSERVATIONS) = ',E15.7)
          CALL DPWRST('XXX','BUG ')
 5451     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        CALL SGECO(SPOOL,MAXHOT,NC1,INDEX,RCOND,TEMP)
C
        IF(1.0+RCOND.EQ.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5471)
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5472)
          CALL DPWRST('XXX','ERRO ')
          WRITE(ICOUT,5473)
          CALL DPWRST('XXX','ERRO ')
          IERROR='YES'
          GOTO9000
        ENDIF
 5471   FORMAT('*** ERROR FROM DPHTC2: UNABLE TO COMPUTE THE INVERSE ',
     1         'OF THE COVARIANCE MATRIX.')
 5472   FORMAT('    PROBLEM: SOME COLUMNS ARE LINEARLY DEPDENDENT ON ',
     1         ' OTHER COLUMNS.')
 5473   FORMAT('    SUGGESTED SOLUTION: WORK WITH A SUBSET OF THE ',
     1       'ORIGINAL COLUMNS.')
C
        IJOB=1
        CALL SGEDI(SPOOL,MAXHOT,NC1,INDEX,TEMP,ZMEANS,IJOB)
C
        ISTEPN='54B'
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')THEN
          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
          DO5481J=1,NC1
            WRITE(ICOUT,5483)J,(SPOOL(J,L),L=1,MIN(15,NC1))
            CALL DPWRST('XXX','ERRO ')
 5481     CONTINUE
 5483     FORMAT('SPOOL: ROW ',I8,' = ',15F15.7)
        ENDIF
C
C
        NP=NC1
        AM=REAL(NHIST)
        AFACT=REAL(NP)*(AM+1.0)*(AM-1.0)/(AM*AM - AM*REAL(NP))
        IDF1=NP
        IDF2=NHIST-NP
        ALPHA2=ALPHA/2.0
        CALL FPPF(ALPHA2,IDF1,IDF2,YLOWER)
        YLOWER=AFACT*YLOWER
        ALPHA2=1.0-ALPHA/2.0
        CALL FPPF(ALPHA2,IDF1,IDF2,YUPPER)
        YUPPER=AFACT*YUPPER
C
        J=0
        DO5410ISET=1,NR1
C
          DTAG=2.0
          IF(XHIST(ISET).LE.0.5)DTAG=1.0
          IF(XHIST(ISET).LT.-0.5)GOTO5410
C
          DO5420L=1,NC1
            TEMP(L)=Z(ISET,L) - XMEANS(L)
 5420     CONTINUE
          CALL QUAFRM(SPOOL,MAXHOT,MAXHOT,NC1,NC1,TEMP,IWRITE,
     1                XQUAD,IBUGG3,IERROR)
C
          YTEMP=XQUAD
C
          J=J+1
          Y2(J)=YTEMP
          X2(J)=REAL(ISET)
          D2(J)=DTAG
C
CCCCC     J=J+1
CCCCC     Y2(J)=0.0
CCCCC     X2(J)=REAL(ISET)
CCCCC     D2(J)=2.0
C
          J=J+1
          Y2(J)=YUPPER
          X2(J)=REAL(ISET)
          D2(J)=3.0
C
          J=J+1
          Y2(J)=YLOWER
          X2(J)=REAL(ISET)
          D2(J)=4.0
C
          IF(CCUSL.EQ.CPUMIN)GOTO5452
          J=J+1
          Y2(J)=CCUSL
          X2(J)=REAL(ISET)
          D2(J)=5.0
 5452     CONTINUE
C
          IF(CCLSL.EQ.CPUMAX)GOTO5454
          J=J+1
          Y2(J)=CCLSL
          X2(J)=REAL(ISET)
          D2(J)=6.0
 5454     CONTINUE
C
 5410   CONTINUE
        N2=J
        NPLOTV=3
C
      ENDIF
C
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'HTC2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPHTC2--')
        CALL DPWRST('XXX','BUG ')
      ENDIF
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPHTM1(CAPTN,NCAP,IFLAG1,IFLAG2)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              HTML OUTPUT.  THIS ROUTINE IS USED TO INITIATE
C              THE HTML OUTPUT AND STARTS THE FIRST TABLE.
C              THE ONLY OPTIONAL ELEMENT IS THE CAPTION.
C     INPUT  ARGUMENTS--CAPTN  = THE CHARACTER STRING CONTAINING
C                                THE CAPTION.
C                     --NCAP   = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                CAPTION.
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--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
C
      CHARACTER*(*) CAPTN
C
      CHARACTER*10 IFORMT
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  STEP 1: END ASIS MODE AND WRITE A HEADER
C
  999 FORMAT(1X)
 5001 FORMAT('</PRE>')
      IF(IFLAG1)THEN
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011 FORMAT('<UL>')
 5013 FORMAT('<TABLE NOBORDER>')
 5015 FORMAT('   <CAPTION ALIGN=CENTER> <B>')
 5019 FORMAT('   </B> </CAPTION>')
      IF(IFLAG2)THEN
        IFORMT=' '
        IFORMT(1:8)='(6X,A  )'
        WRITE(IFORMT(6:7),'(I2)')NCAP
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        IF(NCAP.GT.0)THEN
          WRITE(ICOUT,5015)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)CAPTN(1:NCAP)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5019)
          CALL DPWRST('XXX','WRIT')
        ENDIF
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              HTML OUTPUT.  THIS ROUTINE IS USED TO CLOSE THE
C              CURRENT TABLE AND TERMINATE THE HTML OUTPUT.
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--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
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  STEP 1: END THE CURRENT TABLE
C
  999 FORMAT(1X)
 5191 FORMAT('</TABLE>')
 5193 FORMAT('</UL>')
      IF(IFLAG1)THEN
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C  STEP 2: RESET "ASIS" MODE
C
 5199 FORMAT('<PRE>')
      IF(IFLAG2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5199)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPHTM3(IVALUE,NCHAR,AVALUE,NUMDIG,IWIDT1,IWIDT2)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              HTML OUTPUT.  THIS ROUTINE IS USED TO GENERATE
C              ONE ROW OF A TABLE WHERE:
C
C                 COLUMN 1: A TEXT STRING
C                 COLUMN 2: A NUMERIC VALUE
C
C              IF NCHAR = 0, A SINGLE SPACE WILL BE INSERTED,
C              IF NUMDIG = 0, AN INTEGER FORMAT WILL BE USED,
C              IF NUMDIG = -1, A SINGLE SPACE WILL BE INSERTED,
C              IF NUMDIG = -2, A DEFAULT FORMAT WILL BE USED.
C               
C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING CONTAINING
C                                 THE CHARACTER VALUE.
C                     --NCHAR   = THE INTEGER NUMBER THAT SPECIFIES
C                                 THE NUMBER OF CHARACTERS IN THE
C                                 CHARACTER STRING.
C                     --AVALUE  = THE NUMERIC VALUE TO BE PRINTED.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) IVALUE
C
      CHARACTER*10 IFORMT
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  STEP 3: DEFINE A DATA ROW
C
  999 FORMAT(1X)
 5041 FORMAT('   <TR>')
 5043 FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=',I5,'>')
 5047 FORMAT('      </TD>')
 5049 FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=',I5,'>')
 5031 FORMAT('         ',G15.7)
 5033 FORMAT('         ',I8)
 5035 FORMAT('         &nbsp;')
 5039 FORMAT('   </TR>')
C
      WRITE(ICOUT,5041)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5043)IWIDT1
      CALL DPWRST('XXX','WRIT')
      IF(NCHAR.GT.0)THEN
        IFORMT=' '
        IFORMT(1:8)='(9X,A  )'
        WRITE(IFORMT(6:7),'(I2)')NCHAR
        WRITE(ICOUT,IFORMT)IVALUE(1:NCHAR)
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,5035)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,5047)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5049)IWIDT2
      CALL DPWRST('XXX','WRIT')
      IF(NUMDIG.GT.0)THEN
        IFORMT=' '
        IFORMT(1:10)='(9X,F15. )'
        WRITE(IFORMT(9:9),'(I1)')MIN(NUMDIG,9)
        WRITE(ICOUT,IFORMT)AVALUE
        CALL DPWRST('XXX','WRIT')
      ELSEIF(NUMDIG.EQ.0)THEN
        WRITE(ICOUT,5033)INT(AVALUE+0.5)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(NUMDIG.EQ.-1)THEN
        WRITE(ICOUT,5035)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(NUMDIG.EQ.-2)THEN
        WRITE(ICOUT,5031)AVALUE
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,5047)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5039)
      CALL DPWRST('XXX','WRIT')
C
      RETURN
      END
      SUBROUTINE DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              HTML OUTPUT.  THIS ROUTINE IS USED TO GENERATE
C              A HEADER ROW FOR A TABLE.  YOU CAN ALSO OPTIONALLY
C              ADD A RULE LINE BEFORE OR AFTER THE HEADER.
C
C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING ARRAY
C                                 CONTAINING THE TEXT FOR THE
C                                 HEADER VALUES.
C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
C                                 THE NUMBER OF CHARACTERS IN THE
C                                 HEADER VALUES.
C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
C                                 THE NUMBER OF HEADER VALUES.
C                     --IFLAG1  = A LOGICAL VALUE THAT SPECIFIES
C                                 WHETHER A RULE LINE IS DRAWN BEFORE
C                                 THE HHEADER.
C                     --IFLAG2  = A LOGICAL VALUE THAT SPECIFIES
C                                 WHETHER A RULE LINE IS DRAWN AFTER
C                                 THE HHEADER.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) IVALUE(NHEAD)
      INTEGER NCHAR(NHEAD)
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDIG(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
C
      CHARACTER*10 IFORMT
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  STEP 3: DEFINE A DATA ROW
C
  999 FORMAT(1X)
C
C  FOLLOWING ADDS A RULE LINE BEFORE THE HEADER LINE
C
 5021 FORMAT('   <TR>')
 5061 FORMAT('      <TD COLSPAN=',I5,'>')
 5062 FORMAT('          <HR>')
 5047 FORMAT('      </TD>')
 5039 FORMAT('   </TR>')
      IF(IFLAG1)THEN
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)NHEAD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C  GENERATE A HEADER LINE
C
 5023 FORMAT('      <TH ALIGN=',A8,' VALIGN=',A8,' WIDTH=',I8,'>')
 5027 FORMAT('      </TH>')
 5029 FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM>')
      IF(NHEAD.GE.1)THEN
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        DO100I=1,NHEAD
          WRITE(ICOUT,5023)ALIGN(I),VALIGN(I),IWIDTH(I)
          CALL DPWRST('XXX','WRIT')
          IFORMT=' '
          IFORMT(1:8)='(9X,A  )'
          WRITE(IFORMT(6:7),'(I2)')NCHAR(I)
          WRITE(ICOUT,IFORMT)IVALUE(I)(1:NCHAR(I))
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5027)
          CALL DPWRST('XXX','WRIT')
  100   CONTINUE
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C  FOLLOWING ADDS A RULE LINE AFTER THE HEADER LINE
C
      IF(IFLAG2)THEN
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)NHEAD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPHTM5(IVALUE,NCHAR,AVALUE,NHEAD)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              HTML OUTPUT.  THIS ROUTINE IS USED TO GENERATE
C              A DATA ROW FOR A TABLE.  THE FIRST FIELD CAN
C              BE A TEXT VALUE (FOR A ROW LABEL).
C
C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING CONTAINING
C                                 THE TEXT FOR THE FIRST COLUMN.
C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
C                                 THE NUMBER OF CHARACTERS IN THE
C                                 FIRST TEXT FIELD.
C                     --AVALUE  = A REAL ARRAY CONTAINING THE DATA
C                                 TO BE GENERATED.
C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
C                                 THE NUMBER OF NUMERIC VALUES.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) IVALUE
      REAL AVALUE(NHEAD)
      INTEGER NCHAR
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDIG(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
C
      CHARACTER*10 IFORMT
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  STEP 3: DEFINE A DATA ROW
C
  999 FORMAT(1X)
C
C  GENERATE A DATA LINE
C
 5021 FORMAT('   <TR>')
 5039 FORMAT('   </TR>')
 5023 FORMAT('      <TD ALIGN=',A8,' VALIGN=',A8,' WIDTH=',I5,'>')
 5024 FORMAT('         <B>')
 5025 FORMAT('         </B>')
 5027 FORMAT('      </TD>')
 5029 FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM>')
C
      IF(NCHAR.GT.0)THEN
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)ALIGN(I),VALIGN(I),IWIDTH(I)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5024)
        CALL DPWRST('XXX','WRIT')
        IFORMT=' '
        IFORMT(1:8)='(9X,A  )'
        WRITE(IFORMT(6:7),'(I2)')NCHAR
        WRITE(ICOUT,IFORMT)IVALUE(1:NCHAR)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5025)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
 5031 FORMAT('         ',G15.7)
 5033 FORMAT('         ',I8)
 5035 FORMAT('         &nbsp;')
      IF(NHEAD.GE.1)THEN
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        DO100I=1,NHEAD
          WRITE(ICOUT,5023)ALIGN(I+1),VALIGN(I+1),IWIDTH(I+1)
          CALL DPWRST('XXX','WRIT')
          IF(NUMDIG(I).GT.0)THEN
            IFORMT=' '
            IFORMT(1:10)='(9X,F15. )'
            WRITE(IFORMT(9:9),'(I1)')MIN(NUMDIG(I),9)
            WRITE(ICOUT,IFORMT)AVALUE(I)
            CALL DPWRST('XXX','WRIT')
          ELSEIF(NUMDIG(I).EQ.0)THEN
            WRITE(ICOUT,5033)INT(AVALUE(I)+0.5)
            CALL DPWRST('XXX','WRIT')
          ELSEIF(NUMDIG(I).EQ.-1)THEN
            WRITE(ICOUT,5035)
            CALL DPWRST('XXX','WRIT')
          ELSEIF(NUMDIG(I).EQ.-2)THEN
            WRITE(ICOUT,5031)AVALUE(I)
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,5027)
          CALL DPWRST('XXX','WRIT')
  100   CONTINUE
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPHTM6(NHEAD)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              HTML OUTPUT.  THIS ROUTINE IS USED TO DRAW A RULE
C              LINE SPANNING NHEAD COLUMNS.
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--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
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  FOLLOWING ADDS A RULE LINE
C
 5021 FORMAT('   <TR>')
 5061 FORMAT('      <TD COLSPAN=',I5,'>')
 5062 FORMAT('          <HR>')
 5047 FORMAT('      </TD>')
 5039 FORMAT('   </TR>')
      WRITE(ICOUT,5021)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5061)NHEAD
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5062)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5047)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5039)
      CALL DPWRST('XXX','WRIT')
      RETURN
      END
      SUBROUTINE DPHW(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1PTEXHE,PTEXWI,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE HEIGHT AND WIDTH FOR TEXT CHARACTERS.
C              THE HEIGHT FOR TEXT CHARACTERS WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE HEIGHT.
C              THE WIDTH FOR TEXT CHARACTERS WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE WIDTH.
C     INPUT  ARGUMENTS--ICOM (A CHARACTER VARIABLE).
C                     --IHARG  (A  CHARACTER VECTOR)
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PDEFHE
C                     --PDEFWI
C                     --IBUGD2
C     OUTPUT ARGUMENTS--PTEXHE
C                     --PTEXWI
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPHW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICOM
   52 FORMAT('ICOM = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG,PDEFHE,PDEFWI
   53 FORMAT('NUMARG,PDEFHE,PDEFWI = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)PTEXHE,PTEXWI
   54 FORMAT('PTEXHE,PTEXWI = ',2E15.7)
      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
   90 CONTINUE
C
C               ***************************************
C               **  TREAT THE HEIGHT AND WIDTH CASE  **
C               ***************************************
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(1).EQ.'ON')GOTO1150
      IF(IHARG(1).EQ.'OFF')GOTO1150
      IF(IHARG(1).EQ.'AUTO')GOTO1150
      IF(IHARG(1).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1160
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPHW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR HW OR WH ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE IT IS DESIRED THAT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE TEXT CHARACTERS HAVE A HEIGHT OF 5')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AND A WIDTH OF 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      (WHERE THE SCREEN UNITS RANGE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      FROM 0 TO 100, AND WHERE THE HEIGHT AND WIDTH ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      EXCLUDES THE BETWEEN-LINE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('     AND BETWEEN-CHARACTER GAP),')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)
 1133 FORMAT('      HW 5 3 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      WH 3 5 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PTEXHE=PDEFHE
      PTEXWI=PDEFWI
      GOTO1180
C
 1160 CONTINUE
      IF(ICOM.EQ.'HW')PTEXHE=ARG(1)
      IF(ICOM.EQ.'HW')PTEXWI=ARG(2)
      IF(ICOM.EQ.'WH')PTEXWI=ARG(1)
      IF(ICOM.EQ.'WH')PTEXHE=ARG(2)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE HEIGHT (FOR TEXT CHARACTERS)  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PTEXHE
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('THE WIDTH  (FOR TEXT CHARACTERS)  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)PTEXWI
 1184 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      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)PTEXHE
 8111 FORMAT('THE CURRENT (TEXT) HEIGHT IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)PTEXWI
 8112 FORMAT('THE CURRENT (TEXT) WIDTH  IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8121)PDEFHE
 8121 FORMAT('THE DEFAULT (TEXT) HEIGHT IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8122)PDEFWI
 8122 FORMAT('THE DEFAULT (TEXT) WIDTH  IS ',E15.7)
      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 DPHW--')
      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)PTEXHE,PTEXWI
 9013 FORMAT('PTEXHE,PTEXWI = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
