      SUBROUTINE DPFACT(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1CLLIMI,CLWIDT,
     1ICONT,NUMHPP,NUMVPP,IMANUF,
     1XMATN,YMATN,XMITN,YMITN,
     1ISQUAR,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ALOWFR,ALOWDG,
     1IFORSW,
     1ANOPL1,ANOPL2,ISEED,IBOOSS,BARHEF,BARWEF,
     1ICAPSW,
     1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IFOUND,IERROR)
C
C     PURPOSE--GENERATE A FACTOR PLOT
C              THAT IS,
C                 FACTOR PLOT Y X1 X2 X3 X4 X5 X6
C              PLOTS Y VS X1, Y VS X2, ETC. AS A MULTIPLOT ON
C              A SINGLE PAGE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/10
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--OCTOBER   1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES---------------
C
      INCLUDE 'DPCOPA.INC'
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICASEQ
CCCCC CHARACTER*4 ICASAN
      CHARACTER*4 ICONT
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IFORSW
C
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGUG
      CHARACTER*4 IBUGU2
      CHARACTER*4 IBUGU3
      CHARACTER*4 IBUGU4
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IEMPTY
      CHARACTER*4 IERAS2
      CHARACTER*4 IFENC2
      CHARACTER*4 IPPTB2
      CHARACTER*4 ISORS2
      CHARACTER*4 ISQUAR
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
      CHARACTER*4 IREPCH
      CHARACTER*4 IMPSW
      CHARACTER*4 IMPSW3
      CHARACTER*4 IFPLFZ
      CHARACTER*4 IFPLTZ
      CHARACTER*4 IFPLPZ
      CHARACTER*4 IFPLLZ
      CHARACTER*4 IFPLL2
      CHARACTER*4 IFPLXZ
      CHARACTER*4 IFPLYZ
      CHARACTER*4 IFPLDZ
      CHARACTER*4 IFPLZT
      CHARACTER*4 IFPLZ2
      CHARACTER*4 IFPLZ3
      CHARACTER*4 IFPLZ4
C
      CHARACTER*4 IFEED9
C
      CHARACTER*4 IMANUF
C
      CHARACTER*4 ICHAP2(100)
      CHARACTER*4 ILINP2(100)
      CHARACTER*4 ISPIS2(100)
      CHARACTER*4 IBARS2(100)
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
      CHARACTER*4 IX1ZSV
      CHARACTER*4 IX2ZSV
      CHARACTER*4 IY1ZSV
      CHARACTER*4 IY2ZSV
      CHARACTER*4 IY1MNS
      CHARACTER*4 IY1MXS
      CHARACTER*4 IY1LJ2
      CHARACTER*4 IY1LD2
      CHARACTER*4 IY2MNS
      CHARACTER*4 IY2MXS
      CHARACTER*4 IX1MNS
      CHARACTER*4 IX1MXS
      CHARACTER*4 IX2MNS
      CHARACTER*4 IX2MXS
      CHARACTER*4 IX1FSV
      CHARACTER*4 IX2FSV
      CHARACTER*4 IY1FSV
      CHARACTER*4 IY2FSV
      CHARACTER*4 ILFLAX
      CHARACTER*4 ILFLAY
      CHARACTER*4 IFPLLD
      CHARACTER*4 IFPLDI
      CHARACTER*4 IX1LT2(MAXCH)
      CHARACTER*4 IX2LT2(MAXCH)
      CHARACTER*4 IY1LT2(MAXCH)
      CHARACTER*4 IY2LT2(MAXCH)
      CHARACTER*4 ITITSV(MAXCH)
      CHARACTER*4 IPLOTT
      CHARACTER*4 ISUBSZ
C
      CHARACTER*80 IFILE5
      CHARACTER*12 ISTAT5
      CHARACTER*12 IFORM5
      CHARACTER*12 IACCE5
      CHARACTER*12 IPROT5
      CHARACTER*12 ICURS5
      CHARACTER*4 IERRF5
      CHARACTER*4 IENDF5
      CHARACTER*4 IREWI5
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*4 ICT
      CHARACTER*4 IC2T
      CHARACTER*4 IHT(5)
      CHARACTER*4 IH2T(5)
      CHARACTER*4 ISU2SW(MAXSUB)
C
C  MAXY IS THE MAXIMUM NUMBER OF VARIABLES TO USE IN CREATING THE
C  FACTOR PLOT   CURVE
C
      PARAMETER(MAXY=50)
C
      DIMENSION IVARN1(MAXY)
      DIMENSION IVARN2(MAXY)
      DIMENSION ILIS(MAXY)
      DIMENSION ICOLL(MAXY)
C
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
CCCCC CHARACTER*4 IWRITE
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON------------------------------------------------------
C
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)----------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-------------------------------------------------
C
      IFOUND='YES'
      IERROR='NO'
C
      ISUBN1='DPFACT'
      ISUBN2='    '
C
      ICASPL='FACT'
      IFPLLD='ON'
      IFPLDI='LINE'
C
      IFLAGV=5
C
C               *****************************************
C               **  TREAT THE FACTOR PLOT   CASE **
C               *****************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'FACT')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFACT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO69
      DO61I=1,NUMARG
      WRITE(ICOUT,62)I,IHARG(I),IARGT(I)
   62 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   69 CONTINUE
      WRITE(ICOUT,71)IFPLLA
   71 FORMAT('IFPLLA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IFPLTA
   72 FORMAT('IFPLTA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IFPLPT
   73 FORMAT('IFPLPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IFPLFI
   74 FORMAT('IFPLFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)IFPLFR
   75 FORMAT('IFPLFR = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  SHIFT COMMAND LINE ARGMENTS                     **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FACT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')THEN
        ISHIFT=1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
      ICOM='PLOT'
      ICOM2='    '
      IFOUND='YES'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FACT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINN2=2
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 11--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FACT')
     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.'FACT')GOTO1195
      WRITE(ICOUT,1191)NUMARG,ILOCQ,ICASEQ
 1191 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1195 CONTINUE
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **  IF THE   TO   FEATURE IS USED IN THE        **
C               **  ARGUMENT LIST, TRANSLATE THE   TO   TO      **
C               **  EXPLICIT VARIABLE NAMES                     **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FACT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=ILOCQ-1
      CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXY,
     1IHNAME,IHNAM2,IUSE,NUMNAM,
     1IVARN1,IVARN2,NUMVAR,IBUGG2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 13--                        **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               **  ALSO CHECK TO ASSURE THAT EACH   **
C               **  OF THE VARIABLES HAS AT LEAST    **
C               **  2 OBSERVATIONS.                  **
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FACT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFLAG=0
      IFLAG2=0
      DO1300I=1,NUMVAR
C
      IHRIGH=IVARN1(I)
      IHRIG2=IVARN2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      NTEMP=IN(ILOCV)
      IF(I.EQ.1)THEN
        NRIGHT=NTEMP
      ELSE
        NRIGH2=NTEMP
        IF(NRIGH2.NE.NRIGHT)IFLAG=1
      ENDIF
      ILIS(I)=ILOCV
C
      IF(NTEMP.GT.MINN2)GOTO1390
C
 1309 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPFACT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('      FACTOR PLOT   WAS TO HAVE BEEN FORMED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)MINN2
 1326 FORMAT('      MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE CASE',
     1' HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1327)I,NTEMP
 1327 FORMAT('      VARIABLE ',I8,' HAS ',I8,' OBSERVATIONS.')
      WRITE(ICOUT,1328)
 1328 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1329)(IANS(J),J=1,MIN(IWIDTH,100))
 1329 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1390 CONTINUE
C
 1300 CONTINUE
C
C
C               ******************************************************
C               **  STEP 1.4--                                      **
C               **  CHECK THAT VARIABLES HAVE THE SAME NUMBER OF    **
C               **  ELEMENTS.                                       **
C               ******************************************************
C
 1400 CONTINUE
      ISTEPN='1.4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FACT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFLAG.EQ.0)GOTO1490
      IF(IFPLPT.EQ.'HIST')GOTO1490
      IF(IFPLPT.EQ.'PERC')GOTO1490
      IF(IFPLPT.EQ.'RUNS')GOTO1490
      IF(IFPLPT.EQ.'SPEC')GOTO1490
      IF(IFPLPT.EQ.'LAG ')GOTO1490
      IF(IFPLPT.EQ.'AUTO ')GOTO1490
C
 1410 CONTINUE
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPFACT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
      CALL DPWRST('XXX','BUG ')
 1413 FORMAT('      THE NUMBER OF OBSERVATIONS FOR EACH OF THE',
     1'VARIABLES')
 1414 FORMAT('      MUST BE THE SAME; SUCH WAS NOT THE CASE HERE.')
      DO1417I=1,NUMVAR
      I2=ILIS(I)
      WRITE(ICOUT,1416)IVARN1(I2),IVARN2(I2),IN(I2)
 1416 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
 1417 CONTINUE
      WRITE(ICOUT,1420)
 1420 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1421)(IANS(I),I=1,MIN(IWIDTH,100))
 1421 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               **************************************************
C               **   STEP 1--                                   **
C               **   SAVE INITIAL SETTINGS                      **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'FACT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      PXMN2=PXMIN
      PXMX2=PXMAX
      PYMN2=PYMIN
      PYMX2=PYMAX
      PWXMN2=PWXMIN
      PWXMX2=PWXMAX
      PWYMN2=PWYMIN
      PWYMX2=PWYMAX
      IF(IFPLFR.EQ.'DEFA')THEN
        PXMIN=0.0
        PXMAX=100.0
        PYMIN=0.0
        PYMAX=100.0
      ENDIF
C
      IERAS2=IERASW
      IFENC2=IFENSW
      IPPTB2=IPPTBI
      ISORS2=ISORSW
C
      ILFLAX='OFF'
      ILFLAY='OFF'
      IF(IY1MIN.EQ.'FIXE'.AND.IY1MAX.EQ.'FIXE')THEN
        ILFLAY='ON'
      ENDIF
      IF(IX1MIN.EQ.'FIXE'.AND.IX2MAX.EQ.'FIXE')THEN
        ILFLAX='ON'
      ENDIF
C
      IX1TSV=IX1TSW
      IX2TSV=IX2TSW
      IY1TSV=IY1TSW
      IY2TSV=IY2TSW
      IX1ZSV=IX1ZSW
      IX2ZSV=IX2ZSW
      IY1ZSV=IY1ZSW
      IY2ZSV=IY2ZSW
      PX1LD2=PX1LDS
      PX2LD2=PX2LDS
      PY1LD2=PY1LDS
      PY1LA2=PY1LAN
      IY1LJ2=IY1LJU
      IY1LD2=IY1LDI
      GY1MNS=GY1MIN
      GY1MXS=GY1MAX
      GY2MNS=GY2MIN
      GY2MXS=GY2MAX
      GX1MNS=GX1MIN
      GX1MXS=GX1MAX
      GX2MNS=GX2MIN
      GX2MXS=GX2MAX
      IY1MNS=IY1MIN
      IY1MXS=IY1MAX
      IY2MNS=IY2MIN
      IY2MXS=IY2MAX
      IX1MNS=IX1MIN
      IX1MXS=IX1MAX
      IX2MNS=IX2MIN
      IX2MXS=IX2MAX
      IX1FSV=IX1FSW
      IX2FSV=IX2FSW
      IY1FSV=IY1FSW
      IY2FSV=IY2FSW
      PX1ZD2=PX1ZDS
      PX2ZD2=PX2ZDS
      PY1ZD2=PY1ZDS
      PY2ZD2=PY2ZDS
      DO1495I=1,100
        ICHAP2(I)=ICHAPA(I)
        ILINP2(I)=ILINPA(I)
        ISPIS2(I)=ISPISW(I)
        IBARS2(I)=ISPISW(I)
 1495 CONTINUE
C
      DO1500I=1,MAXCH
        IX1LT2(I)=IX1LTE(I)
        IX2LT2(I)=IX2LTE(I)
        IY1LT2(I)=IY1LTE(I)
        IY2LT2(I)=IY2LTE(I)
 1500 CONTINUE
      NCX1L2=NCX1LA
      NCX2L2=NCX2LA
      NCY1L2=NCY1LA
      NCY2L2=NCY2LA
C
      IFPLL2=IFPLLA
      IFPLTZ=IFPLTA
      IFPLFZ=IFPLFR
      IFPLPZ=IFPLPT
      IFPLLZ=IFPLLD
      IFPLZT=IFPLST
      IFPLZ2=IFPLS2
      IFPLZ3=IFPLS3
      IFPLZ4=IFPLS4
      IFPLXZ=IFPLXA
      IFPLYZ=IFPLYA
      IFPLDZ=IFPLDI
      IF(IFPLFR.EQ.'USER'.AND.IFPLLA.EQ.'BOX')IFPLLA='ON'
      IF(IFPLFR.EQ.'CONN')IFPLFR='DEFA'
      IF(IFPLLA.EQ.'BOX ')THEN
        IFPLLD='ON'
CCCCC   IFPLXA='BOTT'
CCCCC   IFPLYA='LEFT'
        IF(IFPLDI.EQ.'BLAN')IFPLDI='LINE'
      ENDIF
C
      IFEED9=IFEEDB
C
      IF(IFPLPT.EQ.'YOUD')THEN
        IFPLTA='ON'
      ENDIF
C
      IFEED9=IFEEDB
C
      DO110I=1,MAXCH
        ITITSV(I)=ITITTE(I)
  110 CONTINUE
      NCTITS=NCTITL
      PTITDZ=PTITDS
C
      IF(IFPLTA.EQ.'ON')THEN
        ISHIFT=ILOCQ-1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ISHIFT=NUMVAR-1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        DO1509I=1,NUMVAR-1
          IHARG(I)=IVARN1(I)
          IHARG2(I)=IVARN2(I)
 1509   CONTINUE
        NUMVAR=NUMVAR-1
        IF(IFPLPT.EQ.'HIST'.OR.IFPLPT.EQ.'RUNS'.OR.IFPLPT.EQ.'PERC'.OR.
     1     IFPLPT.EQ.'AUTO'.OR.IFPLPT.EQ.'SPEC'.OR.IFPLPT.EQ.'LAG ')THEN
          IF(NUMVAR.LT.1)GOTO9000
        ELSE
          IF(NUMVAR.LT.2)GOTO9000
        ENDIF
        ILOCQ=ILOCQ-1
      ENDIF
C
      DO1530I=1,NUMVAR
      IHRIGH=IVARN1(I)
      IHRIG2=IVARN2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      ICOLL(I)=IVALUE(ILOCV)
 1530 CONTINUE
C
      IOUNI5=IST5NU
      IFILE5=IST5NA
      ISTAT5=IST5ST
      IFORM5=IST5FO
      IACCE5=IST5AC
      IPROT5=IST5PR
      ICURS5=IST5CS
      ISUBN0='SPMA'
      IERRF5='NO'
C
      IREWI5='ON'
      CALL DPOPFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IREWI5,ISUBN0,IERRF5,IBUGG3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')IOUNI5=0
C
      IMPSW3=IMPSW
      IMPCO2=IMPCO
      IMPNR2=IMPNR
      IMPNC2=IMPNC
      IMPSW='ON'
      IMPCO=1
C
      IFPLRV=INT(PFPLRV+0.5)
      IF(IFPLRV.LT.1)IFPLRV=1
      NPLOTS=NUMVAR
      IFACTV=NPLOTS-IFPLRV
      IF(IFACTV.LT.1)THEN
        IFACTV=1
        IFPLRV=NPLOTS-1
      ENDIF
C
      NPLOTS=IFPLRV*IFACTV
C
      IF(IFPLRV.GT.1)THEN
        IMPNR=IFPLRV
        IMPNC=IFACTV
      ELSEIF(IMPNR*IMPNC.LT.NPLOTS)THEN
        IMPNC=INT(SQRT(REAL(NPLOTS-1)))+1
        IMPNR=1
        IF(NPLOTS.GE.11)THEN
          IMPNR=INT(NPLOTS/IMPNC)+1
        ELSEIF(NPLOTS.GE.7)THEN
          IMPNR=3
        ELSEIF(NPLOTS.GE.3)THEN
          IMPNR=2
        ENDIF
      ENDIF
C
      IROWT=IFPLRV
      ICOLT=IFACTV
      IF(IFPLLA.EQ.'BOX')THEN
        IMPNR=IMPNR+1
        IMPNC=IMPNC+1
        IROWT=IFPLRV+1
        ICOLT=IFACTV+1
      ENDIF
C
C               *************************************
C               **   STEP 21--                     **
C               **   GENERATE THE SCATTER PLOTS    **
C               *************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'DPFACT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
C  2-VARIABLE PLOTS
C
      IF(IFPLPT.EQ.'PLOT')THEN
        ICT='PLOT'
        IC2T='    '
        NCCOMM=0
        IPLOTT='FPLO'
        GOTO5299
      ENDIF
      IF(IFPLPT.EQ.'STAT')THEN
        ICT=IFPLST
        IC2T=IFPLS2
        NCCOMM=0
        IF(IFPLS3.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=IFPLS3
          IH2T(NCCOMM)=IFPLS4
        ENDIF
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='STAT'
        IH2T(NCCOMM)='ISTI'
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='PLOT'
        IH2T(NCCOMM)='    '
        IPLOTT='STAT'
        GOTO5299
      ENDIF
      IF(IFPLPT.EQ.'BIHI')THEN
        ICT='RELA'
        IC2T='TIVE'
        IHT(1)='BIHI'
        IH2T(1)='STOG'
        NCCOMM=1
        IPLOTT='BIHI'
        GOTO5299
      ENDIF
      IF(IFPLPT.EQ.'QQPL')THEN
        ICT='QUAN'
        IC2T='TILE'
        IHT(1)='QUAN'
        IH2T(1)='TILE'
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        IPLOTT='QQFP'
        GOTO5299
      ENDIF
      IF(IFPLPT.EQ.'BOXC')THEN
        ICT='BOX '
        IC2T='    '
        IHT(1)='COX '
        IH2T(1)='    '
        IHT(2)='LINE'
        IH2T(2)='ARIT'
        IHT(3)='PLOT'
        IH2T(3)='    '
        NCCOMM=3
        IPLOTT='BOXC'
        GOTO5299
      ENDIF
C
C  UNIVARIATE PLOTS
C
      IF(IFPLPT.EQ.'HIST'.OR.IFPLPT.EQ.'PERC'.OR.IFPLPT.EQ.'RUNS'.OR.
     1   IFPLPT.EQ.'SPEC'.OR.IFPLPT.EQ.'LAG '.OR.IFPLPT.EQ.'AUTO'.OR.
     1   IFPLPT.EQ.'PROB'.OR.IFPLPT.EQ.'PPCC')THEN
        IFPLRV=NUMVAR
        NPLOTS=NUMVAR
        IFACTV=0
        IF(IMPNR*IMPNC.LT.NPLOTS)THEN
          IMPNC=INT(SQRT(REAL(NPLOTS-1)))+1
          IMPNR=1
          IF(NPLOTS.GE.11)THEN
            IMPNR=INT(NPLOTS/IMPNC)+1
          ELSEIF(NPLOTS.GE.7)THEN
            IMPNR=3
          ELSEIF(NPLOTS.GE.3)THEN
            IMPNR=2
          ENDIF
        ENDIF
      ENDIF
      IF(IFPLLA.EQ.'BOX')IFPLLA='ON'
C
      IF(IFPLPT.EQ.'HIST')THEN
        ICT='RELA'
        IC2T='TIVE'
        IHT(1)='HIST'
        IH2T(1)='OGRA'
        NCCOMM=1
        IPLOTT='HIST'
        GOTO5999
      ENDIF
      IF(IFPLPT.EQ.'RUNS')THEN
        ICT='RUN '
        IC2T='    '
        IHT(1)='SEQU'
        IH2T(1)='ENCE'
        IHT(1)='PLOT'
        IH2T(1)='    '
        NCCOMM=2
        IPLOTT='RUNS'
        GOTO5999
      ENDIF
      IF(IFPLPT.EQ.'PERC')THEN
        ICT='PERC'
        IC2T='CENT'
        IHT(1)='POIN'
        IH2T(1)='T   '
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        IPPTB2=IPPTBI
        IPPTBI='UNBI'
        IPLOTT='PERC'
        GOTO5999
      ENDIF
      IF(IFPLPT.EQ.'AUTO')THEN
        ICT='AUTO'
        IC2T='CORR'
        IHT(1)='PLOT'
        IH2T(1)='    '
        NCCOMM=1
        IPLOTT='AUTO'
        GOTO5999
      ENDIF
      IF(IFPLPT.EQ.'SPEC')THEN
        ICT='SPEC'
        IC2T='TRAL'
        IHT(1)='PLOT'
        IH2T(1)='    '
        NCCOMM=1
        IPLOTT='SPEC'
        GOTO5999
      ENDIF
      IF(IFPLPT.EQ.'LAG ')THEN
        ICT='LAG '
        IC2T='    '
        IHT(1)='PLOT'
        IH2T(1)='    '
        NCCOMM=1
        IPLOTT='LAG '
        GOTO5999
      ENDIF
      IF(IFPLPT.EQ.'PROB')THEN
        IF(IFPLP1.EQ.'    ')THEN
          ICT='NORM'
          IC2T='AL  '
          IHT(1)='PROB'
          IH2T(1)='ABIL'
          IHT(2)='PLOT'
          IH2T(2)='    '
          NCCOMM=2
        ELSE
          ICT=IFPLP1
          IC2T='    '
          NCCOMM=0
          IF(IFPLP2.NE.'    ')THEN
            NCCOMM=NCCOMM+1
            IHT(NCCOMM)=IFPLP2
            IH2T(NCCOMM)='    '
          ENDIF
          IF(IFPLP3.NE.'    ')THEN
            NCCOMM=NCCOMM+1
            IHT(NCCOMM)=IFPLP3
            IH2T(NCCOMM)='    '
          ENDIF
          IF(IFPLP4.NE.'    ')THEN
            NCCOMM=NCCOMM+1
            IHT(NCCOMM)=IFPLP4
            IH2T(NCCOMM)='    '
          ENDIF
          IF(IFPLP5.NE.'    ')THEN
            NCCOMM=NCCOMM+1
            IHT(NCCOMM)=IFPLP5
            IH2T(NCCOMM)='    '
          ENDIF
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)='PROB'
          IH2T(NCCOMM)='ABIL'
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)='PLOT'
          IH2T(NCCOMM)='    '
        ENDIF
        IPLOTT='PROB'
        GOTO5999
      ENDIF
      IF(IFPLPT.EQ.'PPCC')THEN
        ICT=IFPLC1
        IC2T='    '
        NCCOMM=0
        IF(IFPLC2.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=IFPLC2
          IH2T(NCCOMM)='    '
        ENDIF
        IF(IFPLC3.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=IFPLC3
          IH2T(NCCOMM)='    '
        ENDIF
        IF(IFPLC4.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=IFPLC4
          IH2T(NCCOMM)='    '
        ENDIF
        IF(IFPLC5.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=IFPLC5
          IH2T(NCCOMM)='    '
        ENDIF
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='PPCC'
        IH2T(NCCOMM)='    '
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='PLOT'
        IH2T(NCCOMM)='    '
        IPLOTT='PPCC'
        GOTO5999
      ENDIF
C
C               *************************************
C               **   GENERATE 2-VARIABLE  PLOTS    **
C               *************************************
 5299 CONTINUE
C
      IF(NPLOTS.LT.1)GOTO8000
C
      ISHIFT=ILOCQ-1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ISHIFT=NCCOMM+2
      IF(IFPLTA.EQ.'ON')ISHIFT=ISHIFT+1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ICOM=ICT
      ICOM2=IC2T
      IF(NCCOMM.GT.0)THEN
        DO5301II=1,NCCOMM
          IHARG(II)=IHT(II)
          IHARG2(II)=IH2T(II)
 5301   CONTINUE
      ENDIF
      IHARG(NCCOMM+1)=IVARN1(1)
      IHARG2(NCCOMM+1)=IVARN2(1)
      IHARG(NCCOMM+2)=IVARN1(2)
      IHARG2(NCCOMM+2)=IVARN2(2)
      IF(IFPLTA.EQ.'ON')THEN
        IHARG(NCCOMM+3)=IVARN1(NUMVAR+1)
        IHARG2(NCCOMM+3)=IVARN2(NUMVAR+1)
      ENDIF
      NARGT=NUMARG
C
      IPLOT=0
      IF(IFPLLA.EQ.'BOX')THEN
        NPLOTS=NPLOTS+IMPNR+IMPNC-1
      ENDIF
      DO5300IRES=1,IROWT
        DO5400IFAC=1,ICOLT
C
          IPLOT=IPLOT+1
          IXLIST=IFAC
          IROW=INT(IPLOT/IMPNC)+1
          IF(MOD(IPLOT,IMPNC).EQ.0)IROW=IROW-1
          ICOL=MOD(IPLOT,IMPNC)
          IF(ICOL.EQ.0)ICOL=IMPNC
C
          IEMPTY='NO'
          ITEMP=IFAC
          IF(IFPLLA.EQ.'BOX')THEN
            ICOL=ICOL-1
            ITEMP=IFAC-1
            IF(ITEMP.EQ.0)IEMPTY='YES'
            IF(IROW.EQ.IMPNR)IEMPTY='YES'
          ENDIF
C
          IF(IRES.LE.IFPLRV)THEN
            IHARG(NCCOMM+1)=IVARN1(IRES)
            IHARG2(NCCOMM+1)=IVARN2(IRES)
            IDY=IRES
          ELSE
            IHARG(NCCOMM+1)=IVARN1(IFPLRV)
            IHARG2(NCCOMM+1)=IVARN2(IFPLRV)
            IDY=IFPLRV
          ENDIF
C
          IX=IFPLRV+ITEMP
          IDX=ITEMP
          IF(IDX.LE.0)IDX=1
          IF(IX.GT.IFPLRV)THEN
            IHARG(NCCOMM+2)=IVARN1(IX)
            IHARG2(NCCOMM+2)=IVARN2(IX)
          ELSE
            IHARG(NCCOMM+2)=IVARN1(IFPLRV+1)
            IHARG2(NCCOMM+2)=IVARN2(IFPLRV+1)
          ENDIF
C
          IF(IEMPTY.EQ.'YES')THEN
            DO5304I=1,MAXSUB
              ISU2SW(I)=ISUBSW(I)
              ISUBSW(I)='OFF'
 5304       CONTINUE
          ENDIF
          IOPTN=3
          CALL DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1                ISUBNU,ISUBSW,
     1                ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1                ISUBN9,ISUBSZ,
     1                ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1                PFPXSL,PFPXSU,PFPYSL,PFPYSU,
     1                IBUGG2,ISUBRO,IERROR)
C
          ICASPL='FACT'
          CALL DPSPM1(ICASPL,IVARN1,IVARN2,ICOLL,
     1                IMPNR,IMPNC,IROW,ICOL,IRES,IX,IPLOT,
     1                NPLOTS,NUMVAR,
     1                ICHAP2,ILINP2,
     1                GY1MNS,GY1MXS,GY2MNS,GY2MXS,
     1                GX1MNS,GX1MXS,GX2MNS,GX2MXS,
     1                IY1MNS,IY1MXS,IY2MNS,IY2MXS,
     1                IX1MNS,IX1MXS,IX2MNS,IX2MXS,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                PX1LD2,PX2LD2,
     1                IY1LJ2,IY1LD2,PY1LD2,PY1LA2,
     1                IX1LT2,IX2LT2,IY1LT2,IY2LT2,
     1                NCX1L2,NCX2L2,NCY1L2,NCY2L2,
     1                PFPXLL,PFPXUL,PFPYLL,PFPYUL,IXLIST,
     1                IFPLLA,IFPLLD,IPLOTT,IFPLFR,IFPLXA,IFPLYA,
     1                IFPLDI,
     1                IFPLTD,PFPLTD,IVNMEX,
     1                IBUGG2,ISUBRO)
C
          IF(IEMPTY.EQ.'YES')THEN
            DO5306I=1,100
              ICHAPA(I)='BLAN'
              ILINPA(I)='BLAN'
              ISPISW(I)='OFF'
              IBARSW(I)='OFF'
 5306       CONTINUE
          ENDIF
C
          CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1                MAXNPP,ISEED,IBOOSS,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                BARHEF,BARWEF,
     1                IRHSTG,IHSTCW,
     1                ICAPSW,IFORSW,
     1                IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1                TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                ISUBRO,IFOUND,IERROR)
          IF(IEMPTY.EQ.'NO')THEN
            CALL DPSPM3(ICASPL,IOUNI5,
     1                  IROW,ICOL,
     1                  PX2LD2,NPLOTP,
     1                  IFORSW,
     1                  IFPX2L,ISPX2P,ISPX2S,
     1                  IHRIGH,IHRIG2,IHWUSE,
     1                  ISUBN1,ISUBN2,MESSAG,
     1                  IBUGG2,ISUBRO,IERROR)
          ENDIF
C
          ICONT=IDCONT(1)
          NUMHPP=IDNHPP(1)
          IMPARG=2
          CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1                XMATN,YMATN,XMITN,YMITN,
     1                ISQUAR,
     1                IVGMSW,IHGMSW,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1                IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1                YPLOT,XPLOT,X2PLOT,TAGPLO,
     1                IMPSW,IMPNR,IMPNC,IMPCO,
     1                IMPARG,
     1                PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                MAXCOL,
     1                DSIZE,DSYMB,DCOLOR,DFILL,
     1                ICAPSW,
     1                IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1                IERROR)
          IF(IERROR.EQ.'NO')IAND1=IAND2
          IF(IERROR.EQ.'YES')GOTO5499
C
          IF(IFPLPT.NE.'PLOT')GOTO5499
          IF(IFPLFI.EQ.'NONE')GOTO5499
          IF(IEMPTY.EQ.'YES')GOTO5499
C
          IMPCO=IMPCO-1
          IF(IMPCO.LE.1)IERASW='OFF'
C
          CALL DPSPM2(ICASPL,IVARN1,IVARN2,ICOLL,NUMVAR,NPLOTP,
     1                IRES,IX,ICHAP2,ILINP2,
     1                TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                ALOWFR,ALOWDG,
     1                IANGLU,MAXNPP,IAND1,IAND2,
     1                IFPLFI,IFPLTA,
     1                XMATN,YMATN,XMITN,YMITN,
     1                ISQUAR,
     1                IVGMSW,IHGMSW,
     1                IMPSW,IMPNR,IMPNC,IMPCO,
     1                IREPCH,
     1                PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1                IBUGUG,IBUGU2,IBUGU3,IBUGU4,
     1                ISUBRO,IFOUND,IERROR)
          IF(IERROR.EQ.'YES')GOTO5499

 5499     CONTINUE
          IERROR='NO'
          ISHIFT=NARGT-NUMARG
          IF(ISHIFT.GT.0)THEN
            CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
          ELSEIF(ISHIFT.LT.0)THEN
            ISHIFT=-ISHIFT
            CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
          ENDIF
          ICOM=ICT
          ICOM2=IC2T
          IF(NCCOMM.GT.0)THEN
            DO5401II=1,NCCOMM
              IHARG(II)=IHT(II)
              IHARG2(II)=IH2T(II)
 5401       CONTINUE
          ENDIF
          IHARG(NCCOMM+1)=IVARN1(1)
          IHARG2(NCCOMM+1)=IVARN2(1)
          IHARG(NCCOMM+2)=IVARN1(1)
          IHARG2(NCCOMM+2)=IVARN2(1)
          IF(IFPLTA.EQ.'ON')THEN
            IHARG(NCCOMM+3)=IVARN1(NUMVAR+1)
            IHARG2(NCCOMM+3)=IVARN2(NUMVAR+1)
          ENDIF
C
 5490   CONTINUE
        PX1LDS=PX1LD2
        GX1MIN=GX1MNS
        GX1MAX=GX1MXS
        GX2MIN=GX2MNS
        GX2MAX=GX2MXS
        GY1MIN=GY1MNS
        GY1MAX=GY1MXS
        GY2MIN=GY2MNS
        GY2MAX=GY2MXS
        IX1MIN=IX1MNS
        IX1MAX=IX1MXS
        IX2MIN=IX2MNS
        IX2MAX=IX2MXS
        IY1MIN=IY1MNS
        IY1MAX=IY1MXS
        IY2MIN=IY2MNS
        IY2MAX=IY2MXS
        PX1ZDS=PX1ZD2
        PX2ZDS=PX2ZD2
        PY1ZDS=PY1ZD2
        PY2ZDS=PY2ZD2
        IF(IEMPTY.EQ.'YES')THEN
          DO5407I=1,MAXSUB
            ISUBSW(I)=ISU2SW(I)
 5407     CONTINUE
        ENDIF
        DO5408I=1,100
            ICHAPA(I)=ICHAP2(I)
            ILINPA(I)=ILINP2(I)
            ISPISW(I)=ISPIS2(I)
            IBARSW(I)=IBARS2(I)
 5408   CONTINUE
        IF(IERROR.EQ.'YES')GOTO5400
C
 5400 CONTINUE
 5300 CONTINUE
      GOTO8000
C
C               *************************************
C               **   GENERATE 1-VARIABLE  PLOTS    **
C               *************************************
 5999 CONTINUE
C
      IF(NPLOTS.LT.1)GOTO8000
C
      ISHIFT=ILOCQ-1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ISHIFT=NCCOMM+1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ICOM=ICT
      ICOM2=IC2T
      DO6001II=1,NCCOMM
        IHARG(II)=IHT(II)
        IHARG2(II)=IH2T(II)
 6001 CONTINUE
      IHARG(NCCOMM+1)=IVARN1(1)
      IHARG2(NCCOMM+1)=IVARN2(1)
      NARGT=NUMARG
C
      IPLOT=0
      DO6100IRES=1,IFPLRV
C
        IHARG(NCCOMM+1)=IVARN1(IRES)
        IHARG2(NCCOMM+1)=IVARN2(IRES)
        IPLOT=IPLOT+1
C
        IX=0
        IXLIST=1
        IROW=INT(IPLOT/IMPNC)+1
        IF(MOD(IPLOT,IMPNC).EQ.0)IROW=IROW-1
        ICOL=MOD(IPLOT,IMPNC)
        IF(ICOL.EQ.0)ICOL=IMPNC
C
        IEMPTY='NO'
        IF(IFPLLA.EQ.'BOX')THEN
          ICOL=ICOL-1
          IF(ICOL.EQ.0)IEMPTY='YES'
          IF(IROW.EQ.IMPNR)IEMPTY='YES'
        ENDIF
C
        IF(IEMPTY.EQ.'YES')THEN
          DO6104I=1,MAXSUB
            ISU2SW(I)=ISUBSW(I)
            ISUBSW(I)='OFF'
 6104     CONTINUE
        ENDIF
        IOPTN=3
        IDY=IRES
        IDX=1
        CALL DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1              ISUBNU,ISUBSW,
     1              ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1              ISUBN9,ISUBSZ,
     1              ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1              PFPXSL,PFPXSU,PFPYSL,PFPYSU,
     1              IBUGG2,ISUBRO,IERROR)
C
        ICASPL='FACT'
        CALL DPSPM1(ICASPL,IVARN1,IVARN2,ICOLL,
     1              IMPNR,IMPNC,IROW,ICOL,IRES,IRES,IPLOT,
     1              NPLOTS,NUMVAR,
     1              ICHAP2,ILINP2,
     1              GY1MNS,GY1MXS,GY2MNS,GY2MXS,
     1              GX1MNS,GX1MXS,GX2MNS,GX2MXS,
     1              IY1MNS,IY1MXS,IY2MNS,IY2MXS,
     1              IX1MNS,IX1MXS,IX2MNS,IX2MXS,
     1              IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1              IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1              PX1LD2,PX2LD2,
     1              IY1LJ2,IY1LD2,PY1LD2,PY1LA2,
     1              IX1LT2,IX2LT2,IY1LT2,IY2LT2,
     1              NCX1L2,NCX2L2,NCY1L2,NCY2L2,
     1              PFPXLL,PFPXUL,PFPYLL,PFPYUL,IXLIST,
     1              IFPLLA,IFPLLD,IPLOTT,IFPLFR,IFPLXA,IFPLYA,
     1              IFPLDI,
     1              IFPLTD,PFPLTD,IVNMEX,
     1              IBUGG2,ISUBRO)
C
        IF(IEMPTY.EQ.'YES')THEN
          DO6106I=1,100
            ICHAPA(I)='BLAN'
            ILINPA(I)='BLAN'
            ISPISW(I)='OFF'
            IBARSW(I)='OFF'
 6106     CONTINUE
        ENDIF
C
        CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1              MAXNPP,ISEED,IBOOSS,
     1              IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1              IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1              BARHEF,BARWEF,
     1              IRHSTG,IHSTCW,
     1              ICAPSW,IFORSW,
     1              IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1              TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1              ISUBRO,IFOUND,IERROR)
        IF(IEMPTY.EQ.'NO')THEN
          CALL DPSPM3(ICASPL,IOUNI5,
     1                IROW,ICOL,
     1                PX2LD2,NPLOTP,
     1                IFORSW,
     1                IFPX2L,ISPX2P,ISPX2S,
     1                IHRIGH,IHRIG2,IHWUSE,
     1                ISUBN1,ISUBN2,MESSAG,
     1                IBUGG2,ISUBRO,IERROR)
        ENDIF
C
        ISHIFT=NARGT-NUMARG
        IF(ISHIFT.GT.0)THEN
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ELSEIF(ISHIFT.LT.0)THEN
          ISHIFT=-ISHIFT
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ENDIF
        ICOM=ICT
        ICOM2=IC2T
        DO6101II=1,NCCOMM
          IHARG(II)=IHT(II)
         IHARG2(II)=IH2T(II)
 6101   CONTINUE
        IHARG(NCCOMM+1)=IVARN1(1)
        IHARG2(NCCOMM+1)=IVARN2(1)
C
C               **************************************************
C               **   STEP 25--                                  **
C               **   PLOT THE CURRENT PLOT                      **
C               **************************************************
 6190   CONTINUE
        ICONT=IDCONT(1)
        NUMHPP=IDNHPP(1)
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'FACT')THEN
          WRITE(ICOUT,6197)IMANUF,NUMDEV,IDMANU(1)
 6197     FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IMPARG=2
        CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1              XMATN,YMATN,XMITN,YMITN,
     1              ISQUAR,
     1              IVGMSW,IHGMSW,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1              IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1              YPLOT,XPLOT,X2PLOT,TAGPLO,
     1              IMPSW,IMPNR,IMPNC,IMPCO,
     1              IMPARG,
     1              PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1              MAXCOL,
     1              DSIZE,DSYMB,DCOLOR,DFILL,
     1              ICAPSW,
     1              IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1              IERROR)
        IF(IERROR.EQ.'NO')IAND1=IAND2
        PX1LDS=PX1LD2
        PX1ZDS=PX1ZD2
        PX2ZDS=PX2ZD2
        PY1ZDS=PY1ZD2
        PY2ZDS=PY2ZD2
        GX1MIN=GX1MNS
        GX1MAX=GX1MXS
        GX2MIN=GX2MNS
        GX2MAX=GX2MXS
        GY1MIN=GY1MNS
        GY1MAX=GY1MXS
        GY2MIN=GY2MNS
        GY2MAX=GY2MXS
        IX1MIN=IX1MNS
        IX1MAX=IX1MXS
        IX2MIN=IX2MNS
        IX2MAX=IX2MXS
        IY1MIN=IY1MNS
        IY1MAX=IY1MXS
        IY2MIN=IY2MNS
        IY2MAX=IY2MXS
        IF(IEMPTY.EQ.'YES')THEN
          DO6107I=1,MAXSUB
            ISUBSW(I)=ISU2SW(I)
 6107     CONTINUE
        ENDIF
        DO6108I=1,100
            ICHAPA(I)=ICHAP2(I)
            ILINPA(I)=ILINP2(I)
            ISPISW(I)=ISPIS2(I)
            IBARSW(I)=IBARS2(I)
 6108     CONTINUE
C
 6100 CONTINUE
      GOTO8000
C
C
C               **************************************************
C               **   STEP 28--                                  **
C               **   REINSTATE INITIAL SETTINGS                 **
C               **************************************************
C
 8000 CONTINUE
 2800 CONTINUE
      ISTEPN='28'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'4PLO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,8807)IMANUF,NUMDEV,IDMANU(1)
 8807 FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      PWXMIN=PWXMN2
      PWXMAX=PWXMX2
      PWYMIN=PWYMN2
      PWYMAX=PWYMX2
      PXMIN=PXMN2
      PXMAX=PXMX2
      PYMIN=PYMN2
      PYMAX=PYMX2
      GX1MIN=GX1MNS
      GX1MAX=GX1MXS
      GX2MIN=GX2MNS
      GX2MAX=GX2MXS
      GY1MIN=GY1MNS
      GY1MAX=GY1MXS
      GY2MIN=GY2MNS
      GY2MAX=GY2MXS
      IX1MIN=IX1MNS
      IX1MAX=IX1MXS
      IX2MIN=IX2MNS
      IX2MAX=IX2MXS
      IY1MIN=IY1MNS
      IY1MAX=IY1MXS
      IY2MIN=IY2MNS
      IY2MAX=IY2MXS
      IX1TSW=IX1TSV
      IX2TSW=IX2TSV
      IY1TSW=IY1TSV
      IY2TSW=IY2TSV
      IX1ZSW=IX1ZSV
      IX2ZSW=IX2ZSV
      IY1ZSW=IY1ZSV
      IY2ZSW=IY2ZSV
      PX1LDS=PX1LD2
      PX2LDS=PX2LD2
      PY1LDS=PY1LD2
      PY1LAN=PY1LA2
      IY1LJU=IY1LJ2
      IY1LDI=IY1LD2
      PX1ZDS=PX1ZD2
      PX2ZDS=PX2ZD2
      PY1ZDS=PY1ZD2
      PY2ZDS=PY2ZD2
C
      DO8820I=1,100
        ICHAPA(I)=ICHAP2(I)
        ILINPA(I)=ILINP2(I)
        ISPISW(I)=ISPIS2(I)
        IBARSW(I)=IBARS2(I)
 8820 CONTINUE
C
CCCCC IMPSW=IMPSW3
      IMPSW='OFF'
      IMPCO=1
      IMPNR=IMPNR2
      IMPNC=IMPNC2
C
      IERASW='ON'
      IFENSW=IFENC2
      ISORSW=ISORS2
      IPPTBI=IPPTB2
C
      DO8500I=1,MAXCH
        IX1LTE(I)=IX1LT2(I)
        IX2LTE(I)=IX2LT2(I)
        IY1LTE(I)=IY1LT2(I)
        IY2LTE(I)=IY2LT2(I)
 8500 CONTINUE
      NCX1LA=NCX1L2
      NCX2LA=NCX2L2
      NCY1LA=NCY1L2
      NCY2LA=NCY2L2
C
      IFPLLA=IFPLL2
      IFPLTA=IFPLTZ
      IFPLFR=IFPLFZ
      IFPLPT=IFPLPZ
      IFPLLD=IFPLLZ
      IFPLXA=IFPLXZ
      IFPLYA=IFPLYZ
      IFPLDI=IFPLDZ
      IFPLST=IFPLZT
      IFPLS2=IFPLZ2
      IFPLS3=IFPLZ3
      IFPLS4=IFPLZ4
C
      IFEEDB=IFEED9
C
      DO8809I=1,MAXCH
        ITITTE(I)=ITITSV(I)
 8809 CONTINUE
      NCTITL=NCTITS
C
      IENDF5='OFF'
      IREWI5='ON'
      IF(IOUNI5.GT.0)
     1CALL DPCLFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IENDF5,IREWI5,ISUBN0,IERRF5,IBUGG3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')GOTO9000
C
      PTITDS=PTITDZ
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFACT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMARG
 9014 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9029
      DO9021I=1,NUMARG
      WRITE(ICOUT,9022)I,IHARG(I),IARGT(I)
 9022 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9029 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFAIR(NPTS,NLAB,
     1AMEAN,ASD,N,
     1XFAIR,XFAIS2,SEFWK1,SEFWK2,
     1DLOWFW,DHIGFW,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--IMPLEMENT FAIRWEATHER APPROACH TO CONSENSUS MEANS
C     PRINTING--YES
C     SUBROUTINES NEEDED--NONE
C     REFERENCES--ADAPTED FROM MATLAB SCRIPT PROVIDED BY
C                 ANDREW RUHKIN OF THE NIST STATISTICAL
C                 ENGINEERING DIVISION
C               --FAIRWEATHER (1972), "A METHOD FOR OBTAINING
C                 AN EXACT CONFIDENCE INTERVAL FOR THE COMMON
C                 MEAN OF SEVERAL NORMAL POPULATIONS",
C                 APPLIED STATISTICS, 21, PP. 229-233.
C               --M. G. COX (2002), "THE EVALUATION OF KEY
C                 COMPARISON DATA", METROLOGIA, 39, PP. 589-595.
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/4
C     ORIGINAL VERSION--APRIL     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
      REAL AMEAN(*)
      REAL ASD(*)
C
      REAL APPF
      REAL XFAIR
      REAL XFAIS2
      REAL SEFWK1
      REAL SEFWK2
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.'FAIR')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPFAIR--')
        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 FAIRWEATHER CONSENSUS MEAN
C
      IFLAG9=.TRUE.
      DSUM1=0.0D0
      DO910I=1,NLAB
        DNI=DBLE(N(I))
        IF(N(I).GT.5)THEN
          DSUM1=DSUM1 + (DNI-3.0D0)/(DNI-1.0D0)
        ELSE
          IFLAG9=.FALSE.
          XFAIR=0.0
          DLOWFW=0.0D0
          DHIGFW=0.0D0
          GOTO9000
        ENDIF
  910 CONTINUE
      DU1=DSUM1
C
      DSUM1=0.0D0
      DO920I=1,NLAB
        DNI=DBLE(N(I))
        DVARI=DBLE(ASD(I))**2
        CK=(DNI-3.0D0)/(DNI-1.0D0)
        CF=CK/DU1
        U=DVARI/DNI
        WF=CF/DSQRT(U)
        DSUM1=DSUM1 +  WF
  920 CONTINUE
      DSS=DSUM1
C
      DSUM1=0.0D0
      DO930I=1,NLAB
        DNI=DBLE(N(I))
        DMEAN=DBLE(AMEAN(I))
        DVARI=DBLE(ASD(I))**2
        CK=(DNI-3.0D0)/(DNI-1.0D0)
        CF=CK/DU1
        U=DVARI/DNI
        WF=CF/DSQRT(U)
        DWI=WF/DSS
        DSUM1=DSUM1 + DWI*DMEAN
  930 CONTINUE
      XFAIR=REAL(DSUM1)
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
      DSUM2=0.0D0
      DPROD1=1.0D0
      DO940I=1,NLAB
        DNI=DBLE(N(I))
        DMEAN=DBLE(AMEAN(I))
        DVARI=DBLE(ASD(I))**2
        CK=(DNI-3.0D0)/(DNI-1.0D0)
        CF=CK/DU1
        U=DVARI/DNI
        WF=CF/DSQRT(U)
        DWI=WF/DSS
        DSUM2=DSUM2 + DWI*(DMEAN - DBLE(XFAIR))**2
        DPROD1=DPROD1*DWI
  940 CONTINUE
      DPROD1=DPROD1**DPP
      DRI=DPH*DSQRT(DSUM2)/DSQRT(DPROD1)
      DLOWFW=DBLE(XFAIR) - DRI
      DHIGFW=DBLE(XFAIR) + 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>11. Method: Fairweather</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)XFAIR
        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(DLOWFW)
        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(DHIGFW)
        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: Fairweather 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         'Minimum within Lab Sample Size > 5<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
      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 11. Method: Fairweather:} & ',
     1         2X,A1,A1)
 8012   FORMAT(5X,'Estimate of Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
C
        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)XFAIR,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: Fairweather Best Usage: & ',
     1         2X,A1,A1)
 8029   FORMAT(5X,'      Minimum within Lab Size > 5 & ',
     1         2X,A1,A1)
        WRITE(ICOUT,8026)IBASLC,REAL(DLOWFW),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,REAL(DHIGFW),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 11. Method: Fairweather'
        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)=XFAIR
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Lower 95% (Rukhin) Confidence Limit:'
        AVALUE(2)=REAL(DLOWFW)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Upper 95% (Rukhin) Confidence Limit:'
        AVALUE(2)=REAL(DHIGFW)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IVALUE(1)='   Note: Fairweather Best Usage:'
        NCHAR(1)=34
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         Minimum Within Lab Size > 5'
        NCHAR(1)=35
        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
        IF(.NOT.IFLAG9)GOTO9000
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('11.  Method: Fairweather')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4002)XFAIR
 4002   FORMAT('    Estimate of Consensus Mean:             ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,4003)XFAIS2
C4003   FORMAT('    Estimate of Variance (Sinha):           ',
CCCCC1         F15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,4004)XFAIS20
C4004   FORMAT('    Estimate of Variance (Naive):           ',
CCCCC1         F15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4022)REAL(DLOWFW)
 4022   FORMAT('    Lower 95% (Rukhin) Confidence Limit:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)REAL(DHIGFW)
 4023   FORMAT('    Upper 95% (Rukhin) Confidence Limit:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('    Note: Fairweather Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)
 4032   FORMAT('          Minimum Sample Size for Lab',
     1         ' > 5')
        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.'FAIR')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPFAIR--')
        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)XFAIR,XFAIS2
 9014   FORMAT('XFAIR,XFAIS2 = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)DLOWFW,DHIGFW
 9015   FORMAT('DLOWFW,DHIGFW = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPFEED(IHARG,NUMARG,
     1IFEED2,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY THE FEEDBACK SWITCH WHICH IN TURN
C              DETERMINES WHETHER ANY SUBSEQUENT FEEDBACK OUTPUT
C              (LIKE, SAY, FROM A SUBSET SPECIFICATION)
C              WILL BE PRINTED OR NOT.
C              THIS CAPABILITY IS USEFUL IF ONE WISHES TO SUPPRESS
C              FEEDBACK OUTPUT FROM ALL SWITCH SETTING COMMANDS
C              SO AS TO NOT CLUTTER UP THE SCREEN
C              IN FORMING (FOR EXAMPLE) DIAGRAMMATIC GRAPHICS.
C              THE SPECIFIED FEEDBACK SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IFEED2.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IFEED2 (A HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY       1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IFEED2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1199
C
 1150 CONTINUE
      IHOLD='ON'
      GOTO1180
C
 1160 CONTINUE
      IHOLD='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IFEED2=IHOLD
      IFEEDB=IFEED2
C
CCCCC GOTO1189
CCCCC IF(IFEEDB.EQ.'OFF')GOTO1189
CCCCC WRITE(ICOUT,999)
CC999 FORMAT(1X)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1181)IFEED2
C1181 FORMAT('THE FEEDBACK SWITCH HAS JUST BEEN SET TO ',
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC1A4)
C1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPFENC(IHARG,NUMARG,
     1IFENSW,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY THE FENCE SWITCH WHICH IN TURN
C              DETERMINES WHETHER SUCCEEDING BOX PLOTS WILL HAVE
C              VALUES BEYOND THE INNER FENCE AND OUTER FENCE INDICATED.
C              THE SPECIFIED FENCE SWITCH SPECIFICATION
C              WILL BE PLACED IN THE CHARACTER VARIABLE IFENSW.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IFENSW (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83/7
C     ORIGINAL VERSION--JULY      1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IFENSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1150
C
 1150 CONTINUE
      IHOLD='ON'
      GOTO1180
C
 1160 CONTINUE
      IHOLD='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IFENSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IFENSW
 1181 FORMAT('THE FENCE SWITCH (FOR BOX PLOTS) HAS JUST ',
     1'BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPFICN(ICOM,IHARG,IHARG2,IARGT,ARG,NUMARG,
     1IPARNC,IPANC2,IPAROP,PARLIM,NUMCON,MAXCON,IFOUND,IERROR,IBUG)
C
C     PURPOSE--DEFINE CONSTRAINTS TO BE USED
C              IN CONJUNCTION WITH THE FIT COMMAND
C              (AND THE PRE-FIT COMMAND).
C              THE SPECIFIED CONSTRAINED PARAMETER NAME WILL BE PLACED
C              IN AN ELEMENT OF THE HOLLERITH VARIABLES
C              IPARNC(.) AND IPANC2(.).
C              THE SPECIFIED MATHEMATICAL OPERATION
C              (< OR <= OR = OR >= OR >)
C              INVOLVED WITH THE CONSTRAINT
C              WILL BE PLACED IN THE CORRESPONDING ELEMENT
C              OF THE HOLLARIRTH VECTOR IPAROP(.).
C              THE SPECIFIED NUMBER WHICH SERVES AS THE BOUNDARY VALUE
C              IN THE CONSTRAINT WILL BE PLACED IN THE CORRESPONDING
C              ELEMENT OF THE FLOATING POINT VECTOR PARLIM(.).
C     INPUT  ARGUMENTS--ICOM   (A  HOLLERITH VECTOR)
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IHARG2 (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IPARNC (A  HOLLERITH VECTOR)
C                     --IPANC2 (A  HOLLERITH VECTOR)
C                     --IPAROP (A  HOLLERITH VECTOR)
C                     --PARLIM (A  FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --DECEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IPARNC
      CHARACTER*4 IPANC2
      CHARACTER*4 IPAROP
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 IBUG
C
      CHARACTER*4 IH1
      CHARACTER*4 IH2
      CHARACTER*4 NEWCON
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION IPARNC(*)
      DIMENSION IPANC2(*)
      DIMENSION IPAROP(*)
      DIMENSION PARLIM(*)
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='DPFI'
      ISUBN2='CN  '
C
      ICON=0
C
      NEWCON='UNKN'
C
      IF(IBUG.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** AT THE BEGINNING OF DPFICN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)NUMARG
   62 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ICOM
   63 FORMAT('ICOM = ',A4)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO67
      DO65I=1,NUMARG
      WRITE(ICOUT,66)I,IHARG(I),IHARG2(I),ARG(I)
   66 FORMAT('I,IHARG(I),IHARG2(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
   67 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)NUMCON,MAXCON,NEWCON,IBUG
   72 FORMAT('NUMCON,MAXCON,NEWCON,IBUG = ',I8,I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCON.LE.0)GOTO77
      DO75I=1,NUMCON
      WRITE(ICOUT,76)I,IPARNC(I),IPANC2(I),IPAROP(I),PARLIM(I)
   76 FORMAT('I,IPARNC(I),IPANC2(I),IPAROP(I),PARLIM(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   77 CONTINUE
C
   90 CONTINUE
C
C               **********************************************
C               **  STEP 1--                                **
C               **  DETERMINE IF HAVE THE TOTAL RESET CASE  **
C               **********************************************
C
      ISTEPN='1'
      IF(IBUG.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'FIT'.AND.IHARG(1).EQ.'CONS'.AND.
     1IHARG2(1).EQ.'TRAI')GOTO100
      GOTO900
C
  100 CONTINUE
      IF(NUMARG.LE.1)GOTO110
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'ON')GOTO110
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'OFF')GOTO110
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'AUTO')GOTO110
      IF(NUMARG.EQ.2.AND.IHARG(2).EQ.'DEFA')GOTO110
      GOTO190
C
  110 CONTINUE
      IFOUND='YES'
      DO120I=1,MAXCON
      IPARNC(I)='    '
      IPANC2(I)='    '
      IPAROP(I)='NONE'
      PARLIM(I)=CPUMIN
  120 CONTINUE
      NUMCON=0
C
      IF(IFEEDB.EQ.'OFF')GOTO129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('ALL PARAMETERS HAVE JUST BEEN SET SO AS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,122)
  122 FORMAT('    TO BE UNCONSTRAINED')
      CALL DPWRST('XXX','BUG ')
  129 CONTINUE
      GOTO900
C
  190 CONTINUE
C
C               ********************************************************
C               **  STEP 2--                                          **
C               **  DETERMINE IF NAME OF PARAMETER TO BE CONSTRAINED  **
C               **  ALREADY EXISTS IN CONSTRAINT TABLE.               **
C               ********************************************************
C
      ISTEPN='2'
      IF(IBUG.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH1=IHARG(2)
      IH2=IHARG2(2)
C
CC    NEWCON='NO'
CC    ICON=0
CC    IF(NUMCON.LE.0)GOTO220
CC    DO200I=1,NUMCON
CC    I2=I
CC    IF(IH1.EQ.IPARNC(I).AND.IH2.EQ.IPANC2(I))GOTO210
CC200 CONTINUE
CC    GOTO220
CC
CC210 CONTINUE
CC    ICON=I2
CC    GOTO290
CC
  220 CONTINUE
      ICON=NUMCON+1
      IF(ICON.LE.MAXCON)GOTO229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,221)
  221 FORMAT('***** ERROR IN DPFICN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,222)
  222 FORMAT('      THE NUMBER OF CONSTRAINTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,224)
  224 FORMAT('      HAS JUST EXCEEDED THE MAXIMUM SIZE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,225)MAXCON
  225 FORMAT('      (',I5,') OF THE INTERNAL CONSTRAINT TABLE.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO900
  229 CONTINUE
C
      NEWCON='YES'
      NUMCON=ICON
      GOTO290
C
  290 CONTINUE
C
C               ***********************************************
C               **  STEP 3--                                 **
C               **  ENTER THE PARAMETER NAME (IF NECESSARY)  **
C               **  INTO THE NAME VECTORS IPARNC(.) AND      **
C               **  IPANC2(.)                                **
C               ***********************************************
C
      ISTEPN='3'
      IF(IBUG.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPARNC(ICON)=IH1
      IPANC2(ICON)=IH2
C
C               ******************************************
C               **  STEP 4--                            **
C               **  ENTER THE CONSTRAINT OPERATION      **
C               **  INTO THE OPERATION VECTOR IPAROP(.) **
C               ******************************************
C
      ISTEPN='4'
      IF(IBUG.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPAROP(ICON)='NONE'
      IF(NUMARG.LE.3)GOTO410
      IF(IHARG(3).EQ.'ON')GOTO410
      IF(IHARG(3).EQ.'OFF')GOTO410
      IF(IHARG(3).EQ.'DEFA')GOTO410
      IF(IHARG(3).EQ.'AUTO')GOTO410
C
      IF(IHARG(3).EQ.'<'.AND.IHARG(4).NE.'=')GOTO420
      IF(IHARG(3).EQ.'<'.AND.IHARG(4).EQ.'=')GOTO430
      IF(IHARG(3).EQ.'='.AND.IHARG(4).EQ.'<')GOTO430
      IF(IHARG(3).EQ.'='.AND.IHARG(4).NE.'<'.AND.
     1IHARG(4).NE.'>')GOTO440
      IF(IHARG(3).EQ.'>'.AND.IHARG(4).EQ.'=')GOTO450
      IF(IHARG(3).EQ.'='.AND.IHARG(4).EQ.'>')GOTO450
      IF(IHARG(3).EQ.'>'.AND.IHARG(4).NE.'=')GOTO460
      GOTO470
C
  410 CONTINUE
      IPAROP(ICON)='NONE'
      GOTO490
C
  420 CONTINUE
      IPAROP(ICON)='<'
      GOTO490
C
  430 CONTINUE
      IPAROP(ICON)='<='
      GOTO490
C
  440 CONTINUE
      IPAROP(ICON)='='
      GOTO490
C
  450 CONTINUE
      IPAROP(ICON)='>='
      GOTO490
C
  460 CONTINUE
      IPAROP(ICON)='>'
      GOTO490
C
  470 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,471)
  471 FORMAT('ERROR IN DPFICN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,472)
  472 FORMAT('      THE SECOND ARGUMENT IN THE FIT CONSTRAINT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,473)
  473 FORMAT('      COMMAND SHOULD BE ONE OF THE FOLLOWING 5  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,474)
  474 FORMAT('      MATHEMATICAL OPERATIONS-- <   <=   =   >=   >')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,475)
  475 FORMAT('      OR SHOULD BE ONE OF THE FOLLOWING 4 WORDS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,476)
  476 FORMAT('      ON    OFF    AUTOMATIC    DEFAULT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,477)
  477 FORMAT('      BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,478)
  478 FORMAT('      THE FOLLOWING ILLUSTRATIVE EXAMPLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,479)
  479 FORMAT('      DEMONSTRATES THE ALLOWABLE FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,480)
  480 FORMAT('      SUPPOSE THE ANALYST WISHES TO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('      CONSTRAIN THE PARAMETER ALPHA IN A FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      TO BE STRICTLY GREATER THAN 0 AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      ALSO TO BE LESS THAN OR EQUAL TO 100,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      THEN THE FOLLOWING MAY BE ENTERED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)
  485 FORMAT('      FIT CONSTRAINT ALPHA > 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      FIT CONSTRAINT ALPHA <= 100')
      CALL DPWRST('XXX','BUG ')
      IF(NEWCON.EQ.'NO')GOTO489
      NUMCON=NUMCON-1
      IPARNC(ICON)='    '
      IPANC2(ICON)='    '
  489 CONTINUE
      GOTO900
C
  490 CONTINUE
C
C               **************************************
C               **  STEP 5--                        **
C               **  ENTER THE CONSTRAINT LIMITS     **
C               **  INTO THE VECTOR PARLIM(.)       **
C               **************************************
C
      ISTEPN='5'
      IF(IBUG.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPAROP(ICON).EQ.'NONE')GOTO590
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO510
      GOTO570
C
  510 CONTINUE
      IFOUND='YES'
      PARLIM(ICON)=ARG(NUMARG)
      GOTO590
C
  570 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('ERROR IN DPFICN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      THE THIRD ARGUMENT IN THE FIT CONSTRAINT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,573)
  573 FORMAT('      COMMAND SHOULD BE A NUMBER ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,574)
  574 FORMAT('      OR A PREVIOUSLY-DEFINED PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,575)
  575 FORMAT('      BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,576)
  576 FORMAT('      THE FOLLOWING ILLUSTRATIVE EXAMPLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,577)
  577 FORMAT('      DEMONSTRATES THE ALLOWABLE FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)
  578 FORMAT('      SUPPOSE THE ANALYST WISHES TO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      CONSTRAIN THE PARAMETER ALPHA IN A FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,480)
  580 FORMAT('      TO BE STRICTLY GREATER THAN 0 AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      ALSO TO BE LESS THAN OR EQUAL TO 100,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      THEN THE FOLLOWING MAY BE ENTERED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      FIT CONSTRAINT ALPHA > 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)
  584 FORMAT('      FIT CONSTRAINT ALPHA <= 100')
      CALL DPWRST('XXX','BUG ')
      IF(NEWCON.EQ.'NO')GOTO589
      NUMCON=NUMCON-1
      IPARNC(ICON)='    '
      IPANC2(ICON)='    '
  589 CONTINUE
      GOTO900
  590 CONTINUE
C
C               ****************************
C               **  STEP 6--              **
C               **  WRITE OUT A MESSAGE.  **
C               ****************************
C
      ISTEPN='6'
      IF(IBUG.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPAROP(ICON).EQ.'NONE')GOTO610
      IF(IPAROP(ICON).EQ.'<')GOTO620
      IF(IPAROP(ICON).EQ.'<=')GOTO630
      IF(IPAROP(ICON).EQ.'=')GOTO640
      IF(IPAROP(ICON).EQ.'>=')GOTO650
      IF(IPAROP(ICON).EQ.'>')GOTO660
      GOTO690
C
  610 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,611)IPARNC(ICON),IPANC2(ICON)
  611 FORMAT('THE PARAMETER ',A4,A4,' HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,612)
  612 FORMAT('    SO AS TO BE UNCONSTRAINED')
      CALL DPWRST('XXX','BUG ')
  619 CONTINUE
      GOTO670
C
  620 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,621)IPARNC(ICON),IPANC2(ICON)
  621 FORMAT('THE PARAMETER ',A4,A4,' HAS JUST BEEN CONSTRAINED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,622)PARLIM(ICON)
  622 FORMAT('    TO BE STRICTLY LESS THAN ',E15.7)
      CALL DPWRST('XXX','BUG ')
  629 CONTINUE
      GOTO690
C
  630 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO639
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,631)IPARNC(ICON),IPANC2(ICON)
  631 FORMAT('THE PARAMETER ',A4,A4,' HAS JUST BEEN CONSTRAINED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,632)PARLIM(ICON)
  632 FORMAT('    TO BE LESS THAN OR EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
  639 CONTINUE
      GOTO690
C
  640 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO649
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,641)IPARNC(ICON),IPANC2(ICON)
  641 FORMAT('THE PARAMETER ',A4,A4,' HAS JUST BEEN CONSTRAINED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,642)PARLIM(ICON)
  642 FORMAT('    TO BE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
  649 CONTINUE
      GOTO690
C
  650 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO659
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,651)IPARNC(ICON),IPANC2(ICON)
  651 FORMAT('THE PARAMETER ',A4,A4,' HAS JUST BEEN CONSTRAINED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,652)PARLIM(ICON)
  652 FORMAT('    TO BE GREATER THAN OR EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
  659 CONTINUE
      GOTO690
C
  660 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO669
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,661)IPARNC(ICON),IPANC2(ICON)
  661 FORMAT('THE PARAMETER ',A4,A4,' HAS JUST BEEN CONSTRAINED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,662)PARLIM(ICON)
  662 FORMAT('    TO BE STRICTLY GREATER THAN ',E15.7)
      CALL DPWRST('XXX','BUG ')
  669 CONTINUE
      GOTO690
C
  670 CONTINUE
      NUMCO2=NUMCON
      IF(NUMCON.LE.0)GOTO679
      DO671I=1,NUMCON
      IF(I.GT.NUMCO2)GOTO679
      I2=I
      IF(IH1.EQ.IPARNC(I).AND.IH2.EQ.IPANC2(I))GOTO672
      GOTO671
C
  672 CONTINUE
      J=I
      JM1=J-1
      JMIN=I+1
      JMAX=NUMCO2
      IF(JMIN.GT.JMAX)GOTO674
      DO673J=JMIN,JMAX
      JM1=J-1
      IPARNC(JM1)=IPARNC(J)
      IPANC2(JM1)=IPANC2(J)
      IPAROP(JM1)=IPAROP(J)
      PARLIM(JM1)=PARLIM(J)
  673 CONTINUE
  674 CONTINUE
      NUMCO2=JM1
C
  671 CONTINUE
  679 CONTINUE
      NUMCON=NUMCO2
      GOTO690
C
  690 CONTINUE
C
C               ****************
C               **  STEP 9--  **
C               **  EXIT      **
C               ****************
C
  900 CONTINUE
      IF(IBUG.EQ.'OFF')GOTO990
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,901)
  901 FORMAT('***** AT THE END OF DPFICN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,902)NUMCON,MAXCON,NEWCON,IBUG
  902 FORMAT('NUMCON,MAXCON,NEWCON,IBUG = ',I8,I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,903)ICON
  903 FORMAT('ICON = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCON.LE.0)GOTO990
      DO910I=1,NUMCON
      WRITE(ICOUT,911)I,IPARNC(I),IPANC2(I),IPAROP(I),PARLIM(I)
  911 FORMAT('I,IPARNC(I),IPANC2(I),IPAROP(I),PARLIM(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
  910 CONTINUE
  990 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFIFO(IHARG,NUMARG,
     1IOUTTY,IFOUND,IERROR)
C
C     PURPOSE--SET THE FORMAT/TYPE SWITCH FOR THE OUTPUT FILE.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IOUTTY (A HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--92/4
C     ORIGINAL VERSION--MARCH     1992.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IOUTTY
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'?')GOTO1160
      GOTO1170
C
 1150 CONTINUE
      IHOLD='ASCI'
      GOTO1180
C
 1160 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1161)IOUTTY
 1161 FORMAT('THE CURRENT FORMAT OF THE OUTPUT FILE IS ',A4)
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      IFOUND='YES'
      GOTO1199
C
 1170 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IOUTTY=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IOUTTY
 1181 FORMAT('THE OUTPUT FILE FORMAT SWITCH HAS JUST ',
     1'BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPFIIT(IHARG,IARGT,IARG,NUMARG,IDEFFI,
     1IFITIT,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE UPPER BOUND FOR THE NUMBER OF FIT ITERATIONS.
C              THE SPECIFIED FIT ITERATION VALUE WILL BE PLACED
C              IN THE INTEGER VARIABLE IFITIT.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFFI (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IFITIT (AN INTEGER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      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
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'ITER')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ITER')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 DPFIIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR FIT ITERATIONS ',
     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 WILL BE CARRYING OUT  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      A NON-LINEAR FIT , ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AND SUPPOSE THE ANALYST WISHES TO TERMINATE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THE FIT IF THE NUMBER OF ITERATIONS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      HAPPENS TO REACH 30;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      FIT ITERATIONS 30 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      IHOLD=IDEFFI
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IFITIT=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IFITIT
 1181 FORMAT('THE FIT ITERATIONS HAVE JUST BEEN SET TO ',
     1I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPFILE(IANS,IWIDTH,IWORD,
     1IOFILE,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--SCAN THE    IWORD-TH   WORD OF THE INPUT LINE.
C              AND DETERMINE IF IT IS A FILE NAME.
C              THE CRITERION IS THAT IF THAT WORD
C              CONTAINS THE CHARACTER    IFCHAR   ,
C              THEN IT IS CONSIDERED A FILE NAME,
C              OTHERWISE IT IS CONSIDERED NOT TO BE A FILE NAME.
C     OUTPUT ARGUMENT--IOFILE ('YES' OR 'NO')
C     NOTE--THIS SUBROUTINE IS "SYSTEM-DEPENDENT" IN THE SENSE
C           THAT IFCHAR MAY DIFFER FROM ONE SYSTEM TO ANOTHER.
C     NOTE--IFCHAR IS SET AT TIMPLEMENTATION TIME
C           IN THE SUBROUTINE INITFO.
C     NOTE--THE DEFAULT SETTING FOR IFCHAR IS . (= PERIOD).
C           THUS YOU MAY ENTER  READ X. Y Z
C           TO TELL DATAPLOT TO READ VARIABLES Y AND Z
C           FROM FILE X
C           AS OPPOSED TO ENTERING   READ X Y Z
C           TO TELL DATAPLOT TO READ VARIABLES X, Y, AND Z
C           FROM THE TERMINAL.
C           READ X. Y Z
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--NOVEMBER  1977.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JUNE      1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1986.
C     UPDATED         --DECEMBER  1988. DESLATTES FILE NAME INSIDE QUOTE PROBLEM
C     UPDATED         --JULY      2002. OPTION (IFILQU=ON/OFF) TO
C                                       DETERMINE IF FILE NAME CAN
C                                       BE ENCLOSED IN QUOTES
C     UPDATED         --JULY      2003. BUG: EVEN THOUGH FILE NAMES
C                                       MAY BE RESTRICTED TO 80
C                                       CHARACTERS, THE COMMAND LINE
C                                       CONTAINING THEM CAN BE
C                                       LONGER.  ADJUST DIMENSIONING
C                                       TO ACCOUNT FOR THIS.  ALSO ADD
C                                       CHECK FOR FILE NAMES EXCEEDING
C                                       80 CHARACTERS.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 IOFILE
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IANSI
CCCCC CHARACTER*80 ICANS
CCCCC CHARACTER*80 ISTRIN
      CHARACTER*255 ICANS
      CHARACTER*255 ISTRIN
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IANS(*)
C
      PARAMETER (MAXFNC=80)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.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='DPFI'
      ISUBN2='LE  '
C
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'FILE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFILE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IWIDTH,IWORD
   52 FORMAT('IWIDTH,IWORD = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,53)(IANS(I),I=1,MIN(100,IWIDTH))
   53   FORMAT('IANS(.) = ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,54)IFCHAR
   54 FORMAT('IFCHAR = ',A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************************
C               **  STEP 1--                         **
C               **  DETERMINE IF HAVE THE FILE CASE  **
C               ***************************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'FILE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,MIN(255,IWIDTH)
        IANSI=IANS(I)
        ICANS(I:I)=IANSI(1:1)
 1110 CONTINUE
C
      ISTART=1
      ISTOP=IWIDTH
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRIN,NCSTRI,
     1IBUGS2,ISUBRO,IERROR)
C
      IOFILE='NO'
      IF(NCSTRI.LE.0)GOTO1290
C     THE FOLLOWING LINE WAS INSERTED DECEMBER 1988 TO
C     SOLVE THE DESLATTES PROBLEM    WRITE "(EXAMPLE--ABC.DEF)"
C     JULY 2002: MAKE QUOTE OPTIONAL (PC FILES CAN HAVE SPACES,
C     SO ENCLOSE IN QUOTES TO EXTRACT)
CCCCC IF(ICANS(1:1).EQ.'"')GOTO1290
      IF(ICANS(1:1).EQ.'"' .AND. IFILQU.EQ.'OFF')GOTO1290
      IF(ICOL1.GT.ICOL2)GOTO1290
      DO1200I=ICOL1,ICOL2
      IF(ICANS(I:I).EQ.IFCHAR)GOTO1250
 1200 CONTINUE
      GOTO1290
 1250 CONTINUE
      IOFILE='YES'
      NC=ICOL2-ICOL1+1
      IF(IFILQU.EQ.'ON' .AND. ICANS(ICOL1:ICOL1).EQ.'"')NC=NC-1
      IF(IFILQU.EQ.'ON' .AND. ICANS(ICOL2:ICOL2).EQ.'"')NC=NC-1
      IF(NC.GT.MAXFNC)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1251)MAXFNC
 1251   FORMAT('***** FATAL ERROR: FILE NAME EXCEEDS MAXIMUM ',
     1         'LENGTH OF ',I8,' CHARACTERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1253)NC
 1253   FORMAT('      REQUESTED FILE NAME HAS ',I8,' CHARACTERS.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      GOTO1290
 1290 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'FILE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END      OF DPFILE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IWIDTH,IWORD
 9012 FORMAT('IWIDTH,IWORD = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,9013)(IANS(I),I=1,MIN(100,IWIDTH))
 9013   FORMAT('IANS(.) = ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,9014)IFCHAR
 9014 FORMAT('IFCHAR = ',A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICOL1,ICOL2,NCSTRI
 9015 FORMAT('ICOL1,ICOL2,NCSTRI = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,9021)(ICANS(I:I),I=1,MIN(100,IWIDTH))
 9021   FORMAT('ICANS(.:.) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9022)(ISTRIN(I:I),I=1,MIN(100,IWIDTH))
 9022   FORMAT('ISTRIN(.:.) = ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,9031)IBUGS2,IERROR
 9031 FORMAT('IBUGS2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IOFILE
 9032 FORMAT('IOFILE = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFIL2(ICHAR,IMIN,IMAX,IANS2,IWID,
     1LOCCHA,NAM,NPACKC,IBUG,IERROR)
C
C     PURPOSE--EXTRACT QUALIFIER, FILE, OR SUBFILE
C              NAME FROM A STRING.
C     INPUT  ARGUMENTS--IMIN   = INTEGER VARIABLE
C                                CONTAINING THE START LOCATION
C                                (IN THE VECTOR IANS2(.))
C                                FOR THE SEARCH.
C                     --IMAX   = INTEGER VARIABLE
C                                CONTAINING THE STOP LOCATION
C                                (IN THE VECTOR IANS2(.))
C                                FOR THE SEARCH.
C                     --ICHAR  = HOLLERITH VARIABLE GIVING
C                                THE SOUGHT-AFTER CHARACTER
C                                IN THE SEARCH.
C                     --IANS2  = HOLLERITH VECTOR BEING SEARCHED.
C                     --IWID   = THE NUMBER OF ELEMENTS
C                                IN THE HOLLERITH VECTOR IANS2(.)
C     OUTPUT ARGUMENTS--LOCCHA = INTEGER VARIABLE
C                                CONTAINING THE LOCATION
C                                (IN THE VECTR IANS2(.))
C                                WHERE THE CHARACTER WAS FOUND.
C                     --NAM    = HOLLERITH VECTOR
C                                INTO WHICH THE PACKED NAME
C                                IS PLACED.
C                     --NPACKC = INTEGER VARIABLE
C                                CONTAINING THE NUMBER OF WORDS
C                                IN THE VARIABLE NAM(.) FOR
C                                THE PACKED VERSION OF THE
C                                QUALIFIER, FILE, AND/OR SUBFILE NAME
C                                (WHERE THE WORDS ARE PACKED--
C                                4, 6, 10, ETC. CHARACTERS PER WORD).
C     NOTE--IF THE NAME DOES NOT EXIST,
C           THE LOCCHA IS SET TO IMIN-1,
C           NAM(.) IS FILLED WITH BLANKS,
C           AND NPACKC IS SET TO 0   .
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JUNE        1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR
      CHARACTER*4 IANS2
      CHARACTER*4 NAM
      CHARACTER*4 IBUG
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IANS2(*)
      DIMENSION NAM(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      IF(IBUG.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFIL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR,IMIN,IMAX
   52 FORMAT('ICHAR,IMIN,IMAX = ',A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWID
   53 FORMAT('IWID = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IANS2(I),I=1,IWID)
   54 FORMAT('IANS2(.)--',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUG,IERROR
   55 FORMAT('IBUG,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ****************************************
C               **  STEP 1--                          **
C               **  ZERO-OUT AND BLANK-OUT            **
C               **  THE OUTPUT VARIABLES AND VECTOR.  **
C               ****************************************
C
      LOCCHA=IMIN-1
      NPACKC=0
C
      DO1110J=1,10
      NAM(J)=' '
 1110 CONTINUE
C
C               *******************************************
C               **  STEP 2--                             **
C               **  SEARCH FOR THE TARGET CHARACTER;     **
C               **  DETERMINE ITS LOCATION IN IANS2(.);  **
C               **  PLACE THE LOCATION VALUE IN LOCCHA.  **
C               *******************************************
C
      IF(ICHAR.EQ.'END')GOTO1126
      IF(IMAX.LE.0)GOTO1190
      IF(IMIN.GT.IMAX)GOTO1190
      DO1120I=IMIN,IMAX
      I2=I
      IF(IBUG.EQ.'ON')WRITE(ICOUT,1111)I,IANS2(I),ICHAR
 1111 FORMAT('I,IANS2(I),ICHAR = ',I6,A6,A6)
      IF(IBUG.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IANS2(I).EQ.ICHAR)GOTO1125
 1120 CONTINUE
      GOTO1190
 1125 CONTINUE
      LOCCHA=I2
      GOTO1129
 1126 CONTINUE
      LOCCHA=IMAX+1
      GOTO1129
 1129 CONTINUE
C
C               *************************************************
C               **  STEP 3--                                   **
C               **  EXTRACT THE NAME BETWEEN LOCATION IMIN     **
C               **  AND THE LOCATION OF THE TARGET CHARACTER.  **
C               **  PACK THE NAME INTO NAM(.)                  **
C               **  COMPUTE NPACKC = THE NUMBER OF PACKED WORDS**
C               **  IN NAM(.) NEEDED FOR THE NAME.             **
C               *************************************************
C
      NUMCH=0
      IMAX2=LOCCHA-1
      IF(IMAX2.LE.0)GOTO1190
      IF(IMIN.GT.IMAX2)GOTO1190
      DO1130I=IMIN,IMAX2
CCCCC J=((I-IMIN)/NUMBPC)+1
      J=((I-IMIN)/NUMCPW)+1
      IF(IANS2(I).EQ.' ')GOTO1130
      NUMCH=NUMCH+1
      ISTAR3=(NUMBPC*(NUMCH-1)) - (NUMBPW*(J-1))
      ISTAR3=IABS(ISTAR3)
      CALL DPCHEX(0,NUMBPC,IANS2(I),ISTAR3,NUMBPC,NAM(J))
 1130 CONTINUE
      NPACKC=J
 1139 CONTINUE
C
 1190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUG.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFIL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICHAR,IMIN,IMAX
 9012 FORMAT('ICHAR,IMIN,IMAX = ',A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IWID
 9013 FORMAT('IWID = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(IANS2(I),I=1,IWID)
 9014 FORMAT('IANS2(.)--',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IBUG,IERROR
 9015 FORMAT('IBUG,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)LOCCHA,NPACKC
 9016 FORMAT('LOCCHA,NPACKC = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)(NAM(I),I=1,10)
 9017 FORMAT('NAM(.)--',10A6)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFILL(IHARG,NUMARG,
     1IDEFFI,
     1ITEXFI,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FILL SWITCH (ON OR OFF) FOR
C              TEXT SCRIPT AND OTHER DIAGRAMMATIC FIGURES
C              ON A PLOT.
C              THE FILL SWITCH WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXFI.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFFI
C                     --IBUGD2
C     OUTPUT ARGUMENTS--ITEXFI
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFFI
      CHARACTER*4 ITEXFI
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFILL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFFI
   53 FORMAT('IDEFFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ************************************
C               **  TREAT THE FILL          CASE  **
C               ************************************
C
      IF(NUMARG.LE.0)GOTO1161
      IF(IHARG(NUMARG).EQ.'ON')GOTO1161
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1162
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      GOTO1170
C
 1161 CONTINUE
      ITEXFI='ON'
      GOTO1180
C
 1162 CONTINUE
      ITEXFI='OFF'
      GOTO1180
C
 1165 CONTINUE
      ITEXFI=IDEFFI
      GOTO1180
C
 1170 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1171)
 1171 FORMAT('***** ERROR IN DPFILL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('      ILLEGAL ENTRY FOR FILL ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)
 1173 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)
 1174 FORMAT('      SUPPOSE THE THE ANALYST WISHES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1175)
 1175 FORMAT('      TO HAVE ALL TEXT AND FIGURES FILLED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1177)
 1177 FORMAT('      THEN ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1178)
 1178 FORMAT('           FILL ON ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1179)
 1179 FORMAT('           FILL ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE FILL (FOR TEXT AND FIGURES) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ITEXFI
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      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 DPFILL')
      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)IDEFFI,ITEXFI
 9013 FORMAT('IDEFFI,ITEXFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFIMA(PXMIN,PYMIN,PXMAX,PYMAX,
     1ICASPL,ICAS3D,
     1IMARCO)
C
C     PURPOSE--FILL  THE MARGIN REGION ON THE SCREEN
C              (THE REGION OUTSIDE THE FRAME LINES).
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --FEBRUARY  1988.  STAR PLOT
C     UPDATED         --JUNE      1988.  CALL TO GRFIRE
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO GRFIRE (ALAN)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 IMARCO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLB
      CHARACTER*4 ICOLP
C
      CHARACTER*4 ICOL
C
      CHARACTER*4 ICASE
C
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
      CHARACTER*4 IPATT2
C
      DIMENSION PX(10)
      DIMENSION PY(10)
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
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'FIMA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFIMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)PXMIN,PYMIN,PXMAX,PYMAX
   52 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICAS3D
   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMARCO
   54 FORMAT('IMARCO = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IPATT2='SOLI'
C
      IF(ICASPL.EQ.'PIEC')GOTO9000
      IF(ICASPL.EQ.'STAR')GOTO9000
      IF(ICAS3D.EQ.'ON')GOTO9000
C
C               **********************************
C               **  STEP 0--                    **
C               **  COPY OVER THE MARGIN COLOR  **
C               **********************************
C
      ICASE='REGI'
      IFIG='BOX'
      IPATT='SOLI'
      IF(IGCOLO.EQ.'OFF')IPATT='EMPT'
      PTHICK=0.0
      PXGAP=0.0
      PYGAP=0.0
      ICOLB=IMARCO
      ICOLP=IMARCO
C
C               **********************************************
C               **  STEP 1--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE FILL COLOR                       **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      ICOL=ICOLB
      CALL GRTRCO(ICASE,ICOL,JCOL)
      JCOLB=JCOL
C
C               *******************************
C               **  STEP 2--                 **
C               **  SET THE FILL   COLOR     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSECO(ICASE,ICOL,JCOL)
C
C               **********************************************
C               **  STEP 3--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE FILL PATTERN                     **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRPA(ICASE,IPATT,PXGAP,PYGAP,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2)
C
C               *******************************
C               **  STEP 4--                 **
C               **  SET THE FILL PATTERN     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEPA(ICASE,IPATT,PXGAP,PYGAP,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2)
C
C               **********************************************
C               **  STEP 5--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE PATTERN COLOR                    **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      ICOL=ICOLP
      CALL GRTRCO(ICASE,ICOL,JCOL)
      JCOLP=JCOL
C
C               *******************************
C               **  STEP 6--                 **
C               **  SET THE PATTERN COLOR    **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSECO(ICASE,ICOL,JCOL)
C
C               **********************************************
C               **  STEP 7--                                **
C               **  TRANSLATE THE  DESIRED                  **
C               **  LINE THICKNESS (OF THE PATTERN)         **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRTH(ICASE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 8--                 **
C               **  SET THE LINE THICKNESS   **
C               **  (OF THE PATTERN)         **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSETH(ICASE,PTHICK,JTHICK,PTHIC2)
C
C               ***********************************
C               **  STEP 11--                    **
C               **  FILL  THE REGION             **
C               **  BELOW THE BOTTOM FRAME LINE  **
C               ***********************************
C
      PX(1)=0.0
      PY(1)=0.0
      PX(2)=100.0
      PY(2)=0.0
      PX(3)=100.0
      PY(3)=PYMIN
      PX(4)=0.0
      PY(4)=PYMIN
      NP=4
      CALL GRFIRE(PX,PY,NP,IFIG,
     1IPATT,JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2,
     1PTHICK,JTHICK,PTHIC2,
     1ICOLB,JCOLB,ICOLP,JCOLP,
     1IPATT2)
C
C               ********************************************
C               **  STEP 12--                             **
C               **  FILL  THE REGION                      **
C               **  TO THE RIGHT OF THE RIGHT FRAME LINE  **
C               ********************************************
C
      PX(1)=PXMAX
      PY(1)=PYMIN
      PX(2)=100.0
      PY(2)=PYMIN
      PX(3)=100.0
      PY(3)=100.0
      PX(4)=PXMAX
      PY(4)=100.0
      NP=4
      CALL GRFIRE(PX,PY,NP,IFIG,
     1IPATT,JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2,
     1PTHICK,JTHICK,PTHIC2,
     1ICOLB,JCOLB,ICOLP,JCOLP,
     1IPATT2)
C
C               ********************************
C               **  STEP 13--                 **
C               **  FILL  THE REGION          **
C               **  ABOVE THE TOP FRAME LINE  **
C               ********************************
C
      PX(1)=0.0
      PY(1)=PYMAX
      PX(2)=PXMAX
      PY(2)=PYMAX
      PX(3)=PXMAX
      PY(3)=100.0
      PX(4)=0.0
      PY(4)=100.0
      NP=4
      CALL GRFIRE(PX,PY,NP,IFIG,
     1IPATT,JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2,
     1PTHICK,JTHICK,PTHIC2,
     1ICOLB,JCOLB,ICOLP,JCOLP,
     1IPATT2)
C
C               ******************************************
C               **  STEP 14--                           **
C               **  FILL  THE REGION                    **
C               **  TO THE LEFT OF THE LEFT FRAME LINE  **
C               ******************************************
C
      PX(1)=0.0
      PY(1)=PYMIN
      PX(2)=PXMIN
      PY(2)=PYMIN
      PX(3)=PXMIN
      PY(3)=PYMAX
      PX(4)=0.0
      PY(4)=PYMAX
      NP=4
      CALL GRFIRE(PX,PY,NP,IFIG,
     1IPATT,JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2,
     1PTHICK,JTHICK,PTHIC2,
     1ICOLB,JCOLB,ICOLP,JCOLP,
     1IPATT2)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'FIMA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFIMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)PXMIN,PYMIN,PXMAX,PYMAX
 9012 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMARCO
 9014 FORMAT('IMARCO = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFIG,IPATT,ICOLB,ICOLP
 9015 FORMAT('IFIG,IPATT,ICOLB,ICOLP = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFIPW(IHARG,IARGT,ARG,NUMARG,DEFFPW,
     1FITPOW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE POWER IN THE FIT CRITERION
C              IN THE FIT COMMAND (AND THE PRE-FIT COMMAND).
C              THE SPECIFIED FIT POWER VALUE WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE FITPOW.
C     NOTE--POWER = 2 YIELDS THE LEAST SQUARES CRITERION.
C         --POWER = 1 YIELDS THE L1 CRITERION.
C         --POWER = INFINITY YIELDS THE MINIMAX CRITERION.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFFPW (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--FITPOW (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--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.2.AND.IHARG(2).EQ.'=')GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'POWE')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'POWE')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 DPFIPW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR FIT POWER ',
     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 WILL BE CARRYING OUT  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      A FIT , ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AND SUPPOSE THE ANALYST WISHES TO USE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      POWER OF 1.5 IN THE FIT CRITERION; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      FIT POWER 1.5 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFFPW
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      FITPOW=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)FITPOW
 1181 FORMAT('THE FIT POWER HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
     1IPATT2)
C  ABOVE LINE ADDED SEPTEMBER, 1987
C  CONTAINS THE PATTERN FOR THE LINE (I.E., SOLID DASH, ETC.)
C
C
C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
C              FILL THE REGION
C              DEFINED BY THE VERTICES AS GIVEN
C              IN THE PX(.) AND PY(.) VECTORS.
C              THIS REGION HAS SPECIFIED FILL PATTERN,
C              BACKGROUND COLOR, PATTERN LINE THICKNESS,
C              PATTERN LINE GAPCING, AND PATTERN COLOR.
C
C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
C           STANDARDIZED (0.0 TO 100.0) UNITS.
C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
C           (BUT NP SHOULD ALWAYS = 2 FOR THIS SUBROUTINE).
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY   1989.  ADDED PARAMETER TO CALL LIST (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO GRFIRE (ALAN)
C     UPDATED         --JANUARY   1989.  BUGS FOR BAR PLOT COMMAND (ALAN)
C     UPDATED         --MARCH     1990.  MOVE CALL TO SEPA BEFORE COLOR
C                                        ROUTINES.  EITHER SET PATTERN
C                                        OR FILL COLOR, BUT NOT BOTH (PATTERN
C                                        COLOR WAS OVER-RIDING FILL COLOR)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
C
      CHARACTER*4 ICASE
C
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
      CHARACTER*4 IPATT2
C
      DIMENSION PX(*)
      DIMENSION PY(*)
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
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'FIRE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFIRE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NP
   54 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NP
      WRITE(ICOUT,56)PX(I),PY(I)
   56 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,61)IFIG
   61 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IPATT
   62 FORMAT('IPATT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)PTHICK
   63 FORMAT('PTHICK = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)PXGAP,PYGAP
   64 FORMAT('PXGAP,PYGAP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)ICOLF
   65 FORMAT('ICOLF = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICOLP
   66 FORMAT('ICOLP = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      ICASE='REGI'
C  FOLLOWING BLOCK MOVED MARCH, 1990.  PATTERN COLOR WAS
C  OVERRIDING FILL COLOR.  DETERMINE WHICH ONE TO CALL
C  (EITHER PATTERN OR FILL, BUT NOT BOTH)
C
C               **********************************************
C               **  STEP X--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE FILL PATTERN                     **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRPA(ICASE,IPATT,PXGAP,PYGAP,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2)
C
C               *******************************
C               **  STEP X--                 **
C               **  SET THE FILL PATTERN     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEPA(ICASE,IPATT,PXGAP,PYGAP,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2)
C
      IF(IPATT.EQ.'SOLI')GOTO1099
      IF(IPATT.EQ.'FILL')GOTO1099
      GOTO1199
 1099 CONTINUE
C
C               **********************************************
C               **  STEP 1--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE FILL COLOR                       **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      ICOL=ICOLF
      CALL GRTRCO(ICASE,ICOL,JCOL)
      JCOLF=JCOL
C
C               *******************************
C               **  STEP 2--                 **
C               **  SET THE FILL   COLOR     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSECO(ICASE,ICOL,JCOL)
C  FOLLOWING LINE ADDED MARCH 1990.
      GOTO1999
C
C               **********************************************
C               **  STEP 3--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE FILL PATTERN                     **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
CCCCC CALL GRTRPA(ICASE,IPATT,PXGAP,PYGAP,
CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2)
C
C               *******************************
C               **  STEP 4--                 **
C               **  SET THE FILL PATTERN     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
CCCCC CALL GRSEPA(ICASE,IPATT,PXGAP,PYGAP,
CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2)
C
C               **********************************************
C               **  STEP 5--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE PATTERN COLOR                    **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
CCCCC FOLLOWING LINE ADDED MARCH 1990.
 1199 CONTINUE
      ICOL=ICOLP
      CALL GRTRCO(ICASE,ICOL,JCOL)
      JCOLP=JCOL
C
C               *******************************
C               **  STEP 6--                 **
C               **  SET THE PATTERN COLOR    **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSECO(ICASE,ICOL,JCOL)
CCCCC FOLLOWING LINE ADDED MARCH 1990.
 1999 CONTINUE
C
C               **********************************************
C               **  STEP 7--                                **
C               **  TRANSLATE THE  DESIRED                  **
C               **  LINE THICKNESS (OF THE PATTERN)         **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRTH(ICASE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 8--                 **
C               **  SET THE LINE THICKNESS   **
C               **  (OF THE PATTERN)         **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSETH(ICASE,PTHICK,JTHICK,PTHIC2)
C
C               *********************
C               **  STEP 11--      **
C               **  FILL  THE BOX  **
C               *********************
C
      CALL GRFIRE(PX,PY,NP,IFIG,
     1IPATT,JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXGAP2,PYGAP2,
     1PTHICK,JTHICK,PTHIC2,
     1ICOLF,JCOLF,ICOLP,JCOLP,
     1IPATT2)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'FIRE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFIRE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)PX(I),PY(I)
 9016 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)IFIG
 9021 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IPATT,JPATT
 9022 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)PTHICK,JTHICK,PTHIC2
 9023 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)PXGAP,PYGAP
 9024 FORMAT('PXGAP,PYGAP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)ICOLF,JCOLF
 9025 FORMAT('ICOLF,JCOLF = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)ICOLP,JCOLP
 9026 FORMAT('ICOLP,JCOLP = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFISD(IHARG,IARGT,ARG,NUMARG,DEFFSD,
     1FITSD,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LOWER BOUND FOR THE FIT STANDARD DEVIATION.
C              THE RESIDUAL STANDARD DEVIATION AFTER EACH
C              ITERATION OF A FIT WILL BE COMPARED
C              TO THE SPECIFIED FIT STANDARD DEVIATION.
C              THE SPECIFIED FIT STANDARD DEVIATION VALUE WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE FITSD.
C              THE RESIDUAL STANDARD DEVIATION WILL BE
C              COMPARED TO THE FIT STANDARD DEVIATION VALUE.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFFSD (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--FITSD  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--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.3.AND.IHARG(3).EQ.'=')GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'DEVI')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 DPFISD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR FIT STANDARD DEVIATION ',
     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 WILL BE CARRYING OUT  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      A NON-LINEAR FIT , ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AND SUPPOSE THE ANALYST WISHES TO TERMINATE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THE FIT ITERATIONS WHENEVER THE RESIDUAL ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      STANDARD DEVIATION REACHES .0001 OR SMALLER; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      FIT STANDARD DEVIATION .0001 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFFSD
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      FITSD=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)FITSD
 1181 FORMAT('THE FIT STANDARD DEVIATION HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPFITH(IHARG,IARGT,ARG,NUMARG,PDEFFT,MAXFIL,PFILTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FILL THICKNESSES.
C              THESE ARE LOCATED IN THE VECTOR PFILTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEFFT
C                     --MAXFIL
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PFILTH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PFILTH(*)
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
      NUMFIL=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFITH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXFIL,NUMFIL
   53 FORMAT('MAXFIL,NUMFIL = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDEFFT
   55 FORMAT('PDEFFT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PFILTH(1)
   70 FORMAT('PFILTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PFILTH(I)
   76 FORMAT('I,PFILTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=PDEFFT
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMFIL=1
      PFILTH(1)=PDEFFT
      GOTO1270
C
 1220 CONTINUE
      NUMFIL=NUMARG-1
      IF(NUMFIL.GT.MAXFIL)NUMFIL=MAXFIL
      DO1225I=1,NUMFIL
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFFT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFFT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFFT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFFT
      PFILTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMFIL
      WRITE(ICOUT,1276)I,PFILTH(I)
 1276 FORMAT('FILL THICKNESS ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMFIL=MAXFIL
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFFT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFFT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFFT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFFT
      DO1315I=1,NUMFIL
      PFILTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PFILTH(I)
 1316 FORMAT('ALL FILL THICKNESSES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFITH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXFIL,NUMFIL
 9013 FORMAT('MAXFIL,NUMFIL = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDEFFT
 9015 FORMAT('PDEFFT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PFILTH(1)
 9030 FORMAT('PFILTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PFILTH(I)
 9036 FORMAT('I,PFILTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFIWI(IHARG,IARGT,ARG,NUMARG,DEFFW,
     1FILWID,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE WIDTH (USUALLY INTEGER) OF THE FILTER
C              FOR A SMOOTHING OPERATION
C              FOR USE IN THE SMOOTH COMMAND.
C              THE SPECIFIED WIDTH WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE FILWID.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFFW  (A FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--FILWID (A FLOATING POINT INTEGER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY      1981.
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
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'WIDT')GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPFIWI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR FILTER WIDTH ',
     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 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      TO SET THE FILTER WIDTH = 7 OBSERVATIONS  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      FOR SOME SMOOTHING OPERATION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THEN AN ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      FILTER WIDTH 7 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFFW
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      FILWID=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)FILWID
 1181 FORMAT('THE FILTER WIDTH HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPFLTE(YTEMP,XTEMP,MAXNXT,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT F TEST FOR SHIFT IN LOCATION
C     EXAMPLE--F LOCATION TEST Y X
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/9
C     ORIGINAL VERSION--SEPTEMBER 1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
CCCCC MAY 1995.  ADD FOLLOWING DECLARATIONS
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION YMEAN(MAXOBV)
      DIMENSION YBARIV(MAXOBV)
      DIMENSION DTAG(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE(GARBAG(IGARB1),YBARIV(1))
      EQUIVALENCE(GARBAG(IGARB2),DTAG(1))
      EQUIVALENCE(GARBAG(IGARB3),YMEAN(1))
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPFL'
      ISUBN2='TE  '
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 F LOCATION TEST CASE  **
C               **************************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFLTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPFLTE--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR F LOCATION TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,IWIDTH)
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPFLTE--')
      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 F LOCATION TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS SHOULD ALSO BE A VARIABLE)  **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2141)
 2141    FORMAT('***** ERROR IN DPFLTE--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2142)
 2142    FORMAT('      FOR F LOCATION TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2145)
 2145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2146)
 2146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2147)
 2147    FORMAT('      ARGUMENT 2 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2148)
 2148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,2150)(IANS(I),I=1,IWIDTH)
 2150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
 2190 CONTINUE
C
C               ********************************************************
C               **  STEP 22--                                         **
C               **  IF ARGUMENT 2 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2)  **
C               **  FOR ARGUMENT 2 IS THE SAME AS ARGUMENT 1.     **
C               ********************************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.NE.'V')GOTO2290
      IF(N2.EQ.N1)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPFLTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (FOR VARIABLE 2 OF F LOCATION TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      MUST BE THE SAME AS VARIABLE 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)N1,N2
 2216 FORMAT('      N1 = ',I8,' N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2219)
 2219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2220)(IANS(I),I=1,IWIDTH)
 2220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPFLTE--')
      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 F LOCATION TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH)
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 42--                                **
C               **  TEMPORARILY FORM THE VARIABLE X(.)       **
C               **  WHICH WILL HOLD THE DATA FROM SAMPLE 2.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE2.NE.'V')GOTO4290
C
      ISTEPN='42'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4210
      IF(ICASEQ.EQ.'SUBS')GOTO4220
      IF(ICASEQ.EQ.'FOR')GOTO4230
C
 4210 CONTINUE
      DO4215I=1,N2
      ISUB(I)=1
 4215 CONTINUE
      NQ=N2
      GOTO4250
C
 4220 CONTINUE
      NIOLD=N2
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4250
C
 4230 CONTINUE
      NIOLD=N2
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4250
C
 4250 CONTINUE
      IF(NQ.GE.MINN2)GOTO4260
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4251)
 4251 FORMAT('***** ERROR IN DPFLTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4252)
 4252 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4253)IH21,IH22
 4253 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4254)
 4254 FORMAT('      (FOR WHICH F LOCATION TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4255)
 4255 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4256)MINN2
 4256 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4257)NQ
 4257 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4258)
 4258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH)
 4259 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4260 CONTINUE
      J=0
      IMAX=N2
      IF(NQ.LT.N2)IMAX=NQ
      DO4270I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4270
      J=J+1
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
 4270 CONTINUE
      NS2=J
C
 4290 CONTINUE
C
C               *********************************
C               **  STEP 52--                  **
C               **  DO F LOCATION 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 DPFLTE, AS WE ARE ABOUT TO CALL DPFLT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      DO5217I=1,NS1
      WRITE(ICOUT,5218)I,Y(I)
 5218 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5217 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPFLT2(Y,X,NS1,
     1YTEMP,XTEMP,YMEAN,YBARIV,DTAG,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
     1IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPLT'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF0 '
      VALUE0=CUT0
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF50'
      VALUE0=CUT50
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF75'
      VALUE0=CUT75
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF90'
      VALUE0=CUT90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF95'
      VALUE0=CUT95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF99'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='F999'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFLTE--')
      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 DPFLT2(Y,TAG,N,
     1YTEMP,XTEMP,YMEAN,YBARIV,DTAG,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT AN F TEST FOR SHIFT IN LOCATION
C     EXAMPLE--F LOCATION'S TEST Y TAG
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/9
C     ORIGINAL VERSION--SEPTEMBER 1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DOUBLE PRECISION DSUM1
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION DTAG(*)
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
      DIMENSION YMEAN(*)
      DIMENSION YBARIV(*)
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='DPBT'
      ISUBN2='E2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPFLT2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,65)N
   65 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO66I=1,N
      WRITE(ICOUT,67)I,TAG(I)
   67 FORMAT('I,TAG(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPFLT2--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 DPFLT2--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 DPFLT2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(N.GE.1)GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPFLT2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 2 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1212)N
 1212 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1219 CONTINUE
C
      IF(N.EQ.1)GOTO1220
      GOTO1229
 1220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** NOTE FROM DPFLT2--VARIABLE 2 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1229 CONTINUE
C
      HOLD=TAG(1)
      DO1235I=2,N
      IF(TAG(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM DPFLT2--VARIABLE 2 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
 1290 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR F LOCATION  TEST    **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL DISTIN(TAG,N,IWRITE,DTAG,NUMDIS,IBUGA3,IERROR)
C
      CALL MEAN(Y,N,IWRITE,YBAR,IBUGA3,IERROR)
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,4901)YBAR
 4901   FORMAT('YBAR = ',G15.7)
        CALL DPWRST('XXX','BUG')
        DO4905I=1,N
          WRITE(ICOUT,4906)I,TAG(I),DTAG(I),Y(I)
 4906     FORMAT('I,TAG(I),DTAG(I),Y(I)=',I8,3G15.7)
          CALL DPWRST('XXX','BUG')
 4905   CONTINUE
      ENDIF
C
      DO5200IDIS=1,NUMDIS
         J=0
         DO5300I=1,N
            IF(TAG(I).EQ.DTAG(IDIS))THEN
               J=J+1
               YTEMP(J)=Y(I)
            ENDIF
 5300    CONTINUE
         CALL MEAN(YTEMP,J,IWRITE,YMEAN(IDIS),IBUGA3,IERROR)
         DO5400I=1,N
           IF(TAG(I).EQ.DTAG(IDIS))YBARIV(I)=YMEAN(IDIS)
 5400    CONTINUE
 5200 CONTINUE
C
      IF(IBUGA3.EQ.'ON')THEN
        DO5205I=1,N
          WRITE(ICOUT,5206)I,TAG(I),DTAG(I),YBARIV(I)
 5206     FORMAT('I,TAG(I),DTAG(I),YBARIV(I)=',I8,3G15.7)
          CALL DPWRST('XXX','BUG')
 5205   CONTINUE
      ENDIF
C
      DSUM1=0.D0
      DO6100I=1,N
        DSUM1=DSUM1 + (YBARIV(I)-YBAR)**2
 6100 CONTINUE
      SSQ=SNGL(DSUM1)
      NUMDF=NUMDIS-1
      ANUMMS=SSQ/REAL(NUMDF)
C
      DSUM1=0.D0
      DO6200I=1,N
        DSUM1=DSUM1 + (Y(I)-YBARIV(I))**2
 6200 CONTINUE
      SSQ=SNGL(DSUM1)
      IDENDF=N-NUMDIS
      DENMS=SSQ/REAL(IDENDF)
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,6201)ANUMMS,DENMS
 6201   FORMAT('ANUMMS,DENMS=',2G15.7)
        CALL DPWRST('XXX','BUG')
      ENDIF
C
      STATVA=ANUMMS/DENMS
      CALL FCDF(STATVA,NUMDF,IDENDF,STATCD)
C
      KM1=NUMDIS-1
      NMK=N-NUMDIS
C
      CUT0=0.0
      CALL FPPF(.50,KM1,NMK,CUT50)
      CALL FPPF(.75,KM1,NMK,CUT75)
      CALL FPPF(.90,KM1,NMK,CUT90)
      CALL FPPF(.95,KM1,NMK,CUT95)
      CALL FPPF(.99,KM1,NMK,CUT99)
      CALL FPPF(.999,KM1,NMK,CUT999)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(0.000.LE.STATCD.AND.STATCD.LE.0.950)ICONC2='ACCEPT'
C
C               ******************************
C               **   STEP 42--              **
C               **   WRITE OUT EVERYTHING   **
C               **   FOR F LOCATION'S TEST  **
C               ******************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO7290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7211)
 7211 FORMAT('              F-TEST FOR SHIFT IN LOCATION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7212)
 7212 FORMAT('                 (ASSUMPTION: NORMALITY)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,7222)
 7222 FORMAT('1. STATISTICS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7224)N
 7224 FORMAT(6X,'NUMBER OF OBSERVATIONS    = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7226)NUMDIS
 7226 FORMAT(6X,'NUMBER OF GROUPS          = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7228)STATVA
 7228 FORMAT(6X,'F LOCATION TEST STATISTIC   = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7240)
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
 7240 FORMAT('2. PERCENT POINTS OF THE REFERENCE DISTRIBUTION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7241)
 7241 FORMAT('   FOR F LOCATION TEST STATISTIC')
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,7345)CUT0
 7345 FORMAT(6X,'0          % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7346)CUT50
 7346 FORMAT(6X,'50         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7347)CUT75
 7347 FORMAT(6X,'75         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7348)CUT90
 7348 FORMAT(6X,'90         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7349)CUT95
 7349 FORMAT(6X,'95         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7350)CUT99
 7350 FORMAT(6X,'99         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7351)CUT999
 7351 FORMAT(6X,'99.9       % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7247)100.*STATCD,STATVA
 7247 FORMAT(6X,G15.7,'   % Point:  ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,7261)
 7261 FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
      CALL DPWRST('XXX','WRIT')
      IF(STATVA.LE.CUT95)THEN
        WRITE(ICOUT,7262)
 7262   FORMAT(6X,'THERE IS NO SHIFT IN LOCATION.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7263)
 7263   FORMAT(6X,'THUS: HOMOGENOUS WITH RESPECT TO LOCATION.')
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,7272)
 7272   FORMAT(6X,'THERE IS A SHIFT IN LOCATION.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7273)
 7273   FORMAT(6X,'THUS: NOT HOMOGENOUS WITH RESPECT TO LOCATION.')
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
 7290 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFLT2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I)
 9017 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      WRITE(ICOUT,9025)N
 9025 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9026I=1,N
      WRITE(ICOUT,9027)I,TAG(I)
 9027 FORMAT('I,TAG(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9026 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFONT(IHARG,NUMARG,
     1IDEFFO,
     1ITEXFO,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FONT TYPE FOR
C              TITLE, LABEL, AND LEGEND SCRIPT
C              ON A PLOT.
C              THE FONT FOR THE SCRIPT WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXFO.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFFO
C                     --IBUGD2
C     OUTPUT ARGUMENTS--ITEXFO
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFFO
      CHARACTER*4 ITEXFO
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFONT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFFO
   53 FORMAT('IDEFFO = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ***************************
C               **  TREAT THE FONT CASE  **
C               ***************************
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1120
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1120
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      GOTO1140
C
 1120 CONTINUE
      ITEXFO=IDEFFO
      GOTO1180
C
 1140 CONTINUE
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'SIMP')GOTO1141
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DUPL')GOTO1142
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'TRIP')GOTO1143
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COMP')GOTO1144
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'TRIP'.AND.
     1IHARG(2).EQ.'ITAL')GOTO1145
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'TRII')GOTO1145
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'COMP'.AND.
     1IHARG(2).EQ.'ITAL')GOTO1146
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COMI')GOTO1146
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SIMP'.AND.
     1IHARG(2).EQ.'SCRI')GOTO1147
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'SIMS')GOTO1147
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'COMP'.AND.
     1IHARG(2).EQ.'SCRI')GOTO1148
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COMS')GOTO1148
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TEKT')GOTO1151
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TEK')GOTO1151
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'HEWL'.AND.
     1IHARG(2).EQ.'PACK')GOTO1152
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'HP')GOTO1152
C
 1130 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPFONT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL ENTRY FOR FONT ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)
 1133 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      SUPPOSE THE THE ANALYST WISHES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      TO SET THE FONT TO TRIPLEX ITALIC ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      FOR PLOT TITLES, LABELS, ETC.,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      THEN 2 ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)
 1138 FORMAT('            FONT TRIPLEX ITALIC ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1139)
 1139 FORMAT('            FONT TRII ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1141 CONTINUE
      ITEXFO='SIMP'
      GOTO1180
C
 1142 CONTINUE
      ITEXFO='DUPL'
      GOTO1180
C
 1143 CONTINUE
      ITEXFO='TRIP'
      GOTO1180
C
 1144 CONTINUE
      ITEXFO='COMP'
      GOTO1180
C
 1145 CONTINUE
      ITEXFO='TRII'
      GOTO1180
C
 1146 CONTINUE
      ITEXFO='COMI'
      GOTO1180
C
 1147 CONTINUE
      ITEXFO='SIMS'
      GOTO1180
C
 1148 CONTINUE
      ITEXFO='COMS'
      GOTO1180
C
 1151 CONTINUE
      ITEXFO='TEKT'
      GOTO1180
C
 1152 CONTINUE
      ITEXFO='HEWL'
      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 FONT (FOR PLOT SCRIPT AND TEXT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ITEXFO
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)ITEXFO
 8111 FORMAT('THE CURRENT FONT IS ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IDEFFO
 8112 FORMAT('THE DEFAULT FONT IS ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFONT--')
      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)IDEFFO,ITEXFO
 9013 FORMAT('IDEFFO,ITEXFO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFOR(NIOLD,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
C
C     PURPOSE--DEFINE AN INTEGER 0-1 VECTOR ISUB
C              WHICH WILL BE USED IN OTHER SUBROUTINES
C              FOR EXTRACTING SUBSETS.
C     ALLOWABLE FORMS--FOR XX <  XX
C                      FOR XX <= XX
C                      FOR XX =  XX
C                      FOR XX =  XX XX XX
C                      FOR XX =  XX TO XX
C                      FOR XX >= XX
C                      FOR XX >  XX
C     INPUT  ARGUMENTS--NIOLD  = THE ORIGINAL NUMBER OF
C                                ELEMENTS (ROWS) FOR THE LEFT-SIDE VARIABLE.
C                                (IT MAY BE ZERO).
C     OUTPUT ARGUMENTS--NINEW  = THE NEW NUMBER OF ELEMENTS (ROWS)
C                                FOR THE LEFT-SIDE VARIABLE.
C                                NINEW EQUALS MAX(NIOLD,IROWN)
C                     --IROW1  = THE FIRST ROW TO BE CHANGED.
C                     --IROWN  = THE LAST ROW TO BE CHANGED.
C     NOTE THAT IF THE WORD 'FOR' IS NOT IN THE ARGUMENT LIST,
C     THEN THE OUTPUT PARAMETER WILL BE SET TO NUMARG+1.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY  1978.
C     UPDATED         --JANUARY   1978.
C     UPDATED         --FEBRUARY  1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGQ
      CHARACTER*4 IERROR
C
      CHARACTER*4 MESSAG
      CHARACTER*4 IHWUSE
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
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='DPFO'
      ISUBN2='R   '
C
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      ILOCF=0
      NUMIT=0
      I2=0
C
C               **************************
C               **  TREAT THE FOR CASE  **
C               **************************
C
      IF(IBUGQ.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NIOLD,NINEW,IROW1,IROWN
   52 FORMAT('NIOLD,NINEW,IROW1,IROWN = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NLOCAL,ILOCS,NS
   53 FORMAT('NLOCAL,ILOCS,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGQ,IERROR
   54 FORMAT('IBUGQ,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMARG,NUMNAM,MAXNAM,N,MAXN
   55 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IWIDTH,NLOCAL,ILOCF
   56 FORMAT('IWIDTH,NLOCAL,ILOCF = ',3I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ****************************************************************
C               **  STEP 1--
C               **  INITIALIZE THE SUBSET SIZE (NS) TO MAXN.
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.
C               **  ALSO CHECK THAT THE RELEVANT NUMBER OF OBSERVATIONS (NLOCAL)
C               **  IS POSITIVE.
C               ****************************************************************
C
      ISTEPN='1'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=MAXN
      NS=MAXN
      ILOCF=NUMARG+1
      MINNA=0
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(NLOCAL.GE.1)GOTO190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPFOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)
  113 FORMAT('      (FROM WHICH A SUBSET WAS TO HAVE BEEN ',
     1'EXTRACTED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,114)
  114 FORMAT('      IS 0')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  190 CONTINUE
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  INITIALIZE ALL ELEMENTS IN ISUB(.) TO 1 .  **
C               *************************************************
C
      ISTEPN='2'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO200I=1,NLOCAL
      ISUB(I)=1
  200 CONTINUE
C
C               ************************************************
C               **  STEP 3.1--                                **
C               **  CHECK TO SEE IF HAVE THE 'FOR' CASE.      **
C               **  LOCATE THE POSITION IN THE ARGUMENT LIST  **
C               **  OF THE LAST OCCURRANCE OF THE WORD 'FOR'. **
C               ************************************************
C
      ISTEPN='3.1'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCF=-1
      IF(NUMARG.LE.0)GOTO9000
      DO300J=1,NUMARG
      JP1=J+1
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    '.AND.
     1IHARG(JP1).EQ.'I   '.AND.IHARG2(JP1).EQ.'    '.AND.
     1JP1.LE.NUMARG)GOTO350
      GOTO300
  350 CONTINUE
      ILOCF=J
  300 CONTINUE
      IF(ILOCF.EQ.-1)GOTO360
      GOTO390
  360 CONTINUE
      ILOCF=NUMARG+1
      GOTO9000
  390 CONTINUE
C
C               *************************************************
C               **  STEP 3.2--                                 **
C               **  IF EXISTENT,                               **
C               **  PACK < = INTO <=                           **
C               **  PACK = < INTO =<                           **
C               **  PACK > = INTO >=                           **
C               **  PACK = > INTO =>                           **
C               **  THIS IS BECAUSE = SIGNS ARE AUTOMATICALLY  **
C               **  GIVEN A SPACE IN DPTYPE AND TREATED AS     **
C               **  AS A SEPARATE WORD.                        **
C               **  NOTE THAT NUMARG WILL BE CHANGED.          **
C               *************************************************
C
      ISTEPN='3.2'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL ADJUS2(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
C
C               ***********************************************
C               **  STEP 4--                                 **
C               **  CHECK THAT FOR IS SUCCEEDED BY AT LEAST  **
C               **  3 OTHER ARGUMENTS.                       **
C               ***********************************************
C
      ISTEPN='4'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCF3=ILOCF+3
      IF(ILOCF3.GT.NUMARG)GOTO400
      GOTO480
  400 CONTINUE
      WRITE(ICOUT,401)
  401 FORMAT('***** ERROR IN DPFOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,402)
  402 FORMAT('      THE WORD    FOR    SHOULD HAVE BEEN FOLLOWED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,403)
  403 FORMAT('      BY EXACTLY 3 OR BY EXACTLY 5    WORDS   --')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,404)
  404 FORMAT('      1) A DUMMY VARIABLE NAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,405)
  405 FORMAT('      2) AN EQUAL SIGN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,406)
  406 FORMAT('      3) ONE LIMIT (LOWER OR UPPER) ',
     1'FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,409)
  409 FORMAT('      4) THE INCREMENT FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,410)
  410 FORMAT('      5) THE OTHER LIMIT (UPPER OR LOWER) ',
     1'FOR THE DUMMY VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,421)
  421 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,422)(IANS(I),I=1,IWIDTH)
  422 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  480 CONTINUE
C
C               *************************************
C               **  STEP 5--                       **
C               **  FORM THE 3 INTERNAL VALUES--   **
C               **  START, AINC, AND STOP.         **
C               *************************************
C
      ISTEPN='5'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCF2=ILOCF+2
      ILOCF3=ILOCF+3
      ILOCF4=ILOCF+4
      ILOCF5=ILOCF+5
C
      ILOCA=ILOCF3
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO511
      IF(IARGT(ILOCA).EQ.'WORD')GOTO512
      GOTO570
  511 CONTINUE
      START=ARG(ILOCA)
      IF(IHARG(ILOCF2).EQ.'=   ')GOTO519
      AINC=0.0
      STOP=ARG(ILOCA)
      IF(IHARG(ILOCF2).EQ.'<   ')START=1.0
      IF(IHARG(ILOCF2).EQ.'<   ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'<   ')STOP=ARG(ILOCA)-1.0
      IF(IHARG(ILOCF2).EQ.'<   ')GOTO539
      IF(IHARG(ILOCF2).EQ.'<=  ')START=1.0
      IF(IHARG(ILOCF2).EQ.'<=  ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'<=  ')STOP=ARG(ILOCA)
      IF(IHARG(ILOCF2).EQ.'<=  ')GOTO539
      IF(IHARG(ILOCF2).EQ.'=<  ')START=1.0
      IF(IHARG(ILOCF2).EQ.'=<  ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'=<  ')STOP=ARG(ILOCA)
      IF(IHARG(ILOCF2).EQ.'=<  ')GOTO539
      IF(IHARG(ILOCF2).EQ.'>=  ')START=ARG(ILOCA)
      IF(IHARG(ILOCF2).EQ.'>=  ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'>=  ')STOP=NIOLD
      IF(IHARG(ILOCF2).EQ.'>=  ')GOTO539
      IF(IHARG(ILOCF2).EQ.'=>  ')START=ARG(ILOCA)
      IF(IHARG(ILOCF2).EQ.'=>  ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'=>  ')STOP=NIOLD
      IF(IHARG(ILOCF2).EQ.'=>  ')GOTO539
      IF(IHARG(ILOCF2).EQ.'>   ')START=ARG(ILOCA)+1.0
      IF(IHARG(ILOCF2).EQ.'>   ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'>   ')STOP=NIOLD
      IF(IHARG(ILOCF2).EQ.'>   ')GOTO539
      GOTO519
  512 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      MESSAG='YES'
      IHWUSE='P'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      START=VALUE(ILOC)
      IF(IHARG(ILOCF2).EQ.'=   ')GOTO519
      AINC=0.0
      STOP=VALUE(ILOC)
      IF(IHARG(ILOCF2).EQ.'<   ')START=1.0
      IF(IHARG(ILOCF2).EQ.'<   ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'<   ')STOP=VALUE(ILOC)-1.0
      IF(IHARG(ILOCF2).EQ.'<   ')GOTO539
      IF(IHARG(ILOCF2).EQ.'<=  ')START=1.0
      IF(IHARG(ILOCF2).EQ.'<=  ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'<=  ')STOP=VALUE(ILOC)
      IF(IHARG(ILOCF2).EQ.'<=  ')GOTO539
      IF(IHARG(ILOCF2).EQ.'=<  ')START=1.0
      IF(IHARG(ILOCF2).EQ.'=<  ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'=<  ')STOP=VALUE(ILOC)
      IF(IHARG(ILOCF2).EQ.'=<  ')GOTO539
      IF(IHARG(ILOCF2).EQ.'>=  ')START=VALUE(ILOC)
      IF(IHARG(ILOCF2).EQ.'>=  ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'>=  ')STOP=NIOLD
      IF(IHARG(ILOCF2).EQ.'>=  ')GOTO539
      IF(IHARG(ILOCF2).EQ.'=>  ')START=VALUE(ILOC)
      IF(IHARG(ILOCF2).EQ.'=>  ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'=>  ')STOP=NIOLD
      IF(IHARG(ILOCF2).EQ.'=>  ')GOTO539
      IF(IHARG(ILOCF2).EQ.'>   ')START=VALUE(ILOC)+1.0
      IF(IHARG(ILOCF2).EQ.'>   ')AINC=1.0
      IF(IHARG(ILOCF2).EQ.'>   ')STOP=NIOLD
      IF(IHARG(ILOCF2).EQ.'>   ')GOTO539
  519 CONTINUE
C
      ILOCA=ILOCF4
      IF(ILOCA.GT.NUMARG)GOTO521
      IF(ILOCA.EQ.NUMARG.AND.IHARG(ILOCA).EQ.'AND'.AND.
     1IHARG2(ILOCA).EQ.'    ')GOTO521
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO522
      IF(IARGT(ILOCA).EQ.'WORD'.AND.IHARG(ILOCA).EQ.'TO  ')GOTO523
      IF(IARGT(ILOCA).EQ.'WORD'.AND.IHARG(ILOCA).NE.'TO  ')GOTO524
      GOTO570
  521 CONTINUE
      AINC=0.0
      GOTO529
  522 CONTINUE
      AINC=ARG(ILOCA)
      GOTO529
  523 CONTINUE
      AINC=1.0
      GOTO529
  524 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      MESSAG='YES'
      IHWUSE='P'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AINC=VALUE(ILOC)
      GOTO529
  529 CONTINUE
C
      ILOCA=ILOCF5
      IF(ILOCA.GT.NUMARG)GOTO531
      IF(ILOCA.EQ.NUMARG.AND.IHARG(ILOCA).EQ.'AND'.AND.
     1IHARG2(ILOCA).EQ.'    ')GOTO531
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO532
      IF(IARGT(ILOCA).EQ.'WORD')GOTO533
      GOTO570
  531 CONTINUE
      STOP=START
      GOTO539
  532 CONTINUE
      STOP=ARG(ILOCA)
      GOTO539
  533 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      MESSAG='YES'
      IHWUSE='P'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      STOP=VALUE(ILOC)
      GOTO539
  539 CONTINUE
      GOTO580
C
  570 CONTINUE
      WRITE(ICOUT,571)
  571 FORMAT('***** INTERNAL ERROR IN DPFOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      AN ARGUMENT TYPE WHICH SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,573)
  573 FORMAT('      EITHER A NUMBER OR A WORD, IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,574)IHARG(ILOCA),IHARG2(ILOCA)
  574 FORMAT('      ARGUMENT                  = ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,575)ILOCA
  575 FORMAT('      LOCATION IN ARGUMENT LIST = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,576)IARGT(ILOCA)
  576 FORMAT('      ARGUMENT TYPE             = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,577)
  577 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,578)(IANS(I),I=1,IWIDTH)
  578 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  580 CONTINUE
      IF(START.EQ.STOP)AINC=0.0
      IF(START.LT.STOP.AND.AINC.LT.0.0)AINC=-AINC
      IF(START.GT.STOP.AND.AINC.GT.0.0)AINC=-AINC
C
C               *****************************************************
C               **  STEP 6--                                       **
C               **  FORM THE ISUB(.) VECTOR;                       **
C               **  DETERMINE ALSO--                               **
C               **  THE FIRST ROW CHANGED (IROW1),                 **
C               **  THE ROW INCREMENT (IROWIN),                    **
C               **  THE LAST  ROW CHANGED (IROWN),                 **
C               **  THE NUMBER OF ROWS CHANGED (NS),               **
C               **  AND THE OUTPUT NUMBER OF ROWS (NINEW).         **
C               **  (THAT IS, THE SUBSET SAMPLE SIZE).             **
C               *****************************************************
C
      ISTEPN='6'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO600I=1,MAXN
      ISUB(I)=0
  600 CONTINUE
C
      IF(AINC.EQ.0.0)NUMIT=1
      IF(AINC.NE.0.0)NUMIT=(STOP-START)/AINC
      IF(NUMIT.LT.0)NUMIT=-NUMIT
      NUMIT=NUMIT+1
C
      L2=0
      DO620I=1,NUMIT
      I2=I
      I2M1=I2-1
      AI=I
      RESULT=START+(AI-1.0)*AINC
      IF(I.EQ.1)GOTO622
      IF(AINC.EQ.0.0)GOTO670
      IF(START.EQ.STOP)GOTO670
      IF(START.LT.STOP.AND.RESULT.GT.STOP)GOTO670
      IF(START.GT.STOP.AND.RESULT.LT.STOP)GOTO670
  622 CONTINUE
      L2=L2+1
C
      IF(L2.LE.MAXN)GOTO639
      WRITE(ICOUT,632)
  632 FORMAT('***** ERROR IN DPFOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,633)
  633 FORMAT('      THE NUMBER OF GENERATED POINTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,634)MAXN
  634 FORMAT('      HAS JUST EXCEEDED ',I8,' *****')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,635)
  635 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,636)(IANS(K),K=1,IWIDTH)
  636 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  639 CONTINUE
C
      XTEMP=RESULT
      ITEMP=XTEMP+0.5
      IF(ITEMP.LE.MAXN)GOTO649
      WRITE(ICOUT,642)
  642 FORMAT('***** ERROR IN DPFOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,643)
  643 FORMAT('      A REFERENCED ROW NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,644)MAXN
  644 FORMAT('      HAS JUST EXCEEDED ',I8,' *****')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,645)
  645 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,646)(IANS(K),K=1,IWIDTH)
  646 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  649 CONTINUE
C
      IF(ITEMP.GE.1)GOTO659
      WRITE(ICOUT,652)
  652 FORMAT('***** ERROR IN DPFOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,653)
  653 FORMAT('      A REFERENCED ROW NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,654)
  654 FORMAT('      IS SMALLER THAN 1    .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,655)
  655 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,656)(IANS(K),K=1,IWIDTH)
  656 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  659 CONTINUE
C
      ISUB(ITEMP)=1.0
      IF(I.EQ.1)IROW1=ITEMP
      IROWN=ITEMP
  620 CONTINUE
C
      NS=I2
      GOTO690
  670 CONTINUE
      NS=I2M1
  690 CONTINUE
      NINEW=NIOLD
      IF(IROWN.GT.NIOLD)NINEW=IROWN
      IROWIN=AINC+0.5
C
C               *************************************************
C               **  STEP 7--                                   **
C               **  WRITE OUT A MESSAGE INDICATING             **
C               **  THE FIRST ROW CHANGED (IROW1),             **
C               **  THE ROW INCREMENT (IROWIN),                **
C               **  THE LAST  ROW CHANGED (IROWN),             **
C               **  THE INPUT NUMBER OF ROWS (NIOLD),          **
C               **  THE NUMBER OF ROWS CHANGED (NS),           **
C               **  AND THE OUTPUT NUMBER OF ROWS (NINEW).     **
C               **  (THAT IS, THE SUBSET SAMPLE SIZE).         **
C               **  ALSO, CHECK THAT NS IS POSITIVE.           **
C               *************************************************
C
      ISTEPN='7'
      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFEEDB.EQ.'OFF')GOTO709
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,701)
  701 FORMAT('***** NOTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,702)IROW1
  702 FORMAT('      ROW START      = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,703)IROWIN
  703 FORMAT('      ROW INCREMENT  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,704)IROWN
  704 FORMAT('      ROW STOP       = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,705)NIOLD
  705 FORMAT('      INPUT  NUMBER OF ROWS   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,706)NS
  706 FORMAT('      NUMBER OF ROWS AFFECTED = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,707)NINEW
  707 FORMAT('      OUTPUT NUMBER OF ROWS   = ',I8)
      CALL DPWRST('XXX','BUG ')
  709 CONTINUE
C
CCCCC IF(NS.GE.1)GOTO790
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,711)
CC711 FORMAT('***** ERROR IN DPFOR--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,712)
CC712 FORMAT('      THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
C
  790 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGQ.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NIOLD,NINEW,IROW1,IROWN
 9012 FORMAT('NIOLD,NINEW,IROW1,IROWN = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NLOCAL,ILOCS,NS
 9013 FORMAT('NLOCAL,ILOCS,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IBUGQ,IERROR
 9014 FORMAT('IBUGQ,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMARG,NUMNAM,MAXNAM,N,MAXN
 9015 FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IWIDTH,NLOCAL,ILOCF
 9016 FORMAT('IWIDTH,NLOCAL,ILOCF = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,NIOLD
      WRITE(ICOUT,9021)I,ISUB(I)
 9021 FORMAT('I,ISUB(I) = ',2I8)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFRAC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,ICONT,
     1IANGLU,ISEED,
CCCCC JULY 1993.  ADD FOLLOWING LINE.
     1IFRAIT,IFRATY,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A FRACTAL PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/1
C     ORIGINAL VERSION--DECEMBER  1988.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --APRIL     1992. MAXCP7 AND MAXCP... MISTAKES
C     UPDATED         --JULY      1993. ADD FRACTAL ITERATIONS AND 
C                                       FRACTAL TYPE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH1
      CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC JULY 1993.  ADD FOLLOWING LINE.
      CHARACTER*4 IFRATY
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Z1(MAXOBV)
      DIMENSION Z2(MAXOBV)
      DIMENSION Z3(MAXOBV)
      DIMENSION Z4(MAXOBV)
      DIMENSION Z5(MAXOBV)
      DIMENSION Z6(MAXOBV)
      DIMENSION Z7(MAXOBV)
C
      DIMENSION W(MAXOBV)
      DIMENSION U(MAXPOP)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Z1(1))
      EQUIVALENCE (GARBAG(IGARB2),Z2(1))
      EQUIVALENCE (GARBAG(IGARB3),Z3(1))
      EQUIVALENCE (GARBAG(IGARB4),Z4(1))
      EQUIVALENCE (GARBAG(IGARB5),Z5(1))
      EQUIVALENCE (GARBAG(IGARB6),Z6(1))
      EQUIVALENCE (GARBAG(IGARB7),Z7(1))
      EQUIVALENCE (GARBAG(IGARB7),W(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='DPFR'
      ISUBN2='AC  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
C               *************************************
C               **  TREAT THE FRACTAL PLOT CASE    **
C               *************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'FRAC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFRAC--')
      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,ICONT
   53 FORMAT('ICASPL,IAND1,IAND2,ICONT = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IANGLU,ISEED,MAXPOP
   54 FORMAT('IANGLU,ISEED,MAXPOP = ',A4,2I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FRAC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='FRAC'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO1110
      GOTO1180
C
 1110 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      GOTO1190
C
 1190 CONTINUE
C
C               ***********************************************************
C               **  STEP 12--                                            **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FRAC')
     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 SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1380
      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
C
 1380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('***** INTERNAL ERROR IN DPFRAC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)
 1382 FORMAT('      AT BRANCH POINT 1381--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1383)
 1383 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1384)
 1384 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1385)NUMARG
 1385 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1386)
 1386 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1387)(IANS(I),I=1,IWIDTH)
 1387 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO1395
      WRITE(ICOUT,1391)NUMARG,ILOCQ,ICASEQ
 1391 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               **************************************************
C               **  STEP 14--                                   **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FRAC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.GE.6.AND.NUMV2.LE.7)GOTO1490
C
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPFRAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      ILLEGAL SYNTAX--THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      TO BE INCLUDED AS ARGUMENTS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
 1414 FORMAT('      IN A FRACTAL PLOT COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      MUST BE AT LEAST 6 AND AT MOST 7;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)NUMV2
 1416 FORMAT('      SUCH WAS NOT THE CASE HERE.  NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1417)
 1417 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1418)(IANS(I),I=1,IWIDTH)
 1418 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ***************************************
C               **  STEP 15--                        **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               ***************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FRAC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1500I=1,NUMV2
      IH1=IHARG(I)
      IH2=IHARG2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH1,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(I.EQ.1)ICOL1=IVALUE(ILOCV)
      IF(I.EQ.2)ICOL2=IVALUE(ILOCV)
      IF(I.EQ.3)ICOL3=IVALUE(ILOCV)
      IF(I.EQ.4)ICOL4=IVALUE(ILOCV)
      IF(I.EQ.5)ICOL5=IVALUE(ILOCV)
      IF(I.EQ.6)ICOL6=IVALUE(ILOCV)
      IF(I.EQ.7)ICOL7=IVALUE(ILOCV)
      IF(I.EQ.1)N1=IN(ILOCV)
      IF(I.EQ.2)N2=IN(ILOCV)
      IF(I.EQ.3)N3=IN(ILOCV)
      IF(I.EQ.4)N4=IN(ILOCV)
      IF(I.EQ.5)N5=IN(ILOCV)
      IF(I.EQ.6)N6=IN(ILOCV)
      IF(I.EQ.7)N7=IN(ILOCV)
 1500 CONTINUE
C
C               **************************************************
C               **  STEP 16--                                   **
C               **  CHECK THAT ALL ARGUMENTS                    **
C               **  HAVE THE SAME NUMBER OF OBSERVATIONS.       **
C               **************************************************
C
      ISTEPN='16'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FRAC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N2.NE.N1)GOTO1610
      IF(NUMV2.LE.2)GOTO1690
      IF(N3.NE.N1)GOTO1610
      IF(NUMV2.LE.3)GOTO1690
      IF(N4.NE.N1)GOTO1610
      IF(NUMV2.LE.4)GOTO1690
      IF(N5.NE.N1)GOTO1610
      IF(NUMV2.LE.5)GOTO1690
      IF(N6.NE.N1)GOTO1610
      IF(NUMV2.LE.6)GOTO1690
      IF(N7.NE.N1)GOTO1610
      GOTO1690
C
 1610 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1611)
 1611 FORMAT('***** ERROR IN DPFRAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1612)
 1612 FORMAT('      FOR A FRACTAL PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1613)
 1613 FORMAT('      ALL VARIABLES MUST HAVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1614)
 1614 FORMAT('      THE SAME NUMBER OF ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1621)N1
 1621 FORMAT('THE FIRST   VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.1)GOTO1690
      WRITE(ICOUT,1622)N2
 1622 FORMAT('THE SECOND  VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.2)GOTO1690
      WRITE(ICOUT,1623)N3
 1623 FORMAT('THE THIRD   VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.3)GOTO1690
      WRITE(ICOUT,1624)N4
 1624 FORMAT('THE FOURTH  VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.4)GOTO1690
      WRITE(ICOUT,1625)N5
 1625 FORMAT('THE FIFTH   VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.5)GOTO1690
      WRITE(ICOUT,1626)N6
 1626 FORMAT('THE SIXTH   VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.6)GOTO1690
      WRITE(ICOUT,1627)N7
 1627 FORMAT('THE SEVENTH VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1628)
 1628 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1629)(IANS(I),I=1,IWIDTH)
 1629 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1690 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.'FRAC')
     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,N1
      ISUB(I)=1
 2115 CONTINUE
      NQ=N1
      GOTO2150
C
 2120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2150
C
 2130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2150
C
 2150 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO2160I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO2160
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Z1(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Z1(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Z1(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Z1(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Z1(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Z1(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Z1(J)=TAGPLO(I)
C
      IF(NUMV2.LE.1)GOTO2160
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)Z2(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)Z2(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)Z2(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)Z2(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)Z2(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)Z2(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)Z2(J)=TAGPLO(I)
C
      IF(NUMV2.LE.2)GOTO2160
      IJ=MAXN*(ICOL3-1)+I
      IF(ICOL3.LE.MAXCOL)Z3(J)=V(IJ)
      IF(ICOL3.EQ.MAXCP1)Z3(J)=PRED(I)
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(ICOL3.EQ.MAXCP3)Z3(J)=RES(I)
      IF(ICOL3.EQ.MAXCP2)Z3(J)=RES(I)
      IF(ICOL3.EQ.MAXCP3)Z3(J)=YPLOT(I)
      IF(ICOL3.EQ.MAXCP4)Z3(J)=XPLOT(I)
      IF(ICOL3.EQ.MAXCP5)Z3(J)=X2PLOT(I)
      IF(ICOL3.EQ.MAXCP6)Z3(J)=TAGPLO(I)
C
      IF(NUMV2.LE.3)GOTO2160
      IJ=MAXN*(ICOL4-1)+I
      IF(ICOL4.LE.MAXCOL)Z4(J)=V(IJ)
      IF(ICOL4.EQ.MAXCP1)Z4(J)=PRED(I)
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(ICOL4.EQ.MAXCP4)Z4(J)=RES(I)
      IF(ICOL4.EQ.MAXCP2)Z4(J)=RES(I)
      IF(ICOL4.EQ.MAXCP3)Z4(J)=YPLOT(I)
      IF(ICOL4.EQ.MAXCP4)Z4(J)=XPLOT(I)
      IF(ICOL4.EQ.MAXCP5)Z4(J)=X2PLOT(I)
      IF(ICOL4.EQ.MAXCP6)Z4(J)=TAGPLO(I)
C
      IF(NUMV2.LE.4)GOTO2160
      IJ=MAXN*(ICOL5-1)+I
      IF(ICOL5.LE.MAXCOL)Z5(J)=V(IJ)
      IF(ICOL5.EQ.MAXCP1)Z5(J)=PRED(I)
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(ICOL5.EQ.MAXCP5)Z5(J)=RES(I)
      IF(ICOL5.EQ.MAXCP2)Z5(J)=RES(I)
      IF(ICOL5.EQ.MAXCP3)Z5(J)=YPLOT(I)
      IF(ICOL5.EQ.MAXCP4)Z5(J)=XPLOT(I)
      IF(ICOL5.EQ.MAXCP5)Z5(J)=X2PLOT(I)
      IF(ICOL5.EQ.MAXCP6)Z5(J)=TAGPLO(I)
C
      IF(NUMV2.LE.5)GOTO2160
      IJ=MAXN*(ICOL6-1)+I
      IF(ICOL6.LE.MAXCOL)Z6(J)=V(IJ)
      IF(ICOL6.EQ.MAXCP1)Z6(J)=PRED(I)
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(ICOL6.EQ.MAXCP6)Z6(J)=RES(I)
      IF(ICOL6.EQ.MAXCP2)Z6(J)=RES(I)
      IF(ICOL6.EQ.MAXCP3)Z6(J)=YPLOT(I)
      IF(ICOL6.EQ.MAXCP4)Z6(J)=XPLOT(I)
      IF(ICOL6.EQ.MAXCP5)Z6(J)=X2PLOT(I)
      IF(ICOL6.EQ.MAXCP6)Z6(J)=TAGPLO(I)
C
      IF(NUMV2.LE.6)GOTO2160
      IJ=MAXN*(ICOL7-1)+I
      IF(ICOL7.LE.MAXCOL)Z7(J)=V(IJ)
      IF(ICOL7.EQ.MAXCP1)Z7(J)=PRED(I)
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(ICOL7.EQ.MAXCP7)Z7(J)=RES(I)
      IF(ICOL7.EQ.MAXCP2)Z7(J)=RES(I)
      IF(ICOL7.EQ.MAXCP3)Z7(J)=YPLOT(I)
      IF(ICOL7.EQ.MAXCP4)Z7(J)=XPLOT(I)
      IF(ICOL7.EQ.MAXCP5)Z7(J)=X2PLOT(I)
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(ICOL7.EQ.MAXCP7)Z6(J)=TAGPLO(I)
      IF(ICOL7.EQ.MAXCP6)Z7(J)=TAGPLO(I)
C
 2160 CONTINUE
      NLOCAL=J
C
C               *************************************************************
C               **  STEP 31--                                              **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                  **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.                     **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'FRAC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.LE.6)GOTO3110
      GOTO3119
 3110 CONTINUE
      DO3111I=1,NLOCAL
      Z7(I)=1.0
 3111 CONTINUE
 3119 CONTINUE
C
      CALL DPFRA2(Z1,Z2,Z3,Z4,Z5,Z6,Z7,NLOCAL,NUMV2,ICASPL,ICONT,
     1IANGLU,ISEED,W,U,MAXPOP,
CCCCC JULY 1993.  ADD FOLLOWING LINE (FRACTAL ITERATIONS, FRACTAL TYPE)
     1IFRAIT,IFRATY,
     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.'FRAC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFRAC--')
      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)ICASPL,IAND1,IAND2,ICONT
 9014 FORMAT('ICASPL,IAND1,IAND2,ICONT = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IANGLU,ISEED,MAXPOP
 9015 FORMAT('IANGLU,ISEED,MAXPOP = ',A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9016 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)NLOCAL,NUMV2
 9041 FORMAT('NLOCAL,NUMV2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NLOCAL.LE.0)GOTO9044
      DO9042I=1,NLOCAL
      WRITE(ICOUT,9043)I,Z1(I),Z2(I),Z3(I),Z4(I),Z5(I),Z6(I)
 9043 FORMAT('I,Z1(I),Z2(I),Z3(I),Z4(I),Z5(I),Z6(I) = ',I8,6E10.3)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
 9044 CONTINUE
      WRITE(ICOUT,9051)NPLOTP
 9051 FORMAT('NPLOTP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9054
      DO9052I=1,NPLOTP
      WRITE(ICOUT,9053)I,Y(I),X(I),D(I)
 9053 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9052 CONTINUE
 9054 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFRA2(Z1,Z2,Z3,Z4,Z5,Z6,Z7,N,NUMV2,ICASPL,ICONT,
     1IANGLU,ISEED,W,U,MAXPOP,
CCCCC JULY 1993.  ADD FOLLOWING LINE
     1IFRAIT,IFRATY,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN FRACTAL PLOT
C     NOTE--Z1 = INITIAL ROTATION
C           Z2 = X-SCALING
C           Z3 = Y-SCALING
C           Z4 = FINAL ROTATION
C           Z5 = X-TRANSLATION
C           Z6 = Y-TRANSLATION
C           Z7 = PROBABILITY WEIGHTING FOR EACH REGION
C     REFERENCE--WILLIAM DOUGLAS WITHERS, NAVAL ACADEMY
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/12
C     ORIGINAL VERSION--DECEMBER  1988.
C     UPDATED         --JULY      1993.  FRACTAL ITERATIONS, FRACTAL
C                                        TYPE.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
CCCCC JULY 1993.  ADD FOLLOWING LINE.
      CHARACTER*4 IFRATY
C
C---------------------------------------------------------------------
C
      DIMENSION Z1(*)
      DIMENSION Z2(*)
      DIMENSION Z3(*)
      DIMENSION Z4(*)
      DIMENSION Z5(*)
      DIMENSION Z6(*)
      DIMENSION Z7(*)
C
      DIMENSION W(*)
      DIMENSION U(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION A11(100)
      DIMENSION A12(100)
      DIMENSION A21(100)
      DIMENSION A22(100)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'FRA2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFRA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICONT,IANGLU,ISEED,MAXPOP
   53 FORMAT('ICASPL,ICONT,IANGLU,ISEED,MAXPOP = ',
     1A4,2X,A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMV2
   54 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)N
   61 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO62I=1,N
      WRITE(ICOUT,63)I,Z1(I),Z2(I),Z3(I),Z4(I),Z5(I),Z6(I),Z7(I)
   63 FORMAT('I,Z1(I),Z2(I),Z3(I),Z4(I),Z5(I),Z6(I),Z7(I) = ',
     1I8,7E9.2)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   90 CONTINUE
C
      CONST=1.0
      IF(IANGLU.EQ.'DEGR')CONST=2*3.14159/360.0
CCCCC JULY 1993.  BRANCH ACCORDING TO CASE.
C
C  WHITHER'S FORMAT
C
      IF(IFRATY.EQ.'WHIT')THEN
        DO1100I=1,N
C
        ALPHA=Z1(I)
        SCALEX=Z2(I)
        SCALEY=Z3(I)
        BETA=Z4(I)
C
        SINALP=SIN(CONST*ALPHA)
        COSALP=COS(CONST*ALPHA)
        SINBET=SIN(CONST*BETA)
        COSBET=COS(CONST*BETA)
        A11(I)=COSALP*COSBET*SCALEX-SINALP*SINBET*SCALEY
        A12(I)=(-SINALP*COSBET*SCALEX-COSALP*SINBET*SCALEY)
        A21(I)=COSALP*SINBET*SCALEX+SINALP*COSBET*SCALEY
        A22(I)=(-SINALP*SINBET*SCALEX+COSALP*COSBET*SCALEY)
C
 1100   CONTINUE
C
C  BARNSLEY ROTATION ANGLE FORMAT
C
      ELSEIF(IFRATY.EQ.'ANGL')THEN
        DO1110I=1,N
C
        ALPHA=Z1(I)
        SCALEX=Z2(I)
        SCALEY=Z3(I)
        BETA=Z4(I)
C
        A11(I)=SCALEX*COS(ALPHA)
        A12(I)=-SCALEY*SIN(BETA)
        A21(I)=SCALEX*SIN(ALPHA)
        A22(I)=SCALEY*COS(BETA)
C
 1110   CONTINUE
C
C  BARNSLEY STANDARD FORMAT
C
      ELSE
        DO1120I=1,N
        A11(I)=Z1(I)
        A12(I)=Z2(I)
        A21(I)=Z3(I)
        A22(I)=Z4(I)
 1120   CONTINUE
      ENDIF
C
      SUM=0.0
      DO1210I=1,N
      SUM=SUM+Z7(I)
 1210 CONTINUE
C
      DO1220I=1,N
      W(I)=Z7(I)/SUM
 1220 CONTINUE
C
      CUM=0.0
      DO1230I=1,N
      CUM=CUM+W(I)
      W(I)=CUM
 1230 CONTINUE
C
CCCCC JULY 1993.  ADD FOLLOWING LINES
CCCCC NU=MAXPOP
      NU=IFRAIT
      IF(NU.GT.MAXPOP)NU=IFRAIT
CCCCC END CHANGE
      CALL UNIRAN(NU,ISEED,U)
C
      XNEW=0.0
      YNEW=0.0
      K=0
      JCUT=20
      DO1310J=1,NU
C
      UJ=U(J)
      DO1320I=1,N
      INDEX=I
      IF(UJ.LE.W(I))GOTO1329
 1320 CONTINUE
 1329 CONTINUE
C
      XOLD=XNEW
      YOLD=YNEW
      XTEMP=A11(INDEX)*XOLD+A12(INDEX)*YOLD
      YTEMP=A21(INDEX)*XOLD+A22(INDEX)*YOLD
      XNEW=XTEMP+Z5(INDEX)
      YNEW=YTEMP+Z6(INDEX)
      IF(J.LE.JCUT)GOTO1310
      IF(J.GT.JCUT)K=K+1
      X2(K)=XNEW
      Y2(K)=YNEW
      D2(K)=1.0
 1310 CONTINUE
C
      N2=K
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'FRA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFRA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICONT,IANGLU,ISEED,MAXPOP
 9013 FORMAT('ICASPL,ICONT,IANGLU,ISEED,MAXPOP = ',
     1A4,2X,A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)N
 9021 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,N
      WRITE(ICOUT,9023)A11(I),A12(I),A21(I),A22(I)
 9023 FORMAT('A11(I),A12(I),A21(I),A22(I) = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
      DO9024I=1,N
      WRITE(ICOUT,9025)I,W(I)
 9025 FORMAT('I,W(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9024 CONTINUE
      WRITE(ICOUT,9051)NUMV2
 9051 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)N2,NPLOTV
 9052 FORMAT('N2,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9053I=1,N2
CCCCC WRITE(ICOUT,9054)I,U(I),X2(I),Y2(I)
 9054 FORMAT('I,U(I),X2(I),Y2(I) = ',I8,3E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
 9053 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFRAM(ICOM,IHARG,NUMARG,
     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
CCCCC THE FOLLOWING LINE WAS ADDED   SEPTEMBER 1993
     1FRASTY,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FRAME SWITCHES (ON/OFF)
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH FRAME SWITCHES DEFINE WHETHER OR NOT
C              EACH OF THE 4 FRAME LINES EXISTS.
C              THE CONTENTS OF A FRAME SWITCH ARE
C              ON    OR    OFF.
C              THE FRAME SWITCHES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C              IX1FSW,IX2FSW,IY1FSW,IY2FSW.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IX1FSW (A HOLLERITH VECTOR)
C                     --IX2FSW (A HOLLERITH VECTOR)
C                     --IY1FSW (A HOLLERITH VECTOR)
C                     --IY2FSW (A HOLLERITH VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --SEPTEMBER 1993. 3-D
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IX1FSW
      CHARACTER*4 IX2FSW
      CHARACTER*4 IY1FSW
      CHARACTER*4 IY2FSW
C
CCCCC THE FOLLOWING LINE WAS ADDED   SEPTEMBER 1993
      CHARACTER*4 FRASTY
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
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CORN')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1900
C
CCCCC THE FOLLOWING SECTION WAS ADDED           SEPTEMBER 1993
CCCCC TO ALLOW FOR 3-D FRAME STYLE  SETTINGS    SEPTEMBER 1993
C               *****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  THE 3D FRAME STYLE IS TO BE CHANGED     **
C               *****************************************************
C
      IF(ICOM.EQ.'3DFR')GOTO1000
      GOTO1099
C
 1000 CONTINUE
      IF(NUMARG.LE.0)GOTO1010
      IF(IHARG(NUMARG).EQ.'ON')GOTO1010
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1020
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1010
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1010
      IF(IHARG(NUMARG).EQ.'?')GOTO1030
      GOTO1020
C
 1010 CONTINUE
      IFOUND='YES'
      FRASTY='3PRO'
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,999)
  999    FORMAT(1X)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1011)
 1011    FORMAT('THE 3D FRAME SWITCH')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1012)
 1012    FORMAT('HAS JUST BEEN SET TO    3PRONG')
         CALL DPWRST('XXX','BUG ')
         GOTO1900
      ENDIF
C
 1020 CONTINUE
      IFOUND='YES'
C
      IF(IHARG(1).EQ.'OFF'.OR.IHARG(1).EQ.'NONE')THEN
         FRASTY='OFF'
         IF(IFEEDB.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1011)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1021)
 1021       FORMAT('HAS JUST BEEN SET TO    OFF')
            CALL DPWRST('XXX','BUG ')
         ENDIF
         GOTO1900
      ENDIF
C
      IF(IHARG(1).EQ.'3PRO')THEN
         FRASTY='3PRO'
         IF(IFEEDB.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1011)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1022)
 1022       FORMAT('HAS JUST BEEN SET TO    3PRONG')
            CALL DPWRST('XXX','BUG ')
         ENDIF
         GOTO1900
      ENDIF
C
      IF(IHARG(1).EQ.'3PLA')THEN
         FRASTY='3PLA'
         IF(IFEEDB.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1011)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1023)
 1023       FORMAT('HAS JUST BEEN SET TO    3PLANE')
            CALL DPWRST('XXX','BUG ')
         ENDIF
         GOTO1900
      ENDIF
C
      IF(IHARG(1).EQ.'CUBE'.OR.IHARG(1).EQ.'BOX')THEN
         FRASTY='BOX'
         IF(IFEEDB.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1011)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1024)
 1024       FORMAT('HAS JUST BEEN SET TO    BOX')
            CALL DPWRST('XXX','BUG ')
         ENDIF
         GOTO1900
      ENDIF
C
      IF(IHARG(1).EQ.'ZIGZ')THEN
         FRASTY='ZIGZ'
         IF(IFEEDB.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1011)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1025)
 1025       FORMAT('HAS JUST BEEN SET TO    ZIGZAG')
            CALL DPWRST('XXX','BUG ')
         ENDIF
         GOTO1900
      ENDIF
C
 1030 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1031)
 1031 FORMAT('THE 3D FRAME SWITCH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1032)FRASTY
 1032 FORMAT('HAS THE CURRENT SETTING = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1033)
 1033 FORMAT('ALLOWABLE SETTINGS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1034)
 1034 FORMAT('   3PRONG')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1035)
 1035 FORMAT('   3PLANE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1036)
 1036 FORMAT('   BOX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1037)
 1037 FORMAT('   ZIGZAG')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1038)
 1038 FORMAT('   OFF')
      CALL DPWRST('XXX','BUG ')
      GOTO1900
C
 1099 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  BOTH HORIZONTAL FRAME LINES ARE TO BE CHANGED  **
C               *****************************************************
C
      IF(ICOM.EQ.'XFRA')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1110
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
      IERROR='YES'
      GOTO1900
C
 1110 CONTINUE
      IFOUND='YES'
      IX1FSW='ON'
      IX2FSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE XFRAME SWITCH (FOR BOTH HORIZONTAL FRAME LINES) ',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      IFOUND='YES'
      IX1FSW='OFF'
      IX2FSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE XFRAME SWITCH (FOR BOTH HORIZONTAL FRAME LINES) ',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE IS TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1FR')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1210
      IF(IHARG(NUMARG).EQ.'ON')GOTO1210
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1220
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1210
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1210
      IERROR='YES'
      GOTO1900
C
 1210 CONTINUE
      IFOUND='YES'
      IX1FSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE X1FRAME SWITCH (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO1900
C
 1220 CONTINUE
      IFOUND='YES'
      IX1FSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE X1FRAME SWITCH (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL FRAME LINE IS TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2FR')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1310
      IF(IHARG(NUMARG).EQ.'ON')GOTO1310
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1320
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1310
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1310
      IERROR='YES'
      GOTO1900
C
 1310 CONTINUE
      IFOUND='YES'
      IX2FSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE X2FRAME SWITCH (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO1900
C
 1320 CONTINUE
      IFOUND='YES'
      IX2FSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE X2FRAME SWITCH (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               ***************************************************
C               **  TREAT THE CASE WHEN                          **
C               **  BOTH VERTICAL FRAME LINES ARE TO BE CHANGED  **
C               ***************************************************
C
      IF(ICOM.EQ.'YFRA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(NUMARG.LE.0)GOTO1410
      IF(IHARG(NUMARG).EQ.'ON')GOTO1410
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1420
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1410
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1410
      IERROR='YES'
      GOTO1900
C
 1410 CONTINUE
      IFOUND='YES'
      IY1FSW='ON'
      IY2FSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('THE YFRAME SWITCH (FOR BOTH VERTICAL FRAME LINES) ',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1419 CONTINUE
      GOTO1900
C
 1420 CONTINUE
      IFOUND='YES'
      IY1FSW='OFF'
      IY2FSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('THE YFRAME SWITCH (FOR BOTH VERTICAL FRAME LINES) ',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   FRAME LINE IS TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1FR')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(NUMARG.LE.0)GOTO1510
      IF(IHARG(NUMARG).EQ.'ON')GOTO1510
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1520
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1510
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1510
      IERROR='YES'
      GOTO1900
C
 1510 CONTINUE
      IFOUND='YES'
      IY1FSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('THE Y1FRAME SWITCH (FOR THE LEFT VERTICAL ',
     1'FRAME LINE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
      GOTO1900
C
 1520 CONTINUE
      IFOUND='YES'
      IY1FSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1529
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)
 1525 FORMAT('THE Y1FRAME SWITCH (FOR THE LEFT VERTICAL ',
     1'FRAME LINE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1529 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE IS TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2FR')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(NUMARG.LE.0)GOTO1610
      IF(IHARG(NUMARG).EQ.'ON')GOTO1610
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1620
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1610
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1610
      IERROR='YES'
      GOTO1900
C
 1610 CONTINUE
      IFOUND='YES'
      IY2FSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('THE Y2FRAME SWITCH (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO1900
C
 1620 CONTINUE
      IFOUND='YES'
      IY2FSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)
 1625 FORMAT('THE Y2FRAME SWITCH (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1629 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               **************************************************
C               **  TREAT THE CASE WHEN                         **
C               **  THE ENTIRE 4-SIDED FRAME IS TO BE CHANGED   **
C               **************************************************
C
      IF(ICOM.EQ.'XYFR')GOTO1700
      IF(ICOM.EQ.'YXFR')GOTO1700
      IF(ICOM.EQ.'FRAM')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(NUMARG.LE.0)GOTO1710
      IF(IHARG(NUMARG).EQ.'ON')GOTO1710
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1720
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1710
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1710
      IERROR='YES'
      GOTO1900
C
 1710 CONTINUE
      IFOUND='YES'
      IX1FSW='ON'
      IX2FSW='ON'
      IY1FSW='ON'
      IY2FSW='ON'
C
      IF(IFEEDB.EQ.'OFF')GOTO1719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1715)
 1715 FORMAT('THE FRAME SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1719 CONTINUE
      GOTO1900
C
 1720 CONTINUE
      IFOUND='YES'
      IX1FSW='OFF'
      IX2FSW='OFF'
      IY1FSW='OFF'
      IY2FSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)
 1725 FORMAT('THE FRAME SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1729 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPFRCC(IHARG,IHARG2,IARGT,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1PXMIN,PXMAX,PYMIN,PYMAX,IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FRAME CORNER COORDINATES
C              (LOWER LEFT AND UPPER RIGHT)
C              WHICH IN TURN WILL DEFINE THE SIZE AND SHAPE
C              OF THE PLOT FRAME.
C              THE 2 PAIRS OF COORDINATES ARE CONTAINED IN THE
C              4 VARIABLES    PXMIN,PYMIN    AND    PXMAX,PYMAX
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--PXMIN = X COOR. FOR LOWER LEFT  CORNER
C                     --PXMAX = X COOR. FOR UPPER RIGHT CORNER
C                     --PYMIN = Y COOR. FOR LOWER LEFT  CORNER
C                     --PYMAX = Y COOR. FOR UPPER RIGHT CORNER
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IANS(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPFR'
      ISUBN2='CC  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFRCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IFOUND,IERROR
   52 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PXMIN,PXMAX,PYMIN,PYMAX
   53 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  TREAT THE    FRAME     COORDINATES    CASE  **
C               **************************************************
C
      IF(NUMARG.LE.1)GOTO1150
      GOTO1110
C
 1110 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(NUMARG.GE.2)GOTO1175
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPFRCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR FRAME CORNER COORDINATES ',
     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 TO POSITION   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE LOWER LEFT CORNER OF THE FRAME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      10% ACROSS THE PAGE AND 20% UP THE PAGE, AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THE UPPER RIGHT CORNER OF THE FRAME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      90% ACROSS THE PAGE AND 80% UP THE PAGE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      FRAME CORNER COORDINATES 10 20 90 80')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PXMIN=15.
      PYMIN=20.
      PXMAX=85.
      PYMAX=90.
      GOTO1180
C
 1175 CONTINUE
      DO1176J=2,NUMARG
      IF(IARGT(J).EQ.'NUMB')GOTO1177
      GOTO1178
 1177 CONTINUE
      IF(J.EQ.2)PXMIN=ARG(J)
      IF(J.EQ.3)PYMIN=ARG(J)
      IF(J.EQ.4)PXMAX=ARG(J)
      IF(J.EQ.5)PYMAX=ARG(J)
      GOTO1176
 1178 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.2)PXMIN=VALUE(ILOC)
      IF(J.EQ.3)PYMIN=VALUE(ILOC)
      IF(J.EQ.4)PXMAX=VALUE(ILOC)
      IF(J.EQ.5)PYMAX=VALUE(ILOC)
 1176 CONTINUE
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('THE FRAME CORNER COORDINATES HAVE JUST BEEN SET ',
     1'AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)PXMIN,PYMIN
 1186 FORMAT('    (X,Y) FOR LOWER LEFT  CORNER OF FRAME = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1187)PXMAX,PYMAX
 1187 FORMAT('    (X,Y) FOR UPPER RIGHT CORNER OF FRAME = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFRCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PXMIN,PXMAX,PYMIN,PYMAX
 9013 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFRCL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IX1FCO,IX2FCO,IY1FCO,IY2FCO,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FRAME COLOR SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH FRAME COLOR SWITCHES DEFINE THE COLOR
C              FOR EACH OF THE 4 FRAME LINES.
C              THE CONTENTS OF A FRAME COLOR SWITCH ARE
C              A COLOR.
C              THE FRAME COLOR SWITCHES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C              IX1FCO,IX2FCO,IY1FCO,IY2FCO.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C     OUTPUT ARGUMENTS--IX1FCO (A HOLLERITH VECTOR)
C                     --IX2FCO (A HOLLERITH VECTOR)
C                     --IY1FCO (A HOLLERITH VECTOR)
C                     --IY2FCO (A HOLLERITH VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   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 IX1FCO
      CHARACTER*4 IX2FCO
      CHARACTER*4 IY1FCO
      CHARACTER*4 IY2FCO
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'COLO')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL FRAMES    ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XFRA')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'
      IX1FCO=IHOLD
      IX2FCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE FRAME COLOR (FOR BOTH HORIZONTAL ',
     1'FRAME 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               **  ONLY THE BOTTOM HORIZONTAL FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1FR')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'
      IX1FCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE FRAME COLOR (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      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               **  ONLY THE TOP    HORIZONTAL FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2FR')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'
      IX2FCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE FRAME COLOR (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      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
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   FRAMES    ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YFRA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFCO
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1FCO=IHOLD
      IY2FCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE FRAME COLOR (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1FR')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFCO
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1FCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE FRAME COLOR (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2FR')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFCO
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2FCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE FRAME COLOR (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME FRAME LINES ARE TO BE CHANGED      **
C               *****************************************************
C
      IF(ICOM.EQ.'FRAM')GOTO1700
      IF(ICOM.EQ.'XYFR')GOTO1700
      IF(ICOM.EQ.'YXFR')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFCO
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1FCO=IHOLD
      IX2FCO=IHOLD
      IY1FCO=IHOLD
      IY2FCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE FRAME COLOR (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPFRE2(Y,X,N,ICASPL,IRELAT,IDATSW,CLWID,XSTART,XSTOP,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C                   1) A FREQUENCY PLOT,
C                   2) A RELATIVE FREQUENCY PLOT
C                      (THAT IS, WITH AREA = 1).
C                   3) A CUMULATIVE FREQUENCY PLOT
C                   4) A RELATIVE CUMULATIVE FREQUENCY PLOT
C                      (THAT IS, WITH MAX ORDINATE = 1).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1999.  CHECK FOR POINTS OUTSIDE INTERVAL
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
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPFR'
      ISUBN2='E2  '
C
      IERROR='NO'
C
      AN3=0.0
      DENOM=0.0
      CUMFJ=0.0
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPFRE2--')
      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 DPFRE2--')
      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=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('***** ERROR IN DPFRE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL INPUT HORIZONTAL AXIS ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('***** AT THE BEGINNING OF DPFRE2--')
      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(CLWID.NE.CPUMIN.AND.XSTART.NE.CPUMIN.AND.
     1XSTOP.NE.CPUMAX)GOTO119
      IWRIT2='OFF'
      CALL MEAN(X,N,IWRIT2,XMEAN,IBUGG3,IERROR)
      CALL SD(X,N,IWRIT2,XSD,IBUGG3,IERROR)
      IF(CLWID.EQ.CPUMIN)CLWID=0.3*XSD
      IF(XSTART.EQ.CPUMIN)XSTART=XMEAN-6.0*XSD
      IF(XSTOP.EQ.CPUMAX)XSTOP=XMEAN+6.0*XSD
  119 CONTINUE
      GOTO180
C
  150 CONTINUE
      CALL SORT(X,N,D2)
      NM1=N-1
      CLWID=D2(2)-D2(1)
      DO160I=1,NM1
      IP1=I+1
      DELI=D2(IP1)-D2(I)
      IF(DELI.LT.CLWID)CLWID=DELI
  160 CONTINUE
      XSTART=D2(1)-(CLWID/2.0)
      XSTOP=D2(N)+(CLWID/2.0)
      GOTO180
C
  180 CONTINUE
      TOTWID=XSTOP-XSTART
      ANUMCL=TOTWID/CLWID
      NUMCLA=ANUMCL+1.0
C
      J=NUMCLA-1
      AJ=J
      CLMAXJ=XSTART+AJ*CLWID
      ABSDEL=ABS(CLMAXJ-XSTOP)
      IF(ABSDEL.LE.0.0001)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
      IABOVE=0
      IBELOW=0
      DO420I=1,N
      DO430J=1,NUMCLA
      J2=J
      AJ=J
      IF(X(I).LT.XSTART)THEN
        IBELOW=IBELOW+1
        GOTO420
      ENDIF
      IF(X(I).GT.XSTOP)THEN
        IABOVE=IABOVE+1
        GOTO420
      ENDIF
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(CLMINJ.LE.X(I).AND.X(I).LT.CLMAXJ)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
      AJ=J
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(X(I).EQ.CLMAXJ)D2(J)=D2(J)+1.0
  450 CONTINUE
      GOTO590
C
  510 CONTINUE
      IABOVE=0
      IBELOW=0
      DO520I=1,N
      DO530J=1,NUMCLA
      J2=J
      AJ=J
      IF(X(I).LT.XSTART)THEN
        IBELOW=IBELOW+1
        GOTO520
      ENDIF
      IF(X(I).GT.XSTOP)THEN
        IABOVE=IABOVE+1
        GOTO520
      ENDIF
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(CLMINJ.LE.X(I).AND.X(I).LT.CLMAXJ)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
      AJ=J
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(X(I).EQ.CLMAXJ)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,XSTART
 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,XSTOP
 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 DPFRE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,592)CLWID,XSTART,XSTOP,TOTWID,ANUMCL,NUMCLA
  592 FORMAT('CLWID,XSTART,XSTOP,TOTWID,ANUMCL,NUMCLA= ',5E11.4,I8)
      CALL DPWRST('XXX','BUG ')
      DO593J=1,NUMCLA
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      FJ=D2(J)
      WRITE(ICOUT,594)J,CLMINJ,CLMAXJ,FJ
  594 FORMAT('J,CLMINJ,CLMAXJ,FJ = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
  593 CONTINUE
  595 CONTINUE
C
C               **********************************
C               **  STEP 4--                    **
C               **  DETERMINE PLOT COORDINATES  **
C               **********************************
C
      IF(ICASPL.EQ.'FREQ')GOTO1100
      IF(ICASPL.EQ.'CUMF')GOTO1200
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPFRE2 ',
     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('      FREQ   OR    CUMF, 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
      IF(IRELAT.EQ.'ON')DENOM=AN3
C
      K=0
C
      K=K+1
      J=1
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      X2(K)=CLMINJ-((CLMAXJ-CLMINJ)/2.0)
      Y2(K)=0.0
C
      DO1120J=1,NUMCLA
      K=K+1
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      FJ=D2(J)
      X2(K)=(CLMINJ+CLMAXJ)/2.0
      Y2(K)=FJ/DENOM
 1120 CONTINUE
C
      K=K+1
      J=NUMCLA
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      X2(K)=CLMAXJ+((CLMAXJ-CLMINJ)/2.0)
      Y2(K)=0.0
C
      N2=K
      NPLOTV=2
C
      K=0
C
      K=K+1
      D2(K)=1.0
C
      DO1130J=1,NUMCLA
      K=K+1
      D2(K)=1.0
 1130 CONTINUE
C
      K=K+1
      D2(K)=1.0
C
      GOTO9000
C
 1200 CONTINUE
      SUM=0.0
      DO1210J=1,NUMCLA
      FJ=D2(J)
      SUM=SUM+FJ
 1210 CONTINUE
      AN3=SUM
C
      DENOM=1.0
      IF(IRELAT.EQ.'ON')DENOM=AN3
C
      K=0
      SUM=0.0
C
      K=K+1
      J=1
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      X2(K)=CLMINJ-((CLMAXJ-CLMINJ)/2.0)
      Y2(K)=0.0
C
      DO1220J=1,NUMCLA
      K=K+1
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      FJ=D2(J)
      SUM=SUM+FJ
      CUMFJ=SUM
      X2(K)=(CLMINJ+CLMAXJ)/2.0
      Y2(K)=CUMFJ/DENOM
 1220 CONTINUE
C
      K=K+1
      J=NUMCLA
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      X2(K)=CLMAXJ+((CLMAXJ-CLMINJ)/2.0)
      Y2(K)=CUMFJ/DENOM
C
      N2=K
      NPLOTV=2
C
      K=0
C
      K=K+1
      D2(K)=1.0
C
      DO1230J=1,NUMCLA
      K=K+1
      D2(K)=1.0
 1230 CONTINUE
C
      K=K+1
      D2(K)=1.0
C
      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 DPFRE2--')
      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
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFREQ(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 4 PLOTS--
C              1) FREQUENCY PLOT;
C              2) RELATIVE FREQUENCY PLOT;
C              3) CUMULATIVE FREQUENCY PLOT;
C              4) RELATIVE CUMULATIVE FREQUENCY PLOT;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--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
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 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 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION CLLIMI(*)
      DIMENSION CLWIDT(*)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPFR'
      ISUBN2='EQ  '
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
      ICOLR=0
C
C               **********************************************
C               **  TREAT THE FREQUENCY PLOT AND            **
C               **  RELATED STATISTICAL DISTRIBUTION PLOTS  **
C               **********************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFREQ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'FREQ'.AND.IHARG(1).EQ.'PLOT')GOTO110
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'FREQ'.AND.IHARG(2).EQ.'PLOT')
     1GOTO120
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CUMU'.AND.IHARG(1).EQ.'FREQ'.AND.IHARG(2).EQ.'PLOT')
     1GOTO130
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'CUMU'.AND.IHARG(2).EQ.'FREQ'.AND.
     1IHARG(3).EQ.'PLOT')GOTO140
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'CUMU'.AND.IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'FREQ'.AND.
     1IHARG(3).EQ.'PLOT')GOTO140
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ICASPL='FREQ'
      IRELAT='OFF'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  120 CONTINUE
      ICASPL='FREQ'
      IRELAT='ON'
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  130 CONTINUE
      ICASPL='CUMF'
      IRELAT='OFF'
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  140 CONTINUE
      ICASPL='CUMF'
      IRELAT='ON'
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='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 DPFREQ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A FREQUENCY PLOT ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A RELATIVE FREQUENCY PLOT ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMF'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,323)
  323 FORMAT('      (FOR WHICH A CUMULATIVE FREQUENCY PLOT ')
      IF(ICASPL.EQ.'CUMF'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMF'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,324)
  324 FORMAT('      (FOR WHICH A RELATIVE CUMULATIVE FREQUENCY ',
     1'PLOT ')
      IF(ICASPL.EQ.'CUMF'.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 DPFREQ')
      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 DPFREQ--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,552)
  552 FORMAT('      FOR A FREQUENCY PLOT, ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,553)
  553 FORMAT('      FOR A RELATIVE FREQUENCY PLOT, ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMF'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,554)
  554 FORMAT('      FOR A CUMULATIVE FREQUENCY PLOT, ')
      IF(ICASPL.EQ.'CUMF'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMF'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,555)
  555 FORMAT('      FOR A RELATIVE CUMULATIVE FREQUENCY PLOT, ')
      IF(ICASPL.EQ.'CUMF'.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 DPFREQ--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,572)
  572 FORMAT('      FOR A FREQUENCY PLOT, ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,573)
  573 FORMAT('      FOR A RELATIVE FREQUENCY PLOT, ')
      IF(ICASPL.EQ.'FREQ'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMF'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,574)
  574 FORMAT('      FOR A CUMULATIVE FREQUENCY PLOT, ')
      IF(ICASPL.EQ.'CUMF'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMF'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,575)
  575 FORMAT('      FOR A RELATIVE CUMULATIVE FREQUENCY PLOT, ')
      IF(ICASPL.EQ.'CUMF'.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')
      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  (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)
      XSTART=CLLIMI(1)
      XSTOP=CLLIMI(2)
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 DPFRE2(Y1,X1,NLOCAL,ICASPL,IRELAT,IDATSW,CLWID,XSTART,XSTOP,
     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 DPFREQ--')
      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 DPFRIE(YTEMP,XTEMP,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT FRIEDMAN TEST
C              NON-PARAMETRIC TWO-WAY ANOVA
C     EXAMPLE--FRIEDMAN TEST Y X1 X2
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/10
C     ORIGINAL VERSION--OCTOBER   2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
      CHARACTER*4 IH31
      CHARACTER*4 IH32
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
      CHARACTER*4 IUSE3
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION DBLOCK(MAXOBV)
      DIMENSION DTREAT(MAXOBV)
      DIMENSION YRANK(MAXOBV)
      DIMENSION RJ(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE(GARBAG(IGARB1),XTEMP2(1))
      EQUIVALENCE(GARBAG(IGARB2),DBLOCK(1))
      EQUIVALENCE(GARBAG(IGARB3),DTREAT(1))
      EQUIVALENCE(GARBAG(IGARB4),YRANK(1))
      EQUIVALENCE(GARBAG(IGARB5),RJ(1))
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPFR'
      ISUBN2='IE  '
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=4
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ******************************************
C               **  TREAT THE FRIEDMAN TEST CASE        **
C               ******************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRIE')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPFRIE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ
   52   FORMAT('IBUGA2,IBUGA3,IBUBQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICAPSW,ICAPTY
   53   FORMAT('ICAPSW,ICAPTY = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)MAXNXT
   55   FORMAT('MAXNXT = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')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 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRIE')
     1CALL 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 FRIEDMAN TEST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR THE FRIEDMAN TEST, THE FIRST ARGUMENT (THE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      RESPONSE VARIABLE) 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)THEN
           WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         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 4 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRIE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.EQ.'V' .AND. N1.LE.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1211)
 1211   FORMAT('***** ERROR IN FRIEDMAN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1212)
 1212   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1214)
 1214   FORMAT('      FRIEDMAN TEST WAS TO HAVE BEEN CARRIED OUT MUST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1216)MINN2
 1216   FORMAT('      BE ',I8,' OR LARGER; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1218)IH11,IH12,N1
 1218   FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1219)
 1219   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1220)(IANS(I),I=1,MIN(IWIDTH,80))
 1220     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS SHOULD ALSO BE A VARIABLE)  **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRIE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2141)
 2141    FORMAT('***** ERROR IN THE FRIEDMAN TEST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2142)
 2142    FORMAT('      FOR THE FRIEDMAN TEST, THE SECOND ARGUMENT (THE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2145)
 2145    FORMAT('      FIRST FACTOR (= BLOCK) VARIABLE)  MUST BE A')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2146)
 2146    FORMAT('      VARIABLE (AS OPPOSED TO A PARAMETER OR')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2147)
 2147    FORMAT('      FUNCTION).  ARGUMENT 2 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2148)
 2148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
           WRITE(ICOUT,2150)(IANS(I),I=1,MIN(IWIDTH,80))
 2150      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
C
C               *******************************************************
C               **  STEP 21B--                                       **
C               **  IF ARGUMENT 2 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2) **
C               **  FOR ARGUMENT 2 IS THE SAME AS ARGUMENT 1.        **
C               *******************************************************
C
      ISTEPN='21B'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRIE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.EQ.'V' .AND. N1.NE.N2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2161)
 2161   FORMAT('***** ERROR IN THE FRIEDMAN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2162)
 2162   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR VARIABLE 2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2163)
 2163   FORMAT('      OF THE FRIEDMAN TEST MUST BE THE SAME AS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2165)
 2165   FORMAT('      VARIABLE 1.  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2166)N1,N2
 2166   FORMAT('      N1 = ',I8,' N2 = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2169)
 2169   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2170)(IANS(I),I=1,MIN(IWIDTH,80))
 2170     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ****************************************
C               **  STEP 22--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 3  **
C               **  (THIS SHOULD ALSO BE A VARIABLE)  **
C               ****************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRIE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH31=IHARG(3)
      IH32=IHARG2(3)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH31,IH32,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,2241)
 2241    FORMAT('***** ERROR IN THE FRIEDMAN TEST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2242)
 2242    FORMAT('      FOR THE FRIEDMAN TEST, THE THIRD ARGUMENT (THE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2245)
 2245    FORMAT('      SECOND FACTOR (= TREATMENT) VARIABLE)  MUST BE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2246)
 2246    FORMAT('      A VARIABLE (AS OPPOSED TO A PARAMETER OR')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2247)
 2247    FORMAT('      FUNCTION).  ARGUMENT 3 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2248)
 2248    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
           WRITE(ICOUT,2250)(IANS(I),I=1,MIN(IWIDTH,80))
 2250      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE3=IUSE(ILOCV)
      ICOL3=IVALUE(ILOCV)
      N3=IN(ILOCV)
C
C               *******************************************************
C               **  STEP 21B--                                       **
C               **  IF ARGUMENT 3 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N3) **
C               **  FOR ARGUMENT 3 IS THE SAME AS ARGUMENT 1.        **
C               *******************************************************
C
      ISTEPN='22B'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRIE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE3.EQ.'V' .AND. N1.NE.N3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2261)
 2261   FORMAT('***** ERROR IN THE FRIEDMAN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2262)
 2262   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR VARIABLE 3')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2263)
 2263   FORMAT('      OF THE FRIEDMAN TEST MUST BE THE SAME AS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2265)
 2265   FORMAT('      VARIABLE 1.  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2266)N1,N3
 2266   FORMAT('      N1 = ',I8,' N3 = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2269)
 2269   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2270)(IANS(I),I=1,MIN(IWIDTH,80))
 2270     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
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
      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.LE.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4151)
 4151   FORMAT('***** ERROR IN THE FRIEDMAN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4152)
 4152   FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN EXTRACTED,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4153)IH11,IH12
 4153   FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING FROM ',
     1         'VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4154)
 4154   FORMAT('      (FOR WHICH THE FRIEDMAN TEST IS TO BE CARRIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4156)MINN2
 4156   FORMAT('      OUT) 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)THEN
          WRITE(ICOUT,4159)(IANS(I),I=1,MIN(IWIDTH,80))
 4159     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      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
        IJ=MAXN*(ICOL2-1)+I
        IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
        IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
        IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
        IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
        IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
        IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
        IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
        IJ=MAXN*(ICOL3-1)+I
        IF(ICOL2.LE.MAXCOL)XTEMP2(J)=V(IJ)
        IF(ICOL2.EQ.MAXCP1)XTEMP2(J)=PRED(I)
        IF(ICOL2.EQ.MAXCP2)XTEMP2(J)=RES(I)
        IF(ICOL2.EQ.MAXCP3)XTEMP2(J)=YPLOT(I)
        IF(ICOL2.EQ.MAXCP4)XTEMP2(J)=XPLOT(I)
        IF(ICOL2.EQ.MAXCP5)XTEMP2(J)=X2PLOT(I)
        IF(ICOL2.EQ.MAXCP6)XTEMP2(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
C               **********************************
C               **  STEP 52--                   **
C               **  CARRY OUT THE FRIEDMAN TEST **
C               **********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRIE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'FRIE')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5211)
 5211   FORMAT('***** FROM DPFRIE, AS WE ARE ABOUT TO CALL DPFRI2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5212)N1,N2,N3,NS1,MAXN
 5212   FORMAT('N1,N2,N3,NS1,MAXN = ',5I8)
        CALL DPWRST('XXX','BUG ')
        DO5215I=1,NS1
         WRITE(ICOUT,5216)I,Y(I),X(I),XTEMP2(I)
 5216    FORMAT('I,Y(I),X(I),XTEMP2(I) = ',I8,3E15.7)
         CALL DPWRST('XXX','BUG ')
 5215   CONTINUE
        WRITE(ICOUT,5231)IBUGA3
 5231   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL DPFRI2(Y,X,XTEMP2,NS1,
     1YTEMP,XTEMP,YRANK,RJ,DBLOCK,DTREAT,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
     1ICAPSW,ICAPTY,
     1IBUGA3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRIE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPFR'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF0 '
      VALUE0=CUT0
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF50'
      VALUE0=CUT50
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF75'
      VALUE0=CUT75
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF90'
      VALUE0=CUT90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF95'
      VALUE0=CUT95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF99'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='F999'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'FRI2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPFRIE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA2,IBUGA3,IBUGQ
 9012   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)N1,N2,N3,NS1
 9014   FORMAT('N1,N2,N3,NS1 = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)ICASEQ
 9015   FORMAT('ICASEQ = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)IFOUND,IERROR
 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPFRIT(IHARG,IARGT,ARG,NUMARG,IDEFFI,
     1IFRAIT,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FRACTAL ITERATIONS
C              THIS DEFINES THE MAXIMUM NUMBER OF POINTS TO
C              PLOT FOR FRACTAL PLOTS.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFFI (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--IFRAIT  (AN INTEGER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY-ALAN HECKERT
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--93/7
C     ORIGINAL VERSION--JULY    1993.
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.'ITER')GOTO1110
      GOTO1199
C
 1110 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(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPFRIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR FRACTAL ITERATIONS ',
     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,1131)
 1131 FORMAT('      FRACTAL ITERATIONS 20000')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      IHOLD=IDEFFI
      GOTO1180
C
 1160 CONTINUE
      IHOLD=ARG(NUMARG)+0.5
      IF(IHOLD.LE.0)IHOLD=IDEFFI
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IFRAIT=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IFRAIT
 1181 FORMAT('THE FRACTAL ITERATIONS HAS JUST BEEN SET TO ',
     1I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPFRI2(Y,BLOCK,TREAT,N,
     1YTEMP,XTEMP,YRANK,RJ,DBLOCK,DTREAT,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
     1ICAPSW,ICAPTY,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT FRIEDMAN'S TEST
C              NON-PARAMETRIC TWO-WAY ANOVA
C     EXAMPLE--FRIEDMAN TEST Y BLOCK TREAT
C     REFERENCE--"PRACTICAL NON-PARAMETRIC STATSTICS", CONOVER,
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/10
C     ORIGINAL VERSION--OCTOBER   2003.
C     UPDATED         --JANUARY   2006. FIX BUG IN RANKING
C                                       (UNCORRECTED VERSION WORKS
C                                       IF DATA ARE RANKS WITHIN
C                                       THE BLOCK).
C     UPDATED         --JANUARY   2006. SOME INFO THAT WAS SUPPOSSED
C                                       TO GO TO DPST2F.DAT WAS
C                                       GOING TO DPST1F.DAT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*3 IATEMP
C
      DOUBLE PRECISION DSUM1
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION BLOCK(*)
      DIMENSION TREAT(*)
      DIMENSION YRANK(*)
      DIMENSION RJ(*)
      DIMENSION DBLOCK(*)
      DIMENSION DTREAT(*)
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
C
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPFR'
      ISUBN2='I2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'FRI2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPFRI2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I),BLOCK(I),TREAT(I)
   57     FORMAT('I,Y(I),BLOCK(I),TREAT(I) = ',I8,3E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'FRI2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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 FRIEDMAN TEST--RESPONSE VARIABLE ',
     1       'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      HOLD=BLOCK(1)
      DO1235I=2,N
      IF(BLOCK(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM FRIEDMAN TEST--FIRST FACTOR VARIABLE ',
     1       'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
      HOLD=TREAT(1)
      DO1335I=2,N
      IF(TREAT(I).NE.HOLD)GOTO1339
 1335 CONTINUE
 1330 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1331)HOLD
 1331 FORMAT('***** NOTE FROM FRIEDMAN TEST--SECOND FACTOR VARIABLE ',
     1       'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1339 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR FRIEDMAN TEST       **
C               ******************************
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
C  STEP 1: COMPUTE NUMBER OF DISTINCT BLOCKS AND TREATMENTS
C
      CALL DISTIN(BLOCK,N,IWRITE,DBLOCK,NBLOCK,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      CALL DISTIN(TREAT,N,IWRITE,DTREAT,NTREAT,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C  STEP 2: COMPUTE TREATMENT RANKS WITHIN EACH BLOCK
C
      DO4010I=1,N
        YRANK(I)=-1.0
 4010 CONTINUE
C
      DO4110I=1,NBLOCK
        HOLD=DBLOCK(I)
        ICOUNT=0
        DO4120J=1,N
          IF(BLOCK(J).EQ.HOLD)THEN
            ICOUNT=ICOUNT+1
            YTEMP(ICOUNT)=Y(J)
          ENDIF
 4120   CONTINUE
        CALL RANK(YTEMP,ICOUNT,IWRITE,XTEMP,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOUNT=0
        DO4130J=1,N
          IF(BLOCK(J).EQ.HOLD)THEN
            ICOUNT=ICOUNT+1
CCCCC       2006/1: EXTRACT RANKING CORRECTLY!
CCCCC       YTEMP(ICOUNT)=Y(J)
CCCCC       YRANK(J)=YTEMP(ICOUNT)
            YRANK(J)=XTEMP(ICOUNT)
          ENDIF
 4130   CONTINUE
 4110 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'FRI2')THEN
        DO4140I=1,N
          WRITE(ICOUT,4142)I,Y(I),YRANK(I)
 4142     FORMAT('I,Y(I),YRANK(I) = ',I8,E15.7,F12.2)
          CALL DPWRST('XXX','BUG ')
 4140   CONTINUE
      ENDIF
C
C  STEP 3: NOW COMPUTE RANK SUMS FOR EACH TREATMENT
C
      DO4210I=1,NTREAT
        HOLD=DTREAT(I)
        DSUM1=0.0D0
        DO4220J=1,N
          IF(TREAT(J).EQ.HOLD)THEN
            DSUM1=DSUM1 + DBLE(YRANK(J))
          ENDIF
 4220   CONTINUE
        RJ(I)=REAL(DSUM1)
 4210 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'FRI2')THEN
        DO4240I=1,NTREAT
          WRITE(ICOUT,4242)I,RJ(I)
 4242     FORMAT('I,RJ(I) = ',I8,E15.7)
          CALL DPWRST('XXX','BUG ')
 4240   CONTINUE
      ENDIF
C
C  STEP 4: NOW COMPUTE VARIOUS QUANTITIES BASED ON RJ
C
      ANB=REAL(NBLOCK)
      AK=REAL(NTREAT)
      C1=ANB*AK*(AK+1.0)**2/4.0
      DSUM1=0.0D0
      DO4310I=1,N
        DSUM1=DSUM1 + DBLE(YRANK(I))**2
 4310 CONTINUE
      A1=REAL(DSUM1)
      DSUM1=0.0D0
      DO4320I=1,NTREAT
        DSUM1=DSUM1 + RJ(I)**2
 4320 CONTINUE
      T1=(AK-1.0)*(REAL(DSUM1)-ANB*C1)/(A1-C1)
      T2=(ANB-1.0)*T1/(ANB*(AK-1.0) - T1)
C
      STATVA=T2
      NUMDF1=NTREAT-1
      NUMDF2=(NBLOCK-1)*(NTREAT-1)
      CALL FCDF(STATVA,NUMDF1,NUMDF2,STATCD)
C
      CUT0=0.0
      CALL FPPF(.50,NUMDF1,NUMDF2,CUT50)
      CALL FPPF(.75,NUMDF1,NUMDF2,CUT75)
      CALL FPPF(.90,NUMDF1,NUMDF2,CUT90)
      CALL FPPF(.95,NUMDF1,NUMDF2,CUT95)
      CALL FPPF(.99,NUMDF1,NUMDF2,CUT99)
      CALL FPPF(.999,NUMDF1,NUMDF2,CUT999)
C
      IDF=(NBLOCK-1)*(NTREAT-1)
      CALL TPPF(0.95,IDF,T95)
      CALL TPPF(0.975,IDF,T975)
      CALL TPPF(0.995,IDF,T995)
      TERM1=(A1-C1)*2.0*ANB/((ANB-1.0)*(AK-1.0))
      TERM2=1.0 - T1/(ANB*(AK-1.0))
      CONTRA=SQRT(TERM1*TERM2)
      CONTR1=T95*CONTRA
      CONTR2=T975*CONTRA
      CONTR3=T995*CONTRA
C
      ICONC1='ACCEPT'
      ICONC2='ACCEPT'
      ICONC3='ACCEPT'
C
      IF(STATVA.GT.CUT95)ICONC2='REJECT'
C
C               *****************************
C               **   STEP 42-              **
C               **   WRITE OUT THE TABLE   **
C               *****************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'FRI2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='FRI2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='FRI2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      WRITE(IOUNI1,2005)
 2005 FORMAT(4X,'RESPONSE',13X,'RANK',11X,'BLOCK',8X,'TREATMENT')
      DO2010I=1,N
        WRITE(IOUNI1,2011)Y(I),YRANK(I),BLOCK(I),TREAT(I)
 2011   FORMAT(1X,E15.7,F15.2,F15.2,F15.2)
 2010 CONTINUE
C
      WRITE(IOUNI2,2021)CONTRA
 2021 FORMAT(1X,'Contrast term:          ',E15.7)
      WRITE(IOUNI2,2022)CONTR1
 2022 FORMAT(1X,'Contrast term*t(0.95):  ',E15.7)
      WRITE(IOUNI2,2023)CONTR2
 2023 FORMAT(1X,'Contrast term*t(0.975): ',E15.7)
      WRITE(IOUNI2,2024)CONTR3
 2024 FORMAT(1X,'Contrast term*t(0.995): ',E15.7)
      WRITE(IOUNI2,2025)
 2025 FORMAT(10X,'I',10X,'J',8X,'R(I)-R(J)')
C
      DO2030I=1,NTREAT
        DO2039J=1,NTREAT
          IF(I.LT.J)THEN
            ADIFF=RJ(I)-RJ(J)
            IATEMP='   '
            IF(ABS(ADIFF).GE.CONTR1)IATEMP(1:1)='*'
            IF(ABS(ADIFF).GE.CONTR2)IATEMP(2:2)='*'
            IF(ABS(ADIFF).GE.CONTR3)IATEMP(3:3)='*'
            WRITE(IOUNI2,2037)I,J,ADIFF,IATEMP
 2037       FORMAT(3X,I8,3X,I8,5X,E15.7,A3)
          ENDIF
 2039   CONTINUE
 2030 CONTINUE
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
C               ******************************
C               **   STEP 43--              **
C               **   WRITE OUT EVERYTHING   **
C               **   FOR FRIEDMAN TEST      **
C               ******************************
C
      ISTEPN='43'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'FRI2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: WRITE HEADER
C
        WRITE(ICOUT,5001)
 5001   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
 5002   FORMAT('<CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5003)
 5003   FORMAT('<B>FRIEDMAN TEST FOR IDENTICAL TREATMENT ',
     1         'EFFECTS</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
 5004   FORMAT('</CENTER> <BR><BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START LIST
C
        WRITE(ICOUT,5005)
 5005   FORMAT('<OL>')
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2A: LIST ITEM 1
C
        WRITE(ICOUT,5006)
 5006   FORMAT('   <LI>Statistics:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
 5007   FORMAT('       <P>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
 5011   FORMAT('       <TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
 5021   FORMAT('         <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
 5023   FORMAT('            <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5025)
 5025   FORMAT('               Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
 5027   FORMAT('            </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
 5026   FORMAT('            <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)N
 5029   FORMAT('                ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
 5028   FORMAT('         </TR>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5041)
 5041   FORMAT('               Number of Blocks:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)NBLOCK
        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,5042)
 5042   FORMAT('               Number of Treatments:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)NTREAT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
 5043   FORMAT('               Friedman Test Statstic (Original):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)T1
 5051   FORMAT('            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5044)
 5044   FORMAT('               A1 (Sum of Squares of Ranks):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)A1
        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,5045)
 5045   FORMAT('               C1 (Correction Factor):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)C1
        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,5046)
 5046   FORMAT('               Friedman Test Statistic (Conover):')
        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,5091)
 5091   FORMAT('       </TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: LIST ITEM 2
C
        WRITE(ICOUT,5066)
 5066   FORMAT('   <LI>Percent Points of the F Reference ',
     1         'Distribution<br>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
 5067   FORMAT('       for Friedman Test Statistic:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
 5071   FORMAT('               0    Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
 5072   FORMAT('               50   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT50
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
 5073   FORMAT('               75   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT75
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
 5074   FORMAT('               90   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
 5075   FORMAT('               95   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5076)
 5076   FORMAT('               99   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT99
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5077)
 5077   FORMAT('               99.9 Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT999
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5078)100.0*STATCD
 5078   FORMAT('<br>               ',G15.7,' Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)STATVA
 5052   FORMAT('<br>            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2C: LIST ITEM 3
C
        WRITE(ICOUT,5081)
 5081   FORMAT('   <LI>Conclusion (at the 5% level):')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,5087)NTREAT
 5087     FORMAT('        The ',I8,' treatments have identical ',
     1           'effects.')
        ELSE
          WRITE(ICOUT,5088)NTREAT
 5088     FORMAT('        The ',I8,' treatments do not have ',
     1           'identical effects.')
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
 5093   FORMAT('</OL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5095)
 5095   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
 8001   FORMAT('{',A1,'bf FRIEDMAN TEST FOR IDENTICAL TREATMENT ',
     1         'EFFECTS}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8004   FORMAT(A1,'begin{center}')
 8005   FORMAT(A1,'end{center}')
 8006   FORMAT(A1,'end{verbatim}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
 8011   FORMAT(A1,'begin{enumerate}')
 8012   FORMAT(A1,'end{enumerate}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        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 F Reference ',
     1         'Distribution:')
 8023   FORMAT(5X,A1,'item Conclusion (at the 5',A1,'% level):')
 8030   FORMAT(11X,A1,'begin{tabular} {lr}')
 8031   FORMAT(11X,'Number of Observations: & ',I8,2X,A1,A1)
 8032   FORMAT(11X,'Number of Blocks: & ',I8,2X,A1,A1)
 8033   FORMAT(11X,'Number of Treatments: & ',I8,2X,A1,A1)
 8034   FORMAT(11X,'Friedman Test Statistic (Original): & ',G15.7,
     1         2X,A1,A1)
 8035   FORMAT(11X,'A1 (Sum of Squares of Ranks): & ',G15.7,2X,A1,A1)
 8036   FORMAT(11X,'C1 (Correction Factor): & ',G15.7,2X,A1,A1)
 8037   FORMAT(11X,'Friedman Test Statistic (Conover): & ',
     1         G15.7,2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8041   FORMAT(11X,G15.7,' Percent Point: & ',G15.7,2X,A1,A1)
 8042   FORMAT(11X,'The ',I8,' treatments have identical effects.',
     1         2X,A1,A1)
 8043   FORMAT(11X,'The ',I8,' treatments do not have identical ',
     1         'effects.',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.9   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)NBLOCK,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)NTREAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)T1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)A1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8036)C1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8037)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8022)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)CUT0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)CUT50,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)CUT90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8047)CUT95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8048)CUT99,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)CUT999,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)100.*STATCD,STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,8042)NTREAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8043)NTREAT,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')
        WRITE(ICOUT,7211)
 7211   FORMAT('              FRIEDMAN TEST FOR TWO-WAY ANOVA')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7220)
 7220   FORMAT('1. STATISTICS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7221)N
 7221   FORMAT(6X,'NUMBER OF OBSERVATIONS              = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7222)NBLOCK
 7222   FORMAT(6X,'NUMBER OF BLOCKS                    = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7223)NTREAT
 7223   FORMAT(6X,'NUMBER OF TREATMENTS                = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7224)T1
 7224   FORMAT(6X,'FRIEDMAN TEST STATISTIC (ORIGINAL)  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7225)A1
 7225   FORMAT(6X,'A1 (SUM OF SQUARES OF RANKS)        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7226)C1
 7226   FORMAT(6X,'C1 (CORRECTION FACTOR)              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7228)STATVA
 7228   FORMAT(6X,'FRIEDMAN TEST STATISTIC (CONOVER)   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
 7240   FORMAT('2. PERCENT POINTS OF THE F REFERENCE DISTRIBUTION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7241)
 7241   FORMAT('   FOR FRIEDMAN TEST STATISTIC')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7265)CUT0
 7265   FORMAT(6X,'0          % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7266)CUT50
 7266   FORMAT(6X,'50         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7267)CUT75
 7267   FORMAT(6X,'75         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7268)CUT90
 7268   FORMAT(6X,'90         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7269)CUT95
 7269   FORMAT(6X,'95         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7270)CUT99
 7270   FORMAT(6X,'99         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7271)CUT999
 7271   FORMAT(6X,'99.9       % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7280)100.*STATCD,STATVA
 7280   FORMAT(6X,G15.7,'   % Point:  ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7291)
 7291   FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,7293)NTREAT
 7293     FORMAT(6X,'THE ',I8,' TREATMENTS HAVE IDENTICAL EFFECTS')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,7295)NTREAT
 7295     FORMAT(6X,'THE ',I8,' TREATMENTS DO NOT HAVE IDENTICAL ',
     1           'EFFECTS')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,9212)
 9212     FORMAT(6X,'RESPONSE, RANKED RESPONSE, BLOCK AND TREATMENT ',
     1           ' WRITTEN TO FILE DPST1F.DAT')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9214)
 9214     FORMAT(6X,'TREATMENT RANKS AND COMPARISONS WRITTEN TO FILE ',
     1           ' DPST2F.DAT')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'FRI2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPFRI2--')
        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')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPFRPA(ICOM,IHARG,IHARG2,NUMARG,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPFRPA(ICOM,IHARG,NUMARG,
     1IDEFPA,
     1IX1FPA,IX2FPA,IY1FPA,IY2FPA,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FRAME PATTERN SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH FRAME PATTERN SWITCHES DEFINE THE PATTERN
C              FOR EACH OF THE 4 FRAME LINES.
C              THE CONTENTS OF A FRAME PATTERN SWITCH ARE
C              A PATTERN.
C              THE FRAME PATTERN SWITCHES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C              IX1FPA,IX2FPA,IY1FPA,IY2FPA.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFPA
C     OUTPUT ARGUMENTS--IX1FPA (A HOLLERITH VECTOR)
C                     --IX2FPA (A HOLLERITH VECTOR)
C                     --IY1FPA (A HOLLERITH VECTOR)
C                     --IY2FPA (A HOLLERITH VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   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 IX1FPA
      CHARACTER*4 IX2FPA
      CHARACTER*4 IY1FPA
      CHARACTER*4 IY2FPA
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---------------------------------------------------------------------
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
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'PATT')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL FRAMES    ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XFRA')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'
      IX1FPA=IHOLD
      IX2FPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE FRAME PATTERN (FOR BOTH HORIZONTAL ',
     1'FRAME 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               **  ONLY THE BOTTOM HORIZONTAL FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1FR')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'
      IX1FPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE FRAME PATTERN (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      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               **  ONLY THE TOP    HORIZONTAL FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2FR')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'
      IX2FPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE FRAME PATTERN (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      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
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   FRAMES    ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YFRA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFPA
      GOTO1480
C
 1460 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'
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1FPA=IHOLD
      IY2FPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE FRAME PATTERN (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1FR')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFPA
      GOTO1580
C
 1560 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'
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1FPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE FRAME PATTERN (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2FR')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFPA
      GOTO1680
C
 1660 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'
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2FPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE FRAME PATTERN (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME FRAME LINES ARE TO BE CHANGED      **
C               *****************************************************
C
      IF(ICOM.EQ.'FRAM')GOTO1700
      IF(ICOM.EQ.'XYFR')GOTO1700
      IF(ICOM.EQ.'YXFR')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'PATT')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFPA
      GOTO1780
C
 1760 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'
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1FPA=IHOLD
      IX2FPA=IHOLD
      IY1FPA=IHOLD
      IY2FPA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE FRAME PATTERN (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPFRTE(XTEMP1,MAXNXT,
     1ICASAN,ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--PERFORM EITHER A FREQUENCY OR FREQUENCY WITHIN A BLOCK
C              TEST FOR RANDOMNESS
C     EXAMPLE--FREQUENCY TEST Y
C              FREQUENCY WITHIN A BLOCK TEST Y
C     REFERENCE--A STATISTICAL TEST SUITE FOR RANDOM AND PSUEDORANDOM
C                NUMBER GENERATORS FOR CRYPTOGRAPHIC APPLICATIONS,
C                ANDREW RUKHIN, JUAN SOTO, JAMES NECHVATAL, MILES SMID,
C                ELAINE BARKER, STEFAN LEIGH, MARK LEVENSON,
C                MARK VANGEL, DAVID BANKS, ALAN HECKERT, JAMES DRAY,
C                SAN VO.  NIST SPECIAL PUBLICATION 800-22,
C                OCTOBER 2000, PP. 14-16.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/11
C     ORIGINAL VERSION--NOVEMBER  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASAN
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
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'
C
      DIMENSION YTEMP1(MAXOBV)
      DIMENSION YTEMP2(MAXOBV)
      DIMENSION YTEMP3(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),YTEMP1(1))
      EQUIVALENCE (GARBAG(IGARB2),YTEMP2(1))
      EQUIVALENCE (GARBAG(IGARB3),YTEMP3(1))
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPFR'
      ISUBN2='TE  '
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 FREQUENCY        TEST CASE  **
C               ********************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRTE')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPFRTE--')
        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 ')
      ENDIF
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' .OR. ISUBRO.EQ.'FRTE')
     1CALL 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 DPFRTE--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR THE FREQUENCY 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' .OR. ISUBRO.EQ.'FRTE')
     1CALL 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 DPFRTE--')
      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 FREQUENCY 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)THEN
        WRITE(ICOUT,1220)(IANS(I),I=1,MIN(80,IWIDTH))
 1220   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      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' .OR. ISUBRO.EQ.'FRTE')
     1CALL 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.'ON' .OR. ISUBRO.EQ.'FRTE')THEN
        WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091   FORMAT('NUMARG,ILOCQ = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
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' .OR. ISUBRO.EQ.'FRTE')
     1CALL 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 DPFRTE--')
      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 FREQUENCY 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)THEN
        WRITE(ICOUT,4159)(IANS(I),I=1,MIN(80,IWIDTH))
 4159   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      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 FREQUENCY TEST        **
C               ***********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'FRTE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'FRTE')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5211)
 5211   FORMAT('***** FROM DPFRTE, AS WE ARE ABOUT TO CALL DPFRT2--')
        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 ')
      ENDIF
C
 5790 CONTINUE
C
      IF(ICASAN.EQ.'FBTE')THEN
        IH11='M   '
        IH12='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IH11,IH12,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'NO')THEN
          AM=VALUE(ILOCP)
          M=INT(AM+0.5)
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5811)
 5811     FORMAT('***** ERROR: FOR FREQUENCY WITHIN A BLOCK TEST, THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5812)
 5812     FORMAT('      DESIRED BLOCK SIZE WAS NOT SET.  TO SET THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5813)
 5813     FORMAT('      BLOCK SIZE, ENTER THE COMMAND')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5814)
 5814     FORMAT('      LET M = value')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        IF(M.LT.20)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5821)
 5821     FORMAT('***** WARNING: FOR THE FREQUENCY WITHIN A BLOCK ',
     1           'TEST, THE ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5822)
 5822     FORMAT('      RECOMMENDATION FOR THE MINIMUM BLOCK SIZE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,5823)M
 5823     FORMAT('      IS 20.  THE SPECIFIED BLOCK SIZE IS ',I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
      CALL DPFRT2(Y,NS1,
     1XTEMP1,MAXNXT,
     1ICAPSW,ICAPTY,ICASAN,M,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,
     1YTEMP1,YTEMP2,YTEMP3,
     1ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'FRTE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPFR'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF50'
      VALUE0=CUT50
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF75'
      VALUE0=CUT75
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF90'
      VALUE0=CUT90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF95'
      VALUE0=CUT95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF99'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
 
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'FRTE')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPFRTE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012   FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)IBUGQ
 9013   FORMAT('IBUGQ = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)NLEFT,NS
 9014   FORMAT('NLEFT,NS = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)ICASEQ
 9015   FORMAT('ICASEQ = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)IFOUND,IERROR
 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPFRT2(Y,N,
     1XTEMP,MAXNXT,
     1ICAPSW,ICAPTY,ICASAN,M,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,
     1YTEMP1,YTEMP2,YTEMP3,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT EITHER THE FREQUENCY TEST
C              FOR RANDOMNESS OR THE FREQUENCY WITHIN A BLOCK TEST
C              FOR RANDOMNESS.
C     EXAMPLE--FREQUENCY TEST Y
C              FREQUENCY WITHIN A BLOCK TEST Y
C     REFERENCE--A STATISTICAL TEST SUITE FOR RANDOM AND PSUEDORANDOM
C                NUMBER GENERATORS FOR CRYPTOGRAPHIC APPLICATIONS,
C                ANDREW RUKHIN, JUAN SOTO, JAMES NECHVATAL, MILES SMID,
C                ELAINE BARKER, STEFAN LEIGH, MARK LEVENSON,
C                MARK VANGEL, DAVID BANKS, ALAN HECKERT, JAMES DRAY,
C                SAN VO.  NIST SPECIAL PUBLICATION 800-22,
C                OCTOBER 2000, PP. 14-18.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/11
C     ORIGINAL VERSION--NOVEMBER  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ICASAN
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*1 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(*)
      DIMENSION YTEMP1(*)
      DIMENSION YTEMP2(*)
      DIMENSION YTEMP3(*)
C
      DOUBLE PRECISION DRESLT
      DOUBLE PRECISION DGAMIP
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='DPFR'
      ISUBN2='T2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'FRT2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPFRT2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'FRT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN FREQUENCY RANDOMNESS TEST.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      AT LEAST SIX OBSERVATIONS REQUIRED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
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 FREQUENCY RANDOMNESS TEST--VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
C               *******************************
C               **  STEP 2--                 **
C               **  COMPUTE THE NUMBER OF    **
C               **  DISTINCT VALUES.         **
C               *******************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'FRT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='NO'
      CALL DISTIN(Y,N,IWRITE,YTEMP1,NDIST,IBUGA3,IERROR)
C
      IF(IERROR.EQ.'YES')GOTO9000
      IF(NDIST.GT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2001)
 2001   FORMAT('***** ERROR IN FREQUENCY RANDOMNESS TEST.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2003)
 2003   FORMAT('      FOR FREQUENCY TEST, AT MOST TWO DISTINCT ',
     1         'VALUES ARE ALLOWED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2005)NDIST
 2005   FORMAT('      NUMBER OF DISTINCT VALUES = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(ICASAN.EQ.'FRTE')GOTO2000
      IF(ICASAN.EQ.'FBTE')GOTO3000
C
 2000 CONTINUE
      IF(NDIST.EQ.1)THEN
        DO2010I=1,N
          YTEMP2(I)=1.0
 2010   CONTINUE
      ELSE
        ALOW=MIN(YTEMP1(1),YTEMP1(2))
        AHIGH=MAX(YTEMP1(1),YTEMP1(2))
        SN=0.0
        DO2020I=1,N
          IF(Y(I).EQ.ALOW)THEN
            SN=SN - 1.0
          ELSE
            SN=SN + 1.0
          ENDIF
 2020   CONTINUE
      ENDIF
C
C               ******************************
C               **  STEP 42--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR FREQUENCY     TEST  **
C               ******************************
C
 4400 CONTINUE
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      STATVA=ABS(SN)/SQRT(REAL(N))
C
      ARG1=STATVA
      CALL NORCDF(ARG1,RESULT)
      TERM=2.0*RESULT-1.0
      STATCD=1.0-TERM
CCCCC CDF2=100.0*STATCD
C
      CUT0=0.
C
      ALPHA=.5
      P2=1.0-ALPHA/2.0
      CALL NORPPF(P2,CUT50)
C
      ALPHA=.25
      P2=1.0-ALPHA/2.0
      CALL NORPPF(P2,CUT75)
C
      ALPHA=.10
      P2=1.0-ALPHA/2.0
      CALL NORPPF(P2,CUT90)
C
      ALPHA=.05
      P2=1.0-ALPHA/2.0
      CALL NORPPF(P2,CUT95)
C
      ALPHA=.025
      P2=1.0-ALPHA/2.0
      CALL NORPPF(P2,CUT975)
C
      ALPHA=.01
      P2=1.0-ALPHA/2.0
      CALL NORPPF(P2,CUT99)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
      ICONC4='REJECT'
C
C               *********************************
C               **   STEP 52--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR FREQUENCY TEST        **
C               *********************************
C
      ISTEPN='52'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5101)
 5101   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5108)
 5108   FORMAT('<CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5102)
 5102   FORMAT('<B>FREQUENCY TEST FOR RANDONNESS</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5109)
 5109   FORMAT('</CENTER>')
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5104)
C5104   FORMAT('<BR><BR>')
CCCCC
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5105)
 5105   FORMAT('<OL>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5206)
 5206   FORMAT('   <LI>Hypotheis:<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5208)
 5208   FORMAT('       H<SUB>0</SUB>: The data are random<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5210)
 5210   FORMAT('       H<SUB>a</SUB>: The data are not random<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5106)
 5106   FORMAT('   <LI>Statistics:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
 5107   FORMAT('       <BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('       <TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
 5121   FORMAT('         <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
 5123   FORMAT('            <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
 5125   FORMAT('               Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
 5127   FORMAT('            </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
 5126   FORMAT('            <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)N
 5129   FORMAT('                ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
 5128   FORMAT('         </TR>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5142)
 5142   FORMAT('               Sum of +1 and -1 Values:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)SN
        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,5146)
 5146   FORMAT('               Frequency Test Statstic Value:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)STATVA
 5154   FORMAT('            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
 5191   FORMAT('       </TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5164)
C5164   FORMAT('   <LI>Percent Points of Reference Half-Normal ',
CCCCC1         '       Distribution (Critical Values): <BR>')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5165)
C5165   FORMAT('       (Reject Hypothesis of Randomness if test ',
CCCCC1         '       statistic value')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5166)
C5166   FORMAT('       is greater than percent point value.')
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5107)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5111)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5121)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5123)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5167)
C5167   FORMAT('               90% Point:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5126)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5151)CUT90
C5151   FORMAT('            ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5128)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5121)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5123)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5168)
C5168   FORMAT('               95% Point:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5126)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5151)CUT95
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5128)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5121)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5123)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5169)
C5169   FORMAT('               97.5% Point:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5126)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5151)CUT975
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5128)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5121)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5123)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5170)
C5170   FORMAT('               99% Point:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5126)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5151)CUT99
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5128)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5121)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5123)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5172)
C5172   FORMAT('               P-Value:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5126)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5151)STATCD
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5128)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5173)STATCD
 5173   FORMAT('   <LI>P-Value = ',G15.7,'<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5174)
 5174   FORMAT('       (Reject hypothesis of randomness if P-Value ',
     1         'is less than alpha)')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5176)
 5176   FORMAT('   <LI>Conclusion (at the 5% Level):')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LT.CUT95)THEN
          WRITE(ICOUT,5180)
          CALL DPWRST('XXX','WRIT')
 5180     FORMAT('        The data are random.')
        ELSE
          WRITE(ICOUT,5190)
          CALL DPWRST('XXX','WRIT')
 5190     FORMAT('        The data are not random.')
        ENDIF
        WRITE(ICOUT,5997)
 5997   FORMAT('</OL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5999)
 5999   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8001   FORMAT('{',A1,'bf FREQUENCY TEST FOR RANDOMNESS}',2X,A1,A1)
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8007   FORMAT(A1,'begin{center}')
 8008   FORMAT(A1,'end{center}')
 8012   FORMAT(A1,'end{verbatim}')
 8017   FORMAT(A1,'begin{enumerate}')
 8018   FORMAT(A1,'end{enumerate}')
 8019   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8020   FORMAT(5X,A1,'item Hypothesis:')
 8021   FORMAT(5X,A1,'item Statistics:')
 8022   FORMAT(5X,A1,'item Critical Values:')
 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,'Sum of +1 and -1 Values: & ',G15.7,2X,A1,A1)
 8034   FORMAT(11X,'Frequency Test Statistic Value: & ',
     1         G15.7,2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8151   FORMAT(11X,'$H_0$: The data are random ')
 8152   FORMAT(11X,'$H_a$: The data are not random')
C
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8151)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8152)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)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)SN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8022)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C8041   FORMAT(11X,'90',A1,'% Point: & ',G15.7,2X,A1,A1)
C8042   FORMAT(11X,'95',A1,'% Point: & ',G15.7,2X,A1,A1)
C8043   FORMAT(11X,'97.5',A1,'% Point: & ',G15.7,2X,A1,A1)
C8044   FORMAT(11X,'99',A1,'% Point: & ',G15.7,2X,A1,A1)
 8046   FORMAT(11X,'P-Value of Statistic: & ',G15.7,2X,A1,A1)
 8047   FORMAT(11X,'(Reject hypothesis of randomness if p-value ',
     1         'is less than $',A1,'alpha$) & ',2X,A1,A1)
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8041)IBASLC,CUT90,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8042)IBASLC,CUT95,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8043)IBASLC,CUT975,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8044)IBASLC,CUT99,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)STATCD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8047)IBASLC,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,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8050   FORMAT(11X,A1,'newline')
 8091   FORMAT(A1,'end{enumerate}')
 8092   FORMAT(A1,'begin{verbatim}')
        IF(STATVA.LT.CUT95)THEN
          WRITE(ICOUT,8051)
          CALL DPWRST('XXX','WRIT')
 8051     FORMAT('        The data are random.')
        ELSE
          WRITE(ICOUT,8061)
          CALL DPWRST('XXX','WRIT')
 8061     FORMAT('        The data are not random.')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8008)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8092)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C  JUST A PLACEHOLDER FOR NOW.
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5211)
 5211   FORMAT('              FREQUENCY TEST FOR RANDOMNESS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5231)
 5231   FORMAT('1. HYPOTHESIS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5232)
 5232   FORMAT(3X,'H0: THE DATA ARE RANDOM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5233)
 5233   FORMAT(3X,'HA: THE DATA ARE NOT RANDOM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
 5241   FORMAT('2. STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5242)N
 5242   FORMAT(3X,'NUMBER OF OBSERVATIONS      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5343)SN
 5343   FORMAT(3X,'SUM OF +1 AND -1 VALUES     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5349)STATVA
 5349   FORMAT(3X,'FREQUENCY TEST STATISTIC    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5438)
C5438   FORMAT('2. PERCENT POINTS OF THE REFERENCE HALF-NORMAL ',
CCCCC1         'DISTRIBUTION')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5439)
C5439   FORMAT('   (REJECT HYPOTHESIS OF RANDOMNESS IF TEST STATISTIC ',
CCCCC1         'VALUE')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5440)
C5440   FORMAT('   IS GREATER THAN PERCENT POINT VALUE)')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5441)
C5441   FORMAT(3X,'FOR FREQUENCY TEST STATISTIC')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5445)CUT0
C5445   FORMAT(6X,'0          % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5446)CUT50
C5446   FORMAT(6X,'50         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5447)CUT75
C5447   FORMAT(6X,'75         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5448)CUT90
C5448   FORMAT(6X,'90         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5449)CUT95
C5449   FORMAT(6X,'95         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5450)CUT975
C5450   FORMAT(6X,'97.5       % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5451)CUT99
C5451   FORMAT(6X,'99         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5453)STATCD
 5453   FORMAT('3. P-VALUE OF STATISTIC  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5454)
 5454   FORMAT('   (REJECT HYPOTHESIS OF RANDOMNESS IF P-VALUE IS ',
     1         'LESS THAN ALPHA)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5561)
 5561   FORMAT('4. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LT.CUT95)THEN
          WRITE(ICOUT,5563)
 5563     FORMAT(3X,'THE DATA ARE RANDOM.')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5565)
 5565     FORMAT(3X,'THE DATA ARE NOT RANDOM.')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
      GOTO9000
C
 3000 CONTINUE
C
      NBLOCK=N/M
      AMNSZ=0.01*REAL(N)
C
      IF(NBLOCK.GE.100)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3011)
 3011   FORMAT('***** WARNING: THE NUMBER OF BLOCKS IS GREATER')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3012)
 3012   FORMAT('      THAN THE RECOMMENDED MAXIMUM OF 100.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3013)N
 3013   FORMAT('      SAMPLE SIZE       = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3014)M
 3014   FORMAT('      BLOCK SIZE        = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3015)NBLOCK
 3015   FORMAT('      NUMBER OF BLOCKS  = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(M.LE.INT(AMNSZ))THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3021)
 3021   FORMAT('***** WARNING: THE BLOCK SIZE IS LESS THAN THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3022)INT(AMNSZ)
 3022   FORMAT('      RECOMMENDED MINIMUM OF ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3023)N
 3023   FORMAT('      SAMPLE SIZE                     = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3024)M
 3024   FORMAT('      BLOCK SIZE                      = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3025)NBLOCK
 3025   FORMAT('      NUMBER OF BLOCKS                = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3026)INT(AMNSZ)
 3026   FORMAT('      RECOMMENDED MINIMUM BLOCK SIZE  = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(M.GT.N)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3031)
 3031   FORMAT('***** ERROR: THE BLOCK SIZE IS GREATER THAN THE ',
     1         'SAMPLE SIZE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3033)N
 3033   FORMAT('      SAMPLE SIZE                     = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3034)M
 3034   FORMAT('      BLOCK SIZE                      = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3035)NBLOCK
 3035   FORMAT('      NUMBER OF BLOCKS                = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3036)INT(AMNSZ)
 3036   FORMAT('      RECOMMENDED MINIMUM BLOCK SIZE  = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NDIST.NE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3041)NDIST
 3041   FORMAT('***** ERROR: THE RESPONSE VARIBLE CONTAINS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3043)
 3043   FORMAT('      DISTINCT VALUES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      ALOW=MIN(YTEMP1(1),YTEMP1(2))
      AHIGH=MAX(YTEMP1(1),YTEMP1(2))
      AM=REAL(M)
C
      SUM=0.0
      DO3110K=1,NBLOCK
        ISTRT=(K-1)*M+1
        ISTOP=K*M
        AONES=0
        DO3120I=ISTRT,ISTOP
          IF(Y(I).EQ.AHIGH)AONES=AONES+1.0
 3120   CONTINUE
        API=AONES/AM
        SUM=SUM + (API-0.5)**2
 3110 CONTINUE
C
      STATVA=4.0*AM*SUM
      DRESLT=1.0D0 - DGAMIP(DBLE(NBLOCK)/2.0D0,DBLE(STATVA)/2.0D0)
      STATCD=SNGL(DRESLT)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
      ICONC4='REJECT'
C
C               *********************************
C               **   STEP 62--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR FREQUENCY TEST        **
C               *********************************
C
      ISTEPN='62'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5601)
 5601   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5608)
 5608   FORMAT('<CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5602)
 5602   FORMAT('<B>FREQUENCY WITHIN A BLOCK TEST FOR RANDONNESS</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5609)
 5609   FORMAT('</CENTER>')
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5604)
C5604   FORMAT('<BR><BR>')
CCCCC
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5605)
 5605   FORMAT('<OL>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5706)
 5706   FORMAT('   <LI>Hypotheis:<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5708)
 5708   FORMAT('       H<SUB>0</SUB>: The data are random<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5710)
 5710   FORMAT('       H<SUB>a</SUB>: The data are not random<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5607)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5606)
 5606   FORMAT('   <LI>Statistics:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5607)
 5607   FORMAT('       <BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5611)
 5611   FORMAT('       <TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5621)
 5621   FORMAT('         <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
 5623   FORMAT('            <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5625)
 5625   FORMAT('               Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
 5627   FORMAT('            </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5626)
 5626   FORMAT('            <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5629)N
 5629   FORMAT('                ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5628)
 5628   FORMAT('         </TR>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5621)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5642)
 5642   FORMAT('               Block Size:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5626)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5629)M
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5628)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5621)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5643)
 5643   FORMAT('               Number of Observations Within a Block:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5626)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5629)NBLOCK
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5628)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5621)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5646)
 5646   FORMAT('               Frequency Test Statstic Value:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5626)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5654)STATVA
 5654   FORMAT('            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5628)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5991)
 5991   FORMAT('       </TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5607)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5664)
C5664   FORMAT('   <LI>Percent Points of Reference Half-Normal ',
CCCCC1         '       Distribution (Critical Values): <BR>')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5665)
C5665   FORMAT('       (Reject Hypothesis of Randomness if test ',
CCCCC1         '       statistic value')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5666)
C5666   FORMAT('       is greater than percent point value.')
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5607)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5611)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5621)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5623)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5667)
C5667   FORMAT('               90% Point:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5626)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5651)CUT90
C5651   FORMAT('            ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5628)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5621)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5623)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5668)
C5668   FORMAT('               95% Point:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5626)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5651)CUT95
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5628)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5621)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5623)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5669)
C5669   FORMAT('               97.5% Point:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5626)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5651)CUT975
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5628)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5621)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5623)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5670)
C5670   FORMAT('               99% Point:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5626)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5651)CUT99
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5628)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5621)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5623)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5672)
C5672   FORMAT('               P-Value:')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5626)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5651)STATCD
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5627)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5628)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5673)STATCD
 5673   FORMAT('   <LI>P-Value = ',G15.7,'<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5674)
 5674   FORMAT('       (Reject hypothesis of randomness if P-Value ',
     1         'is less than alpha)')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5607)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5607)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5676)
 5676   FORMAT('   <LI>Conclusion (at the 5% Level):')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5607)
        CALL DPWRST('XXX','WRIT')
        IF(STATCD.GE.0.05)THEN
          WRITE(ICOUT,5680)
          CALL DPWRST('XXX','WRIT')
 5680     FORMAT('        The data are random.')
        ELSE
          WRITE(ICOUT,5690)
          CALL DPWRST('XXX','WRIT')
 5690     FORMAT('        The data are not random.')
        ENDIF
        WRITE(ICOUT,5997)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8501   FORMAT('{',A1,'bf FREQUENCY WITHIN A BLOCK TEST FOR ',
     1         'RANDOMNESS}',2X,A1,A1)
 8502   FORMAT(A1,'begin{table}')
 8503   FORMAT(A1,'end{table}')
 8507   FORMAT(A1,'begin{center}')
 8508   FORMAT(A1,'end{center}')
 8512   FORMAT(A1,'end{verbatim}')
 8517   FORMAT(A1,'begin{enumerate}')
 8518   FORMAT(A1,'end{enumerate}')
 8519   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8512)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8507)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8502)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8501)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8519)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8519)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8517)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8520   FORMAT(5X,A1,'item Hypothesis:')
 8521   FORMAT(5X,A1,'item Statistics:')
 8522   FORMAT(5X,A1,'item Critical Values:')
 8523   FORMAT(5X,A1,'item Conclusion (at the 5',A1,'% level):')
 8530   FORMAT(11X,A1,'begin{tabular} {lr}')
 8531   FORMAT(11X,'Number of Observations: & ',I8,2X,A1,A1)
 8532   FORMAT(11X,'Block Size: & ',I8,2X,A1,A1)
 8533   FORMAT(11X,'Number of Observations Within a Block: & ',
     1         I8,2X,A1,A1)
 8534   FORMAT(11X,'Frequency Within a Block Test Statistic Value:',
     1         ' & ',G15.7,2X,A1,A1)
 8540   FORMAT(11X,A1,'end{tabular}')
 8651   FORMAT(11X,'$H_0$: The data are random ')
 8652   FORMAT(11X,'$H_a$: The data are not random')
C
        WRITE(ICOUT,8520)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8550)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8651)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8550)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8652)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8521)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8550)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8530)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8531)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8532)M,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8533)NBLOCK,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8534)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8540)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8522)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C8541   FORMAT(11X,'90',A1,'% Point: & ',G15.7,2X,A1,A1)
C8542   FORMAT(11X,'95',A1,'% Point: & ',G15.7,2X,A1,A1)
C8543   FORMAT(11X,'97.5',A1,'% Point: & ',G15.7,2X,A1,A1)
C8544   FORMAT(11X,'99',A1,'% Point: & ',G15.7,2X,A1,A1)
 8546   FORMAT(11X,'P-Value of Statistic: & ',G15.7,2X,A1,A1)
 8547   FORMAT(11X,'(Reject hypothesis of randomness if p-value ',
     1         'is less than $',A1,'alpha$) & ',2X,A1,A1)
        WRITE(ICOUT,8550)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8530)IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8541)IBASLC,CUT90,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8542)IBASLC,CUT95,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8543)IBASLC,CUT975,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8544)IBASLC,CUT99,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8546)STATCD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8547)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8540)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8523)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8550)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8550   FORMAT(11X,A1,'newline')
 8591   FORMAT(A1,'end{enumerate}')
 8592   FORMAT(A1,'begin{verbatim}')
        IF(STATCD.GE.0.05)THEN
          WRITE(ICOUT,8551)
          CALL DPWRST('XXX','WRIT')
 8551     FORMAT('        The data are random.')
        ELSE
          WRITE(ICOUT,8561)
          CALL DPWRST('XXX','WRIT')
 8561     FORMAT('        The data are not random.')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8591)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8503)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8508)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8592)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C  JUST A PLACEHOLDER FOR NOW.
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7211)
 7211   FORMAT('              FREQUENCY WITHIN A BLOCK TEST FOR ',
     1         'RANDOMNESS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7231)
 7231   FORMAT('1. HYPOTHESIS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7232)
 7232   FORMAT(3X,'H0: THE DATA ARE RANDOM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7233)
 7233   FORMAT(3X,'HA: THE DATA ARE NOT RANDOM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7241)
 7241   FORMAT('2. STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7242)N
 7242   FORMAT(3X,'NUMBER OF OBSERVATIONS                  = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7243)M
 7243   FORMAT(3X,'BLOCK SIZE                              = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7244)NBLOCK
 7244   FORMAT(3X,'NUMBER OF OBSERVATIONS WITHIN A BLOCK   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7349)STATVA
 7349   FORMAT(3X,'FREQUENCY WITHIN A BLOCK TEST STATISTIC  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5438)
C5438   FORMAT('2. PERCENT POINTS OF THE REFERENCE HALF-NORMAL ',
CCCCC1         'DISTRIBUTION')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5439)
C5439   FORMAT('   (REJECT HYPOTHESIS OF RANDOMNESS IF TEST STATISTIC ',
CCCCC1         'VALUE')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5440)
C5440   FORMAT('   IS GREATER THAN PERCENT POINT VALUE)')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5441)
C5441   FORMAT(3X,'FOR FREQUENCY TEST STATISTIC')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5445)CUT0
C5445   FORMAT(6X,'0          % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5446)CUT50
C5446   FORMAT(6X,'50         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5447)CUT75
C5447   FORMAT(6X,'75         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5448)CUT90
C5448   FORMAT(6X,'90         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5449)CUT95
C5449   FORMAT(6X,'95         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5450)CUT975
C5450   FORMAT(6X,'97.5       % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5451)CUT99
C5451   FORMAT(6X,'99         % POINT    = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7453)STATCD
 7453   FORMAT('3. P-VALUE OF STATISTIC  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7454)
 7454   FORMAT('   (REJECT HYPOTHESIS OF RANDOMNESS IF P-VALUE IS ',
     1         'LESS THAN ALPHA)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7561)
 7561   FORMAT('4. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATCD.GE.0.05)THEN
          WRITE(ICOUT,7563)
 7563     FORMAT(3X,'THE DATA ARE RANDOM.')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,7565)
 7565     FORMAT(3X,'THE DATA ARE NOT RANDOM.')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
      GOTO9000
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'FRT2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPFRT2--')
        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
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPFRTH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PFRATH,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FRAME THICKNESS
C              CURRENTLY ALL 4 FRAME LINES MUST
C              BE SET TO THE SAME THICKNESS.
C              THE FRAME THICKNESS SWITCHES FOR THE FRAME
C              IS CONTAINED IN THE VARIABLE
C              PFRATH
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --PDEFCO
C     OUTPUT ARGUMENTS--PFRATH (A REAL VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      REAL        PHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
C
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'THIC')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL FRAMES    ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XFRA')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'
      PFRATH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE FRAME THICKNESS (FOR ALL FRAME 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               **  ONLY THE BOTTOM HORIZONTAL FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1FR')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'
      PFRATH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE FRAME THICKNESS (FOR ALL FRAME 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               **  ONLY THE TOP    HORIZONTAL FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2FR')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'
      PFRATH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE FRAME THICKNESS (FOR ALL FRAME LINES) ')
      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
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   FRAMES    ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YFRA')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      PHOLD=PDEFTH
      GOTO1480
C
 1460 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PFRATH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE FRAME THICKNESS (FOR ALL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)PHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1FR')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      PHOLD=PDEFTH
      GOTO1580
C
 1560 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PFRATH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE FRAME THICKNESS (FOR ALL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)PHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   FRAME IS      TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2FR')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      PHOLD=PDEFTH
      GOTO1680
C
 1660 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PFRATH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE FRAME THICKNESS (FOR ALL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)PHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME FRAME LINES ARE TO BE CHANGED      **
C               *****************************************************
C
      IF(ICOM.EQ.'FRAM')GOTO1700
      IF(ICOM.EQ.'XYFR')GOTO1700
      IF(ICOM.EQ.'YXFR')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      PHOLD=PDEFTH
      GOTO1780
C
 1760 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PFRATH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE FRAME THICKNESS (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)PHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPFRTY(IHARG,NUMARG,
     1IDEFFT,
     1IFRATY,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FRACTAL TYPE
C              CAN BE <WHITHERS/ANGLE/BARNSLEY> (DEFAULT IS BARNSLEY)
C              THIS SWITCH CONTROLS HOW THE ARGUMENTS TO THE
C              FRACTAL PLOT COMMAND ARE INTERPERTED.
C
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFFT (A  CHARACTER VARIABLE)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--IFRATY (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--93/7
C     ORIGINAL VERSION--JULY     1993.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFFT
      CHARACTER*4 IFRATY
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFRTY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFFT
   53 FORMAT('IDEFFT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1150
      IF(NUMARG.GT.2)GOTO9000
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'AUTO')GOTO1150
      IF(IHARG(2).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFFT
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(2)
      IF(IHOLD.EQ.'BARN')GOTO1180
      IF(IHOLD.EQ.'WHIT')GOTO1180
      IF(IHOLD.EQ.'ROTA')IHOLD='ANGL'
      IF(IHOLD.EQ.'ANGL')GOTO1180
      GOTO1170
C
 1170 CONTINUE
      IERROR='YES'
      IFOUND='YES'
      WRITE(ICOUT,1171)IHOLD
 1171 FORMAT('THE FRACTAL TYPE SWITCH ',A4,' IS NOT RECOGNIZED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('IT SHOLUD BE: BARNSLEY, WHITHERS, OR ANGLE')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1180 CONTINUE
      IFOUND='YES'
      IFRATY=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IFRATY
 1181 FORMAT('THE FRACTAL TYPE SWITCH HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFRTY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDEFFT,IFRATY
 9013 FORMAT('IDEFFT,IFRATY = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFTES(XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT AN F TEST
C              (1-SAMPLE OR 2-SAMPLE)
CCCCC THE FOLLOWING 3 LINES WERE ADDED     FEBRUARY 1994
C     EXAMPLE--F TEST Y MU
C              F TEST MU Y
C              F TEST Y1 Y2
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JULY      1984.
C     UPDATED         --FEBRUARY  1994.  ADD COMMENTS ABOVE
C     UPDATED         --DECEMBER  1994.  COPY F TEST PARAMETERS
C     UPDATED         --JANUARY   2004.  SUPPORT FOR HTML, LATEX
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
CCCCC MAY 1995.  ADD FOLLOWING DECLARATIONS
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
CCCCC ISUBN1='DPTT'
      ISUBN1='DPFT'
      ISUBN2='ES  '
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 F TEST CASE  **
C               ********************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPFTES--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR AN F TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,IWIDTH)
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  IF ARGUMENT 1 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1)  **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPFTES--')
      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 AN F TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS COULD BE A VARIABLE,        **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2141)
 2141    FORMAT('***** ERROR IN DPFTES--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2142)
 2142    FORMAT('      FOR AN F TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2145)
 2145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2146)
 2146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2147)
 2147    FORMAT('      ARGUMENT 2 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2148)
 2148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,2150)(IANS(I),I=1,IWIDTH)
 2150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
 2190 CONTINUE
C
C               ********************************************************
C               **  STEP 22--                                         **
C               **  IF ARGUMENT 2 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2)  **
C               **  FOR ARGUMENT 2 IS 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.NE.'V')GOTO2290
      IF(N2.GE.MINN2)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPFTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (FOR WHICH AN F TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)MINN2
 2215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)
 2216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)IH21,IH22
 2217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2218)N2
 2218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2219)
 2219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2220)(IANS(I),I=1,IWIDTH)
 2220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPFTES--')
      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 AN F TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH)
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 42--                                **
C               **  TEMPORARILY FORM THE VARIABLE X(.)       **
C               **  WHICH WILL HOLD THE DATAN FROM SAMPLE 2.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE2.NE.'V')GOTO4290
C
      ISTEPN='42'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4210
      IF(ICASEQ.EQ.'SUBS')GOTO4220
      IF(ICASEQ.EQ.'FOR')GOTO4230
C
 4210 CONTINUE
      DO4215I=1,N2
      ISUB(I)=1
 4215 CONTINUE
      NQ=N2
      GOTO4250
C
 4220 CONTINUE
      NIOLD=N2
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4250
C
 4230 CONTINUE
      NIOLD=N2
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4250
C
 4250 CONTINUE
      IF(NQ.GE.MINN2)GOTO4260
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4251)
 4251 FORMAT('***** ERROR IN DPFTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4252)
 4252 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4253)IH21,IH22
 4253 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4254)
 4254 FORMAT('      (FOR WHICH AN F TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4255)
 4255 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4256)MINN2
 4256 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4257)NQ
 4257 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4258)
 4258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH)
 4259 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4260 CONTINUE
      J=0
      IMAX=N2
      IF(NQ.LT.N2)IMAX=NQ
      DO4270I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4270
      J=J+1
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
 4270 CONTINUE
      NS2=J
C
 4290 CONTINUE
C
C               *********************************
C               **  STEP 52--                  **
C               **  CARY OUT THE F 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 DPFTES, AS WE ARE ABOUT TO CALL DPTTE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      DO5217I=1,NS1
      WRITE(ICOUT,5218)I,Y(I)
 5218 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5217 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
CCCCC THE FOLLOWING CALL WAS CHANGED     DECEMBER 1994
      CALL DPFTE2(Y,NS1,X,NS2,
CCCCC1XTEMP1,XTEMP2,MAXNXT,IBUGA3,IERROR)
     1XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,ICAPTY,
     1STATVA,STANU1,STANU2,POOLSD,STATCD,
     1CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,IERROR)
C
CCCCC THE FOLLOWING SECTION WAS ADDED    DECEMBER 1994
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
CCCCC MAY 1995.
CCCCC IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC MAY 1995.  RENAME
CCCCC ISUBN0='DPTT'
      ISUBN0='DPFT'
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='NU1 '
      VALUE0=STANU1
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='NU2 '
      VALUE0=STANU2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='POOL'
      IH2='SD  '
      VALUE0=POOLSD
      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='CUTL'
      IH2='OW95'
      VALUE0=CUTL95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP95'
      VALUE0=CUTU95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW99'
      VALUE0=CUTL99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP99'
      VALUE0=CUTU99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
 
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFTES--')
      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 DPFTE2(Y1,N1,Y2,N2,
CCCCC THE FOLLOWING LINE WAS CHANGED        DECEMBER 1994
CCCCC1XTEMP1,XTEMP2,MAXNXT,IBUGA3,IERROR)
     1XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,ICAPTY,
     1STATVA,STANU1,STANU2,POOLSD,STATCD,
     1CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT AN F TEST
C              (NECESSARILY 2-SAMPLE)
CCCCC THE FOLLOWING 3 LINES WERE ADDED     FEBRUARY 1994
C     EXAMPLE--F TEST Y1 Y2
C     SAMPLE 1 IS IN INPUT VECTOR Y1
C              (WITH N1 OBSERVATIONS).
C     SAMPLE 2 IS IN INPUT VECTOR Y2
C              (WITH N2 OBSERVATIONS).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--94/2
C     ORIGINAL VERSION--FEBRUARY  1994.
C     UPDATED         --DECEMBER  1994.  COPY F TEST PARAMETERS
C     UPDATED         --JANUARY   2004.  SUPPORT FOR HTML, LATEX
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBASLC
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED   FEBRUARY 1994
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPCO'
      ISUBN2='F2  '
C
      IERROR='NO'
C
      N=(-99)
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPFTE2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N1
   55 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N1
      WRITE(ICOUT,57)I,Y1(I)
   57 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,65)N2
   65 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO66I=1,N2
      WRITE(ICOUT,67)I,Y2(I)
   67 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPFTE2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N1
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N1.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPFTE2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y1(1)
      DO1135I=2,N1
      IF(Y1(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPFTE2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(N2.GE.1)GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPFTE2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 2 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1212)N2
 1212 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1219 CONTINUE
C
      IF(N2.EQ.1)GOTO1220
      GOTO1229
 1220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** NOTE FROM DPFTE2--VARIABLE 2 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1229 CONTINUE
C
      HOLD=Y2(1)
      DO1235I=2,N2
      IF(Y2(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM DPFTE2--VARIABLE 2 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
 1290 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR AN          F TEST  **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      CALL MEAN(Y1,N1,IWRITE,Y1MEAN,IBUGA3,IERROR)
      CALL SD(Y1,N1,IWRITE,Y1SD,IBUGA3,IERROR)
      Y1VAR=Y1SD**2
C
      CALL MEAN(Y2,N2,IWRITE,Y2MEAN,IBUGA3,IERROR)
      CALL SD(Y2,N2,IWRITE,Y2SD,IBUGA3,IERROR)
      Y2VAR=Y2SD**2
C
      AN1=N1
      AN2=N2
C
CCCCC THE FOLLOWING LINE WAS FIXED     DECEMBER 1994
CCCCC IF(S1.GE.S2)THEN
      IF(Y1SD.GE.Y2SD)THEN
         SDNUM=Y1SD
         SDDEN=Y2SD
         IDFNUM=N1-1
         IDFDEN=N2-1
      ELSE
         SDNUM=Y2SD
         SDDEN=Y1SD
         IDFNUM=N2-1
         IDFDEN=N1-1
      ENDIF
      RATIO=(SDNUM/SDDEN)**2
      CALL FCDF(RATIO,IDFNUM,IDFDEN,CDF)
      DFNUM=IDFNUM
      DFDEN=IDFDEN
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
CCCCC IF(0.000.LE.CDF.AND.CDF.LE.0.950)ICONC1='ACCEPT'
CCCCC IF(0.025.LE.CDF.AND.CDF.LE.0.975)ICONC2='ACCEPT'
CCCCC IF(0.050.LE.CDF.AND.CDF.LE.1.000)ICONC3='ACCEPT'
      IF(0.000.LE.CDF.AND.CDF.LE.0.950)ICONC2='ACCEPT'
C
CCCCC THE FOLLOWING SECTION WAS ADDED       DECEMBER 1994
      POOLSS=DFNUM*SDNUM*SDNUM+DFDEN*SDDEN*SDDEN
      POOLDF=DFNUM+DFDEN
      POOLVA=0.0
      IF(POOLDF.GT.0.0)POOLVA=POOLSS/POOLDF
      POOLSD=0.0
      IF(POOLVA.GT.0.0)POOLSD=SQRT(POOLVA)
C
CCCCC THE FOLLOWING SECTION WAS ADDED       DECEMBER 1994
      STATVA=RATIO
      STATCD=CDF
      STANU1=IDFNUM
      STANU2=IDFDEN
      CUTL95=0.0
      CALL FPPF(.95,IDFNUM,IDFDEN,CUTU95)
      CUTL99=0.0
      CALL FPPF(.99,IDFNUM,IDFDEN,CUTU99)
C
C               ******************************
C               **   STEP 42--              **
C               **   WRITE OUT EVERYTHING   **
C               **   FOR AN         F 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: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>TWO SAMPLE F-TEST FOR EQUAL STANDARD ',
     1         'DEVIATION</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=TOP WIDTH=250>')
 5047   FORMAT('      </TD>')
 5048   FORMAT('      <TD ALIGN=CENTER VALIGN=TOP WIDTH=50>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=TOP WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5052   FORMAT('         ',I8)
 5055   FORMAT('         ',A8)
 5059   FORMAT('   </TR>')
 5060   FORMAT('         =')
 5057   FORMAT('         &nbsp;')
 5058   FORMAT('         <>')
 5061   FORMAT('         H<sub>0</sub>: ',
     1         'sigma<sub>1</sub> = sigma<sub>2</sub>')
 5062   FORMAT('         H<sub>a</sub>: ',
     1         'sigma<sub>1</sub> <> sigma<sub>2</sub>')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5071   FORMAT('         <B>Sample 1:</B>')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5072   FORMAT('         Number of Observations')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)N1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5073   FORMAT('         Mean')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)Y1MEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5074   FORMAT('         Standard Deviation')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)Y1SD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5076   FORMAT('         <B>Sample 2:</B>')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5076)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)N2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)Y2MEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)Y2SD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5081   FORMAT('         <B>Test:</B>')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5081)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5082   FORMAT('         Standard Deviation (Numerator)')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5082)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SDNUM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5083   FORMAT('         Standard Deviation (Denominator)')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5083)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SDDEN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5084   FORMAT('         F-Test Statistic Value')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5084)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)RATIO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5085   FORMAT('         Degrees of Freedom (Numerator)')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5085)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)INT(DFNUM+0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5086   FORMAT('         Degrees of Freedom (Denomerator)')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5086)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)INT(DFDEN+0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5087   FORMAT('         F-Test CDF Value')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5087)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5094   FORMAT('<P>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5094)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=CENTER VALIGN=TOP WIDTH=200>')
 5127   FORMAT('      </TH>')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
 5171   FORMAT('         Null<BR>Hypothesis')
 5172   FORMAT('         Null Hypothesis<BR>Acceptance Interval')
 5173   FORMAT('         Null Hypothesis<BR>Conclusion')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5241   FORMAT('   <TR>')
 5243   FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM>')
 5247   FORMAT('      </TD>')
 5259   FORMAT('   </TR>')
 5261   FORMAT('         sigma<sub>1</sub> = sigma<sub>2</sub>')
 5262   FORMAT('         (0.000,0.950)')
 5263   FORMAT('         ',A6)
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5261)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5262)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5263)ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
 5194   FORMAT('<PRE>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5194)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf TWO SAMPLE F-TEST FOR EQUAL STANDARD ',
     1       'DEVIATIONS}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lcr}')
 8021 FORMAT(5X,'$H_0$: $',A1,'sigma_1$  = $',A1,'sigma_2$  & & ',
     1       2X,A1,A1)
 8022 FORMAT(5X,'$H_a$: $',A1,'sigma_1$  = $',A1,'sigma_2$ & & ',
     1       2X,A1,A1)
 8023 FORMAT(5X,' &   & ',2X,A1,A1)
 8024 FORMAT(5X,'{',A1,'bf Sample 1:} &   & ',2X,A1,A1)
 8025 FORMAT(5X,'Number of Observations & = & ',I8,2X,A1,A1)
 8026 FORMAT(5X,'Mean & = & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Standard Deviation & = & ',
     1       G15.7,2X,A1,A1)
 8028 FORMAT(5X,'{',A1,'bf Test:} &   & ',2X,A1,A1)
 8029 FORMAT(5X,'Standard Deviation (Numerator) & = & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Standard Deviation (Denomerator) & = & ',
     1       G15.7,2X,A1,A1)
 8031 FORMAT(5X,'F-Test Statistic & = & ',G15.7,2X,A1,A1)
 8032 FORMAT(5X,'Degrees of Freedom (Numerator) & = & ',I8,2X,A1,A1)
 8033 FORMAT(5X,'Degrees of Freedom (Denomerator) & = & ',I8,2X,A1,A1)
 8034 FORMAT(5X,'F-Test Statistic CDF Value & = & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)N1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)Y1MEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)Y1SD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)N2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)Y2MEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)Y2SD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8028)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)SDNUM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)SDDEN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)RATIO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)INT(DFNUM + 0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)INT(DFDEN + 0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)CDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8109 FORMAT(A1,'begin{center}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120 FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121 FORMAT(5X,'{',A1,'bf Null} & {',A1,
     1       'bf Null Hypothesis} & {',A1,'bf Null Hypothesis}',
     1       2X,A1,A1)
 8122 FORMAT(5X,'{',A1,'bf Hypothesis} & {',A1,
     1       'bf Acceptance Interval} & {',A1,
     1       'bf Conclusion}',2X,A1,A1)
 8124 FORMAT(5X,'$',A1,'sigma_1 =  ',A1,'sigma_2 $ ',
     1       ' & (0.000,0.950) & ',A6,2X,A1,A1)
 8140 FORMAT(5X,A1,'hline')
 8149 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8124)IBASLC,IBASLC,ICONC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{center}')
 8193   FORMAT(A1,'end{table}')
 8199   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8199)IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC WRITE IN RTF (RICH TEXT FORMAT)
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT('    TWO SAMPLE F-TEST FOR EQUAL STANDARD DEVIATIONS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('NULL HYPOTHESIS:            SIGMA1 = SIGMA2')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)
 4215   FORMAT('ALTERNATIVE HYPOTHESIS:     SIGMA1 NOT EQUAL SIGMA2')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4220)
 4220   FORMAT('SAMPLE 1:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N1
 4221   FORMAT(3X,'NUMBER OF OBSERVATIONS             = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)Y1MEAN
 4222   FORMAT(3X,'MEAN                               = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)Y1SD
 4223   FORMAT(3X,'STANDARD DEVIATION                 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4230)
 4230   FORMAT('SAMPLE 2:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)N2
 4231   FORMAT(3X,'NUMBER OF OBSERVATIONS             = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4232)Y2MEAN
 4232   FORMAT(3X,'MEAN                               = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)Y2SD
 4233   FORMAT(3X,'STANDARD DEVIATION                 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4241)
 4241   FORMAT('TEST:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)SDNUM
 4242   FORMAT(3X,'STANDARD DEVIATION (NUMERATOR)     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)SDDEN
 4243   FORMAT(3X,'STANDARD DEVIATION (DENOMINATOR)   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4244)RATIO
 4244   FORMAT(3X,'F-TEST STATISTIC VALUE             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)DFNUM
 4245   FORMAT(3X,'DEGREES OF FREEDOM (NUMERATOR)     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)DFDEN
 4246   FORMAT(3X,'DEGREES OF FREEDOM (DENOMINATOR)   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4247)CDF
 4247   FORMAT(3X,'F-TEST STATISTIC CDF VALUE         = ',F11.6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4260)
 4260   FORMAT('  NULL          NULL HYPOTHESIS        NULL ',
     1         'HYPOTHESIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4261)
 4261   FORMAT('  HYPOTHESIS    ACCEPTANCE INTERVAL    CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4262)ICONC2
 4262   FORMAT('SIGMA1 = SIGMA2    (0.000,0.950)         ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFTE2--')
      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)N1
 9015 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N1
      WRITE(ICOUT,9017)I,Y1(I)
 9017 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      WRITE(ICOUT,9025)N2
 9025 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9026I=1,N2
      WRITE(ICOUT,9027)I,Y2(I)
 9027 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9026 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFUEV(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
     1IFOUNZ,IBEGIN,IEND,ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1,
     1NUMCL,NUMPL,NUMAOL,ITYW1L,ICAT1L,INLI1L,ITYW2L,
     1NUMCR,NUMPR,NUMAOR,ITYW1R,ICAT1R,INLI1R,ITYW2R,
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--TREAT THE TYPE 6 LET CASE--
C              COMPUTING A GENERAL FUNCTION
C              (FOR A PARAMETER, A FULL VARIABLE,
C              OR PART OF A VARIABLE).
C     OUTPUT--A PARAMETER OR A VARIABLE.
C     EXAMPLE--IN THE FOLLOWING EXAMPLES,
C              A REPRESENTS A PREVIOUSLY-DEFINED PARAMETER
C              B REPRESENTS A PREVIOUSLY-DEFINED PARAMETER
C              X REPRESENTS A PREVIOUSLY-DEFINED VARIABLE (VECTOR)
C              Y REPRESENTS A PREVIOUSLY-DEFINED VARIABLE (VECTOR)
C              U REPRESENTS AN UNYET-DEFINED TERM
C              I REPRESENTS A DUMMY VARIABLE
C                     --LET A    = I                         (ILLEGAL)
C                     --LET A    = X(2)                      (A PARAMETER)
C                     --LET A    = 3*SIN(4)                  (A PARAMETER)
C                     --LET A    = B*SIN(B)                  (A PARAMETER)
C                     --LET A    = X*SIN(X)                  (ILLEGAL)
C
C                     --LET Y    = I                         (ILLEGAL)
C                     --LET Y    = X(2)                      (ILLEGAL)
C                     --LET Y    = 3*SIN(4)                  (ILLEGAL)
C                     --LET Y    = B*SIN(B)                  (ILLEGAL)
C                     --LET Y    = X*SIN(X)                  (A FULL VARIABLE)
C
C                     --LET Y(I) = I                         (A FULL VARIABLE)
C                     --LET Y(I) = X(2)                      (A FULL VARIABLE)
C                     --LET Y(I) = 3*SIN(4)                  (A FULL VARIABLE)
C                     --LET Y(I) = B*SIN(B)                  (A FULL VARIABLE)
C                     --LET Y(I) = X*SIN(X)                  (A FULL VARIABLE)
C
C                     --LET Y(2) = I                         (ILLEGAL)
C                     --LET Y(2) = X(2)                      (AN EL. OF A VAR.)
C                     --LET Y(2) = 3*SIN(4)                  (AN EL. OF A VAR.)
C                     --LET Y(2) = B*SIN(B)                  (AN EL. OF A VAR.)
C                     --LET Y(2) = X*SIN(X)                  (ILLEGAL)
C
C                     --LET U    = I                         (ILLEGAL)
C                     --LET U    = X(2)                      (A PARAMETER)
C                     --LET U    = 3*SIN(4)                  (A PARAMETER)
C                     --LET U    = B*SIN(B)                  (A PARAMETER)
C                     --LET U    = X*SIN(X)                  (A FULL VARIABLE)
C
C                     --LET U(I) = I                         (ILLEGAL)
C                     --LET U(I) = X(2)                      (ILLEGAL)
C                     --LET U(I) = 3*SIN(4)                  (ILLEGAL)
C                     --LET U(I) = B*SIN(B)                  (ILLEGAL)
C                     --LET U(I) = X*SIN(X)                  (A FULL VARIABLE)
C
C                     --LET U(2) = I                         (ILLEGAL)
C                     --LET U(2) = X(2)                      (AN EL. OF A VAR.)
C                     --LET U(2) = 3*SIN(4)                  (AN EL. OF A VAR.)
C                     --LET U(2) = B*SIN(B)                  (AN EL. OF A VAR.)
C                     --LET U(2) = X*SIN(X)                  (ILLEGAL)
C                ********************************
C
C                     --LET A    = I         SUBSET 2 3 5    (ILLEGAL)
C                     --LET A    = X(2)      SUBSET 2 3 5    (ILLEGAL)
C                     --LET A    = 3*SIN(4)  SUBSET 2 3 5    (ILLEGAL)
C                     --LET A    = B*SIN(B)  SUBSET 2 3 5    (ILLEGAL)
C                     --LET A    = X*SIN(X)  SUBSET 2 3 5    (ILLEGAL)
C
C                     --LET Y    = I         SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y    = X(2)      SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y    = 3*SIN(4)  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y    = B*SIN(B)  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y    = X*SIN(X)  SUBSET 2 3 5    (A PARTIAL VAR.)
C
C                     --LET Y(I) = I         SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y(I) = X(2)      SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y(I) = 3*SIN(4)  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y(I) = B*SIN(B)  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y(I) = X*SIN(X)  SUBSET 2 3 5    (A PARTIAL VAR.)
C
C                     --LET Y(2) = I         SUBSET 2 3 5    (ILLEGAL)
C                     --LET Y(2) = X(2)      SUBSET 2 3 5    (ILLEGAL)
C                     --LET Y(2) = 3*SIN(4)  SUBSET 2 3 5    (ILLEGAL)
C                     --LET Y(2) = B*SIN(B)  SUBSET 2 3 5    (ILLEGAL)
C                     --LET Y(2) = X*SIN(X)  SUBSET 2 3 5    (ILLEGAL)
C
C                     --LET U    = I         SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET U    = X(2)      SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET U    = 3*SIN(4)  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET U    = B*SIN(B)  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET U    = X*SIN(X)  SUBSET 2 3 5    (A PARTIAL VAR.)
C
C                     --LET U(I) = I         SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET U(I) = X(2)      SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET U(I) = 3*SIN(4)  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET U(I) = B*SIN(B)  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET U(I) = X*SIN(X)  SUBSET 2 3 5    (A PARTIAL VAR.)
C
C                     --LET U(2) = I         SUBSET 2 3 5    (ILLEGAL)
C                     --LET U(2) = X(2)      SUBSET 2 3 5    (ILLEGAL)
C                     --LET U(2) = 3*SIN(4)  SUBSET 2 3 5    (ILLEGAL)
C                     --LET U(2) = B*SIN(B)  SUBSET 2 3 5    (ILLEGAL)
C                     --LET U(2) = X*SIN(X)  SUBSET 2 3 5    (ILLEGAL)
C
C                ********************************
C
C                     --LET A    = I         FOR I = 1 2 10  (ILLEGAL)
C                     --LET A    = X(2)      FOR I = 1 2 10  (ILLEGAL)
C                     --LET A    = 3*SIN(4)  FOR I = 1 2 10  (ILLEGAL)
C                     --LET A    = B*SIN(B)  FOR I = 1 2 10  (ILLEGAL)
C                     --LET A    = X*SIN(X)  FOR I = 1 2 10  (ILLEGAL)
C
C                     --LET Y    = I         FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET Y    = X(2)      FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET Y    = 3*SIN(4)  FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET Y    = B*SIN(B)  FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET Y    = X*SIN(X)  FOR I = 1 2 10  (A PARTIAL VAR.)
C
C                     --LET Y(I) = I         FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET Y(I) = X(2)      FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET Y(I) = 3*SIN(4)  FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET Y(I) = B*SIN(B)  FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET Y(I) = X*SIN(X)  FOR I = 1 2 10  (A PARTIAL VAR.)
C
C                     --LET Y(2) = I         FOR I = 1 2 10  (ILLEGAL)
C                     --LET Y(2) = X(2)      FOR I = 1 2 10  (ILLEGAL)
C                     --LET Y(2) = 3*SIN(4)  FOR I = 1 2 10  (ILLEGAL)
C                     --LET Y(2) = B*SIN(B)  FOR I = 1 2 10  (ILLEGAL)
C                     --LET Y(2) = X*SIN(X)  FOR I = 1 2 10  (ILLEGAL)
C
C                     --LET U    = I         FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET U    = X(2)      FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET U    = 3*SIN(4)  FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET U    = B*SIN(B)  FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET U    = X*SIN(X)  FOR I = 1 2 10  (A PARTIAL VAR.)
C
C                     --LET U(I) = I         FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET U(I) = X(2)      FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET U(I) = 3*SIN(4)  FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET U(I) = B*SIN(B)  FOR I = 1 2 10  (A PARTIAL VAR.)
C                     --LET U(I) = X*SIN(X)  FOR I = 1 2 10  (A PARTIAL VAR.)
C
C                     --LET U(2) = I         FOR I = 1 2 10  (ILLEGAL)
C                     --LET U(2) = X(2)      FOR I = 1 2 10  (ILLEGAL)
C                     --LET U(2) = 3*SIN(4)  FOR I = 1 2 10  (ILLEGAL)
C                     --LET U(2) = B*SIN(B)  FOR I = 1 2 10  (ILLEGAL)
C                     --LET U(2) = X*SIN(X)  FOR I = 1 2 10  (ILLEGAL)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (IN DPLET)--DECEMBER 1977.
C     ORIGINAL VERSION AS A SEPARATE SUBROUTINE--MARCH 1978.
C     UPDATED         --MAY       1982.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --JUNE      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --JANUARY   1982.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MARCH     1986.
C     UPDATED         --JANUARY   1988.  CUTOFF VALUE FOR CDC COMPUTERS
C     UPDATED         --MARCH     1988.  FIX LET PRED=... SUBSET/FOR/ALL
C     UPDATED         --DECEMBER  1988.  FIX LET Y(K) = X(K) INSIDE LOOP
C     UPDATED         --FEBRUARY  1989.  CUTOFF VALUE FOR CDC 205 COMPUTER
C     UPDATED         --MARCH     2003.  FOR PARAMETERS, CHECK FOR
C                                        IVALUE > LARGEST MACHINE
C                                        INTEGER
C     UPDATED         --FEBRUARY  2005.  IF FUNCTION DEFINED WITH
C                                        "LET STRING", CASE PRESERVED.
C                                        WHEN FUNCTION EXTRACTED IN
C                                        THIS CONTEXT, NEED TO
C                                        CONVERT LOWER CASE TO UPPER
C                                        CASE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IFOUNZ
      CHARACTER*4 ITYPE
      CHARACTER*4 IHOL
      CHARACTER*4 IHOL2
      CHARACTER*4 IERRO1
      CHARACTER*4 ITYW1L
      CHARACTER*4 ICAT1L
      CHARACTER*4 INLI1L
      CHARACTER*4 ITYW2L
      CHARACTER*4 ITYW1R
      CHARACTER*4 ICAT1R
      CHARACTER*4 INLI1R
      CHARACTER*4 ITYW2R
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWD1
      CHARACTER*4 IWD2
      CHARACTER*4 IWD12
      CHARACTER*4 IWD22
      CHARACTER*4 IVOLDR
      CHARACTER*4 IVOLR2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 IVNEWR
      CHARACTER*4 IVNER2
      CHARACTER*4 ICASEL
      CHARACTER*4 ICASER
      CHARACTER*4 ICASEQ
      CHARACTER*4 ICASIF
      CHARACTER*4 IPJ
      CHARACTER*4 IPJ2
      CHARACTER*4 IHSET
      CHARACTER*4 IHSET2
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
      CHARACTER*4 IRIGHT
      CHARACTER*4 IRIGH2
      CHARACTER*4 IARG4F
      CHARACTER*4 IARG4T
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IFOUNZ(*)
      DIMENSION IBEGIN(*)
      DIMENSION IEND(*)
      DIMENSION ITYPE(*)
      DIMENSION IHOL(*)
      DIMENSION IHOL2(*)
      DIMENSION INT1(*)
      DIMENSION FLOAT1(*)
      DIMENSION IERRO1(*)
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IA(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOMC.INC'
C
      CHARACTER*4 IFSAVE
      DIMENSION IFSAVE(MAXF1)
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='EV  '
C
C  CONVERT FUNCTION TABLE TO UPPER CASE, BUT SAVE ORIGINAL FIRST
C
      DO10I=1,NUMCHF
        IFSAVE(I)=IFUNC(I)
CCCCC   CALL DPCOAN(IFSAVE(I)(1:1),IATEMP)
CCCCC   IF(IATEMP.GE.97 .AND. IATEMP.LE.122)THEN
CCCCC     IATEMP=IATEMP-32
CCCCC     CALL DPCONA(IATEMP,IFSAVE(I)(1:1))
CCCCC   ENDIF
   10 CONTINUE
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
C               *******************************************************
C               **  TREAT THE CASE OF A GENERAL FUNCTION EVALUATION  **
C               **        1) FOR A PARAMETER,                        **
C               **        2) FOR A FULL VARIABLE, OR                 **
C               **        3) 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 DPFUEV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGCO,IBUGEV
   53 FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGQ
   54 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IANGLU
   55 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)NUMNAM
   57 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO60I=1,NUMNAM
      WRITE(ICOUT,61)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
   61 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
   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
      MAXN2=MAXCHF
      MAXN3=MAXCHF
      MAXN4=MAXCHF
C
      IF(IBUGA3.EQ.'OFF')GOTO99
      WRITE(ICOUT,91)
   91 FORMAT('I,IFOUNZ(I),ITYPE(I),IHOL(I),IHOL2(I),INT1(I),',
     1'FLOAT1(I)--')
      CALL DPWRST('XXX','BUG ')
      DO92I=1,30
      WRITE(ICOUT,93)I,IFOUNZ(I),ITYPE(I),IHOL(I),IHOL2(I),INT1(I),
     1FLOAT1(I)
   93 FORMAT(I3,2X,A4,2X,A4,2X,A4,2X,A4,2X,I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   92 CONTINUE
   99 CONTINUE
C
C               ****************************************************************
C               **  STEP 2--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN        *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  IS IT A PARAMETER OR A VARIABLE?                           *
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               **  WHEN THIS STEP IS FINISHED,                                *
C               **  ICASEL   WILL HAVE ONE OF THE FOLLOWING 3 VALUES--         *
C               **           1) PARAM                                          *
C               **           2) VAR                                            *
C               **           3) UNKNOWN (YET TO BE DEFINED; DEPENDS ON RIGHT). *
C               ****************************************************************
C               ****************************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEL='UNKN'
      ILEFT=IHOL(2)
      ILEFT2=IHOL2(2)
      DO2000I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO2500
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO2600
 2000 CONTINUE
      ICASEL='UNKN'
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO2800
      GOTO2900
C
 2500 CONTINUE
      ICASEL='PARA'
      ILISTL=I2
      GOTO2900
C
 2600 CONTINUE
      ICASEL='VAR'
      ILISTL=I2
      ICOLL=IVALUE(ILISTL)
      NILEFT=IN(ILISTL)
      GOTO2900
C
 2800 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2801)
 2801 FORMAT('***** ERROR IN DPFUEV AT 2801--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2802)
 2802 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2803)MAXNAM
 2803 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2804)
 2804 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2805)
 2805 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2806)
 2806 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2807)
 2807 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2808)
 2808 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2900 CONTINUE
C
C               **************************************************
C               **  STEP 3--                                    **
C               **  EXAMINE THE RIGHT-HAND SIDE--               **
C               **  1)  FIRST, SCREEN OUT THE DUMMY             **
C               **      AND THE ELEMENT SPECIFICATION CASES;    **
C               **  2)  THEN EXTRACT THE FUNCTIONAL EXPRESSION; **
C               **  3)  DETERMINE THE TYPE OF QUALIFIERS--      **
C               **      A)  NONE (= FULL = UNQUALIFIED);        **
C               **      B)  SUBSET/EXCEPT; OR                   **
C               **      C)  FOR.                                **
C               **  4)  EXAMINE THE FUNCTION    AL EXPRESSION   **
C               **      FOR PARAMETERS AND VARIABLES.           **
C               **  WHEN THIS STEP IS FINISHED,                 **
C               **  ICASER  WILL BE FULLY DETERMINED AND        **
C               **  WILL HAVE ONE OF THE FOLLOWING 4 VALUES--   **
C               **          1) DUMMY;                           **
C               **          2) ELEMENT;                         **
C               **          3) PARAM (NO VARIABLES);            **
C               **          4) VAR (AT LEAST ONE VARIABLE).     **
C               **  WHEN THIS STEP IS FINISHED,                 **
C               **  ICASEQ  WILL BE FILLY DETERMINED AND        **
C               **  WILL HAVE ONE OF THE FOLLOWING 3 VALUES--   **
C               **          1) FULL;                            **
C               **          2) SUBSET/EXCEPT OR;                **
C               **          3) FOR.                             **
C               **************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASER='UNKN'
      ICASEQ='UNKN'
      IF(NUMCR.EQ.1.AND.NUMPR.EQ.0.AND.NUMAOR.EQ.0.
     1AND.ITYW1R.EQ.'WORD'.AND.INLI1R.EQ.'NO')GOTO3010
      IF(1.LE.NUMCR.AND.NUMCR.LE.4.AND.NUMPR.EQ.2.AND.NUMAOR.EQ.0.
     1AND.ITYW1R.EQ.'WORD'.AND.ICAT1R.EQ.'VARP'.
     1AND.INLI1R.EQ.'YES'.AND.ITYW2R.EQ.'NUMB')GOTO3020
      IF(1.LE.NUMCR.AND.NUMCR.LE.4.AND.NUMPR.EQ.2.AND.NUMAOR.EQ.0.
     1AND.ITYW1R.EQ.'WORD'.AND.ICAT1R.EQ.'VARP'.
     1AND.INLI1R.EQ.'YES'.AND.ITYW2R.EQ.'WORD')GOTO3020
      GOTO3090
C
 3010 CONTINUE
      ICASER='DUMM'
      IF(IFOUNZ(11).EQ.'NO'.AND.IFOUNZ(21).EQ.'NO')ICASEQ='FULL'
      IF(IFOUNZ(11).EQ.'YES')ICASEQ='SUBS'
      IF(IFOUNZ(21).EQ.'YES')ICASEQ='FOR'
      GOTO3990
C
 3020 CONTINUE
      ICASER='ELEM'
      IRIGHT=IHOL(7)
      IRIGH2=IHOL2(7)
      DO3030I=1,NUMNAM
      I2=I
      IF(IRIGHT.EQ.IHNAME(I).AND.IRIGH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO3040
      IF(IRIGHT.EQ.IHNAME(I).AND.IRIGH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO3050
 3030 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3031)
 3031 FORMAT('***** ERROR IN DPFUEV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3032)
 3032 FORMAT('      THE VARIABLE NAME ON THE RIGHT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3033)
 3033 FORMAT('      OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3034)
 3034 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3035)
 3035 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3036)(IANS(I),I=1,IWIDTH)
 3036 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 3040 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3041)
 3041 FORMAT('***** ERROR IN DPFUEV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3042)
 3042 FORMAT('      THE VARIABLE NAME ON THE RIGHT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3043)
 3043 FORMAT('      OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3044)
 3044 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3045)
 3045 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3046)
 3046 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3047)
 3047 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3048)(IANS(I),I=1,IWIDTH)
 3048 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 3050 CONTINUE
      ILISTR=I2
      ICOLR=IVALUE(ILISTR)
      NIRIGH=IN(ILISTR)
C
      IARGIR=INT1(9)
      IF(1.LE.IARGIR.AND.IARGIR.LE.MAXN)GOTO3060
      WRITE(ICOUT,3061)
 3061 FORMAT('***** ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3062)
 3062 FORMAT('      THE SPECIFIED ARGUMENT (ROW NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3063)
 3063 FORMAT('      ON THE RIGHT SIDE OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3064)
 3064 FORMAT('      IS SMALLER THAN 1 OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3065)
 3065 FORMAT('      LARGER THAN THE MAXIMUM ALLOWABLE NUMBER  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3066)MAXN
 3066 FORMAT('      (',I6,')  FOR A GIVEN VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3067)IARGIR
 3067 FORMAT('      THE VALUE (IARGIR) = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3068)
 3068 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3069)(IANS(I),I=1,IWIDTH)
 3069 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 3060 CONTINUE
      IF(IFOUNZ(11).EQ.'NO'.AND.IFOUNZ(21).EQ.'NO')ICASEQ='FULL'
      IF(IFOUNZ(11).EQ.'YES')ICASEQ='SUBS'
      IF(IFOUNZ(21).EQ.'YES')ICASEQ='FOR'
      GOTO3990
C
 3090 CONTINUE
      ICASEQ='UNKN'
C
C     LOCATE THE EQUAL SIGN.
C
      DO3100I=1,IWIDTH
      I2=I
      IF(IANS(I).EQ.'=')GOTO3150
 3100 CONTINUE
      GOTO3400
 3150 CONTINUE
      ISTART=I2
C
      IF(ISTART.GT.IWIDTH)GOTO3400
      DO3200I=ISTART,IWIDTH
      I2=I
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
      IF(IP7.GT.IWIDTH)GOTO3230
      IF(IANS(I).EQ.' '.AND.IANS(IP1).EQ.'S'.AND.IANS(IP2).EQ.'U'
     1.AND.IANS(IP3).EQ.'B'.AND.IANS(IP4).EQ.'S'.AND.IANS(IP5).EQ.'E'
     1.AND.IANS(IP6).EQ.'T'.AND.IANS(IP7).EQ.' ')GOTO3250
      IF(IANS(I).EQ.' '.AND.IANS(IP1).EQ.'F'.AND.IANS(IP2).EQ.'O'
     1.AND.IANS(IP3).EQ.'R'.AND.IANS(IP4).EQ.' ')GOTO3270
      IF(IANS(I).EQ.' '.AND.IANS(IP1).EQ.'I'.AND.IANS(IP2).EQ.'F'
     1.AND.IANS(IP3).EQ.' ')GOTO3280
 3200 CONTINUE
C
 3230 CONTINUE
      ICASEQ='FULL'
      ISTOP=IWIDTH
      GOTO3290
C
 3250 CONTINUE
      ICASEQ='SUBS'
      ISTOP=I2
      GOTO3290
C
 3270 CONTINUE
      ICASEQ='FOR'
      ISTOP=I2
      GOTO3290
C
 3280 CONTINUE
      ICASEQ='IF'
      ISTOP=I2
      GOTO3290
C
 3290 CONTINUE
C
C               ***************************************
C               **  STEP 3.1--                       **
C               **  EXTRACT THE UNDERLYING FUNCTION  **
C               **  FROM FUNCTION DEFINITIONS.       **
C               ***************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC J=0
CCCCC IMIN=ISTART+1
CCCCC DO3370I=IMIN,ISTOP
CCCCC J=J+1
CCCCC IA(J)=IANS(I)
C3370 CONTINUE
CCCCC NUMCHA=J
C
      IWD1='=   '
      IWD12='    '
      IF(ICASEQ.EQ.'FULL')IWD2='    '
      IF(ICASEQ.EQ.'FULL')IWD22='    '
      IF(ICASEQ.EQ.'SUBS'.AND.IHOL(11).EQ.'SUBS')IWD2='SUBS'
      IF(ICASEQ.EQ.'SUBS'.AND.IHOL(11).EQ.'SUBS')IWD22='ET  '
      IF(ICASEQ.EQ.'SUBS'.AND.IHOL(11).EQ.'EXCE')IWD2='EXCE'
      IF(ICASEQ.EQ.'SUBS'.AND.IHOL(11).EQ.'EXCE')IWD22='PT  '
      IF(ICASEQ.EQ.'FOR ')IWD2='FOR '
      IF(ICASEQ.EQ.'FOR ')IWD22='    '
      IF(ICASEQ.EQ.'IF  ')IWD2='IF  '
      IF(ICASEQ.EQ.'IF  ')IWD22='    '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3011)
 3011 FORMAT('***** FROM DPFUEV, AFTER  THE CALL TO DPEXST--')
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IERROR.EQ.'YES')GOTO19000
      IF(IFOUND.EQ.'YES')GOTO3379
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3371)
 3371 FORMAT('***** ERROR IN DPFUEV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3372)
 3372 FORMAT('      INVALID COMMAND FORM FOR FUNCTION EVALUATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3373)
 3373 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3374)
 3374 FORMAT('      LET ... = ...  ',
     1'SUBSET ... ... ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3375)
 3375 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3376)(IANS(I),I=1,IWIDTH)
 3376 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
 3379 CONTINUE
C
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3012)
 3012 FORMAT('***** FROM DPFUEV, BEFORE THE CALL TO DPEXFU--')
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      DO3018I=1,N2
        IA(I)=IFUNC2(I)
        ITEMP=ICHAR(IFUNC2(I)(1:1))
        IF(ITEMP.GE.97 .AND. ITEMP.LE.122)THEN
          ITEMP=ITEMP-32
          IFUNC2(I)(1:1)=CHAR(ITEMP)
        ENDIF
 3018 CONTINUE
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3013)
 3013 FORMAT('***** FROM DPFUEV, AFTER  THE CALL TO DPEXFU--')
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IERROR.EQ.'YES')GOTO19000
C
      J=0
      DO3380I=1,N3
        J=J+1
        IA(J)=IFUNC3(I)
        ITEMP=ICHAR(IA(J)(1:1))
        IF(ITEMP.GE.97 .AND. ITEMP.LE.122)THEN
          ITEMP=ITEMP-32
          IA(J)(1:1)=CHAR(ITEMP)
        ENDIF
 3380 CONTINUE
      NUMCHA=J
      GOTO3500
C
 3400 CONTINUE
      WRITE(ICOUT,3411)
 3411 FORMAT('***** INTERNAL ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3412)
 3412 FORMAT('      AT BRANCH POINT 3400--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3413)
 3413 FORMAT('      ISTART GREATER THAN ISTOP.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3418)
 3418 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3419)(IANS(I),I=1,IWIDTH)
 3419 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 3500 CONTINUE
      ICASER='UNKN'
C
      IPASS=1
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3014)
 3014 FORMAT('***** FROM DPFUEV, BEFORE THE CALL TO COMPIM--')
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      CALL COMPIM(IA,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPAR,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,AJUNK,
     1IBUGCO,IBUGEV,IERROR)
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3015)
 3015 FORMAT('***** FROM DPFUEV, AFTER  THE CALL TO COMPIM--')
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IERROR.EQ.'YES')GOTO19000
C
      NUMP=0
      NUMV=0
      NIOLDR=0
      IVOLDR='JUNK'
      IVOLR2='JUNK'
      IF(NUMPAR.EQ.0)GOTO3900
      DO3600J=1,NUMPAR
      DO3700I=1,NUMNAM
      I2=I
      IF(IPARN(J).EQ.IHNAME(I).AND.IPARN2(J).EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO3850
      IF(IPARN(J).EQ.IHNAME(I).AND.IPARN2(J).EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO3870
 3700 CONTINUE
      GOTO3800
C
 3850 CONTINUE
      NUMP=NUMP+1
      GOTO3600
C
 3870 CONTINUE
      NUMV=NUMV+1
      NIRIGH=IN(I2)
      NIOLDR=NINEWR
      IVOLDR=IVNEWR
      IVOLR2=IVNER2
      NINEWR=IN(I2)
      IVNEWR=IHNAME(I2)
      IVNER2=IHNAM2(I2)
      IF(NUMV.GE.2.AND.NINEWR.NE.NIOLDR)GOTO3820
      GOTO3600
C
 3600 CONTINUE
      GOTO3900
C
 3800 CONTINUE
      WRITE(ICOUT,3801)
 3801 FORMAT('***** ERROR IN DPFUEV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3802)
 3802 FORMAT('      A VARIABLE OR PARAMETER NAME USED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3803)
 3803 FORMAT('      IN AN EXPRESSION IS NOT YET DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3804)IPARN(J),IPARN2(J)
 3804 FORMAT('      VARIABLE OR PARAMETER NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      GOTO3809
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3805)
C3805 FORMAT('      CURRENT LIST OF DEFINED VARIABLES AND ',
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC1'PARAMETERS--')
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC DO3806I2=1,NUMNAM
CCCCC WRITE(ICOUT,3807)IHNAME(I2),IHNAM2(I2),IUSE(I2),IVALUE(I2),
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC1VALUE(I2),IN(I2)
C3807 FORMAT(6X,A4,A4,6X,A4,6X,I6,6X,E15.6,I6)
C3806 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3808)(IA(I),I=1,NUMCHA)
C3808 FORMAT('      FUNCTION EXPRESSION--'100A1)
CCCCC CALL DPWRST('XXX','BUG ')
 3809 CONTINUE
      IERROR='YES'
      GOTO19000
C
 3820 CONTINUE
      WRITE(ICOUT,3821)
 3821 FORMAT('***** ERROR IN DPFUEV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3822)
 3822 FORMAT('      ALL VARIABLES USED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3823)
 3823 FORMAT('      IN A FUNCTIONAL EXPRESSION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3824)
 3824 FORMAT('      MUST HAVE THE SAME LENGTH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3825)
 3825 FORMAT('      (NUMBER OF ELEMENTS);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3826)
 3826 FORMAT('      SUCH WAS NOT THE CASE HERE FOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3827)IVOLDR,IVOLR2,NIOLDR
 3827 FORMAT('      VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3828)IVNEWR,IVNER2,NINEWR
 3828 FORMAT('      VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3829)
 3829 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3830)(IANS(I),I=1,IWIDTH)
 3830 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 3900 CONTINUE
      ICASER='VAR'
      IF(NUMV.LE.0)ICASER='PARA'
C
 3990 CONTINUE
C
C               *******************************
C               **  STEP 4--                 **
C               **  DETERMINE THE SUBCASE    **
C               **  AND BRANCH ACCORDINGLY.  **
C               *******************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IARG4F=IFOUNZ(4)
      IARG4T=ITYPE(4)
      IARG4I=INT1(4)
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,4001)ICASEL,ICASER,ICASEQ,
     1IARG4F,IARG4T
 4001 FORMAT('***** IN DPFUEV, AT START OF STEP 4; ',
     1'ICASEL,ICASER,ICASEQ,IARG4F,IARG4T = ',
     1A4,1X,A4,1X,A4,1X,A4,1X,A4)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(ICASEQ.EQ.'FULL')GOTO4100
      IF(ICASEQ.EQ.'SUBS')GOTO4200
      IF(ICASEQ.EQ.'FOR')GOTO4300
      IF(ICASEQ.EQ.'IF')GOTO4100
C
 4100 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO4119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4111)
 4111 FORMAT('***** IN MIDDLE OF DPFUEV, AT 4100--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4112)ICASEL,ICASER,IHOL(4),IHOL2(4)
 4112 FORMAT('ICASEL,ICASER,IHOL(4),IHOL2(4) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4113)IARG4F,IARG4T,IARG4I
 4113 FORMAT('IARG4F,IARG4T,IARG4I = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 4119 CONTINUE
C
      IF(ICASEL.EQ.'PARA'.AND.IARG4F.EQ.'NO'.AND.ICASER.EQ.'PARA')
     1GOTO5000
      IF(ICASEL.EQ.'PARA'.AND.IARG4F.EQ.'NO'.AND.ICASER.EQ.'ELEM')
     1GOTO5000
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'NO'.AND.ICASER.EQ.'VAR')
     1GOTO7000
C
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'YES'.AND.IHOL(4).EQ.'I   '.AND.
     1IHOL2(4).EQ.'    ')GOTO6000
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD'.AND.
     1IARG4I.LE.0)GOTO7000
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD'.AND.
     1IARG4I.GE.1)GOTO6000
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'NUMB'
     1.AND.ICASER.EQ.'PARA')GOTO6000
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'NUMB'
     1.AND.ICASER.EQ.'ELEM')GOTO6000
C
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'NO'.AND.ICASER.EQ.'PARA')
     1GOTO5000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'NO'.AND.ICASER.EQ.'ELEM')
     1GOTO5000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'NO'.AND.ICASER.EQ.'VAR')
     1GOTO7000
C
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD'
     1.AND.IARG4I.LE.0.AND.ICASER.EQ.'VAR')GOTO7000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD'
     1.AND.IARG4I.GE.1.AND.ICASER.EQ.'VAR')GOTO6000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD'
     1.AND.IARG4I.GE.1.AND.ICASER.EQ.'PARA')GOTO6000
CCCCC THE FOLLOWING 2 LINES WERE INSERTED TO SOLVE    (DECEMBER 1988)
CCCCC THE PROBLEM OF AN ERROR MESSAGE AND NO-ACTION    (DECEMBER 1988)
CCCCC FROM (E.G.,) LET Y(K) = X(K) INSIDE A LOOP   (DECEMBER 1988)
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD'
     1.AND.IARG4I.GE.1.AND.ICASER.EQ.'ELEM')GOTO6000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'NUMB'
     1.AND.ICASER.EQ.'PARA')GOTO6000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'NUMB'
     1.AND.ICASER.EQ.'ELEM')GOTO6000
      GOTO4800
C
 4200 CONTINUE
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'NO')
     1GOTO8000
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD')
     1GOTO8000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'NO')
     1GOTO8000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD')
     1GOTO8000
      GOTO4800
C
 4300 CONTINUE
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'NO')
     1GOTO9000
      IF(ICASEL.EQ.'VAR'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD')
     1GOTO9000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'NO')
     1GOTO9000
      IF(ICASEL.EQ.'UNKN'.AND.IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD')
     1GOTO9000
      GOTO4800
C
 4800 CONTINUE
      WRITE(ICOUT,4811)
 4811 FORMAT('***** ERROR IN DPFUEV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4812)
 4812 FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4814)
 4814 FORMAT('      POSSIBLE CAUSE--UNDEFINED PARAMETER/VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4815)
 4815 FORMAT('      ON RIGHT-HAND SIDE OF EQUAL SIGN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4816)ICASEL,ICASER,ICASEQ
 4816 FORMAT(6X,'ICASEL, ICASER, ICASEQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4818)
 4818 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4819)(IANS(I),I=1,IWIDTH)
 4819 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
C               *****************************************************
C               **  STEP 5--                                       **
C               **  TREAT THE PARAMETER CASE.                      **
C               **  EXAMPLES--                                     **
C               **            LET A    = X(2)                      **
C               **            LET A    = 3*SIN(4)                  **
C               **            LET A    = B*SIN(B)                  **
C               **            LET U    = X(2)                      **
C               **            LET U    = 3*SIN(4)                  **
C               **            LET U    = B*SIN(B)                  **
C               **  WHERE A WAS A PREVIOUSLY-DEFINED PARAMETER     **
C               **  AND WHERE U WAS PREVIOUSLY UNDEFINED.          **
C               **  CARRY OUT THE LIST UPDATING  AND               **
C               **  GENERATE THE INFORMATIVE PRINTING.             **
C               **  THEN EXIT.                                     **
C               *****************************************************
C
 5000 CONTINUE
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'IF')GOTO5050
      GOTO5090
 5050 CONTINUE
      ICASIF='TRUE'
      IHSET=IHOL(12)
      IHSET2=IHOL2(12)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
C
      NISET=IN(ILOC)
      CALL DPIF(ILOCS,ICASIF,IBUGQ,IERROR)
 5090 CONTINUE
C
      IF(ICASER.EQ.'ELEM')GOTO5200
      IF(ICASER.EQ.'PARA')GOTO5300
C
 5100 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5101)
 5101 FORMAT('***** INTERNAL ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5102)
 5102 FORMAT('      AT BRANCH POINT 5101--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5103)ICASER
 5103 FORMAT('      ICASER = ',A4,' DETECTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5104)
 5104 FORMAT('      IN STEP 5 (PARAMETER CALCULATION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5106)
 5106 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5107)(IANS(I),I=1,IWIDTH)
 5107 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 5200 CONTINUE
      IF(ICASEQ.EQ.'IF'.AND.ICASIF.EQ.'FALS')GOTO5119
      IARG9I=INT1(9)
      IJ=MAXN*(ICOLR-1)+IARG9I
      IF(ICOLR.LE.MAXCOL)RIGHT=V(IJ)
      IF(ICOLR.EQ.MAXCP1)RIGHT=PRED(IARG9I)
      IF(ICOLR.EQ.MAXCP2)RIGHT=RES(IARG9I)
      IF(ICOLR.EQ.MAXCP3)RIGHT=YPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP4)RIGHT=XPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP5)RIGHT=X2PLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP6)RIGHT=TAGPLO(IARG9I)
      GOTO5500
C
 5300 CONTINUE
      IF(ICASEQ.EQ.'IF'.AND.ICASIF.EQ.'FALS')GOTO5119
      IF(NUMPAR.LE.0)GOTO5490
      DO5400J=1,NUMPAR
      IPJ=IPARN(J)
      IPJ2=IPARN2(J)
      DO5450I=1,NUMNAM
      I2=I
      IF(IPJ.EQ.IHNAME(I).AND.IPJ2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO5460
 5450 CONTINUE
      GOTO5480
 5460 CONTINUE
      PARAM(J)=VALUE(I2)
 5400 CONTINUE
      GOTO5490
C
 5480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5481)
 5481 FORMAT('***** INTERNAL ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5482)
 5482 FORMAT('      AT BRANCH POINT 5481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5483)
 5483 FORMAT('      PARAMETER NAME FOR FUNCTION EVALUATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5484)
 5484 FORMAT('      NOT FOUND IN INTERNAL LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5485)IPJ,IPJ2
 5485 FORMAT('      PARAMETER NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5486)
 5486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5487)(IANS(I),I=1,IWIDTH)
 5487 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 5490 CONTINUE
      IPASS=2
      CALL COMPIM(IA,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPAR,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,RIGHT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      GOTO5500
C
 5500 CONTINUE
      IFOUND='YES'
      IHNAME(ILISTL)=ILEFT
      IHNAM2(ILISTL)=ILEFT2
      IUSE(ILISTL)='P'
      VALUE(ILISTL)=RIGHT
CCCCC IVALUE(ILISTL)=VALUE(ILISTL)+0.5
C
CCCCC MARCH 2002.  CHANGE CODE BELOW.  BASE ON LARGEST INTEGER AS
CCCCC GIVEN IN DPCOMC.
CCCCC CUTOFF=2**(NUMBPW-3)
C3/02 ICUTMX=NUMBPW
C3/02 IF(IHOST1.EQ.'CDC '.OR.IHOST1.EQ.'CYBE')ICUTMX=48
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1989
C3/02 IF(IHOST1.EQ.'205 ')ICUTMX=48
C3/02 CUTOFF=2**(ICUTMX-3)
      CUTOFF=REAL(I1MACH(9)-1)
C
      IF((-CUTOFF).LE.RIGHT.AND.RIGHT.LE.CUTOFF)THEN
        IVALUE(ILISTL)=RIGHT+0.5
      ELSEIF(RIGHT.GT.CUTOFF)THEN
        IVALUE(ILISTL)=I1MACH(9)-1
      ELSEIF(RIGHT.LT.(-CUTOFF))THEN
        IVALUE(ILISTL)=-(I1MACH(9)-1)
      ELSE
        IVALUE(ILISTL)=0
      ENDIF
      IN(ILISTL)=1
C
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
C
      IF(IPRINT.EQ.'OFF')GOTO5119
      IF(IFEEDB.EQ.'OFF')GOTO5119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5111)ILEFT,ILEFT2,RIGHT
 5111 FORMAT('THE COMPUTED VALUE OF THE CONSTANT ',
     1A4,A4,' = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 5119 CONTINUE
      GOTO19000
C
C               *****************************************************
C               **  STEP 6--                                       **
C               **  TREAT THE ELEMENT SPECIFICATION CASE.          **
C               **  EXAMPLES--                                     **
C               **            LET Y(2) = X(2)                      **
C               **            LET Y(2) = 3*SIN(4)                  **
C               **            LET Y(2) = B*SIN(B)                  **
C               **            LET U(2) = X(2)                      **
C               **            LET U(2) = 3*SIN(4)                  **
C               **            LET U(2) = B*SIN(B)                  **
C               **  WHERE Y WAS A PREVIOUSLY-DEFINED VARIABLE      **
C               **  AND WHERE U WAS PREVIOUSLY UNDEFINED.          **
C               **  CARRY OUT THE LIST UPDATING  AND               **
C               **  GENERATE THE INFORMATIVE PRINTING.             **
C               **  THEN EXIT.                                     **
C               *****************************************************
C
 6000 CONTINUE
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IARG4I=INT1(4)
C
      IF(1.LE.IARG4I.AND.IARG4I.LE.MAXN)GOTO6050
      WRITE(ICOUT,6061)
 6061 FORMAT('***** ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6062)IARG4I,ILEFT,ILEFT2
 6062 FORMAT('      THE SPECIFIED ROW (',I8,') OF VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6063)
 6063 FORMAT('      ON THE LEFT SIDE OF THE EQUAL SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6064)
 6064 FORMAT('      WAS LESS THAN 1 OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6065)MAXN
 6065 FORMAT('      GREATER THAN THE MAX ALLOWABLE ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 6050 CONTINUE
      IF(ICASEL.EQ.'VAR')ICOLL=IVALUE(ILISTL)
      IF(ICASEL.EQ.'UNKN')ICOLL=NUMCOL+1
      IF(ICOLL.LE.MAXCOL)GOTO6090
      WRITE(ICOUT,6051)
 6051 FORMAT('***** ERROR IN DPFUEV AT 6051--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6052)
 6052 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6053)MAXCOL
 6053 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6054)
 6054 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6055)
 6055 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6056)
 6056 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6057)
 6057 FORMAT('      AND THEN OVERWRITE SOME COLUMN.   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6058)
 6058 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,6059)(IANS(I),I=1,IWIDTH)
 6059 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 6090 CONTINUE
      IF(ICASEL.EQ.'VAR'.AND.IARG4I.LE.NILEFT)NINEW=NILEFT
      IF(ICASEL.EQ.'VAR'.AND.IARG4I.GT.NILEFT)NINEW=IARG4I
      IF(ICASEL.EQ.'UNKN')NINEW=IARG4I
C
      IF(ICASER.EQ.'ELEM')GOTO6200
      IF(ICASER.EQ.'PARA')GOTO6300
C
 6100 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6101)
 6101 FORMAT('***** INTERNAL ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6102)
 6102 FORMAT('      AT BRANCH POINT 6101--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6103)ICASER
 6103 FORMAT('      ICASER = ',A4,' DETECTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6104)
 6104 FORMAT('      IN STEP 6 (ELEMENT CALCULATION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6106)
 6106 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,6107)(IANS(I),I=1,IWIDTH)
 6107 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 6200 CONTINUE
      IARG9I=INT1(9)
      IJ=MAXN*(ICOLR-1)+IARG9I
      IF(ICOLR.LE.MAXCOL)RIGHT=V(IJ)
      IF(ICOLR.EQ.MAXCP1)RIGHT=PRED(IARG9I)
      IF(ICOLR.EQ.MAXCP2)RIGHT=RES(IARG9I)
      IF(ICOLR.EQ.MAXCP3)RIGHT=YPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP4)RIGHT=XPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP5)RIGHT=X2PLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP6)RIGHT=TAGPLO(IARG9I)
      IJ=MAXN*(ICOLL-1)+IARG4I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(IARG4I)=RIGHT
      GOTO6500
C
 6300 CONTINUE
      IF(NUMPAR.LE.0)GOTO6490
      DO6400J=1,NUMPAR
      IPJ=IPARN(J)
      IPJ2=IPARN2(J)
      DO6450I=1,NUMNAM
      I2=I
      IF(IPJ.EQ.IHNAME(I).AND.IPJ2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO6460
 6450 CONTINUE
      GOTO6480
 6460 CONTINUE
      PARAM(J)=VALUE(I2)
 6400 CONTINUE
      GOTO6490
C
 6480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6481)
 6481 FORMAT('***** INTERNAL ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6482)
 6482 FORMAT('      AT BRANCH POINT 6481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6483)
 6483 FORMAT('      PARAMETER NAME FOR FUNCTION EVALUATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6484)
 6484 FORMAT('      NOT FOUND IN INTERNAL LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6485)IPJ,IPJ2
 6485 FORMAT('      PARAMETER NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6486)
 6486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,6487)(IANS(I),I=1,IWIDTH)
 6487 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 6490 CONTINUE
      IPASS=2
      CALL COMPIM(IA,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPAR,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,RIGHT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      IJ=MAXN*(ICOLL-1)+IARG4I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(IARG4I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(IARG4I)=RIGHT
      GOTO6500
C
 6500 CONTINUE
      IFOUND='YES'
      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
      DO6600J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO6605
      GOTO6600
 6605 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
 6600 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO6119
      IF(IFEEDB.EQ.'OFF')GOTO6119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6111)ILEFT,ILEFT2,IARG4I,RIGHT
 6111 FORMAT('THE COMPUTED VALUE OF ',
     1A4,A4,'(',I6,') = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6112)ILEFT,ILEFT2,ICOLL
 6112 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6113)ILEFT,ILEFT2,NINEW
 6113 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 6119 CONTINUE
      GOTO19000
C
C               *****************************************************
C               **  STEP 7--                                       **
C               **  TREAT THE FULL VARIABLE CASE.                  **
C               **  EXAMPLES--                                     **
C               **            LET Y    = X*SIN(X)                  **
C               **            LET Y(I) = I                         **
C               **            LET Y(I) = X(2)                      **
C               **            LET Y(I) = 3*SIN(4)                  **
C               **            LET Y(I) = B*SIN(B)                  **
C               **            LET Y(I) = X*SIN(X)                  **
C               **            LET U    = X*SIN(X)                  **
C               **            LET U(I) = X*SIN(X)                  **
C               **  WHERE Y WAS A PREVIOUSLY-DEFINED VARIABLE      **
C               **  AND WHERE U WAS PREVIOUSLY UNDEFINED.          **
C               **  THEN JUMP TO STEP NUMBER 10 BELOW              **
C               **  FOR THE THE LIST UPDATING AND                  **
C               **  GENERATE THE INFORMATIVE PRINTING.             **
C               **  THEN EXIT.                                     **
C               *****************************************************
C
 7000 CONTINUE
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEL.EQ.'VAR')ICOLL=IVALUE(ILISTL)
      IF(ICASEL.EQ.'UNKN')ICOLL=NUMCOL+1
CCCCC IF(ILEFT.EQ.'PRED'.AND.ILEFT2.EQ.'    ')GOTO7090  MARCH 1988
CCCCC IF(ILEFT.EQ.'RES '.AND.ILEFT2.EQ.'    ')GOTO7090  MARCH 1988
      IF(ICOLL.LE.MAXCOL)GOTO7090
CCCCC THE FOLLOWING LINE WAS INSERTED MARCH 1988
CCCCC TO FIX THE PROBLEM OF LET PRED = ... SUBSET ...
CCCCC YIELDING A "TOO MANY VARIABLES" MESSAGE
      IF(ICASEL.EQ.'VAR')GOTO7090
      WRITE(ICOUT,7051)
 7051 FORMAT('***** ERROR IN DPFUEV AT 7051--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7052)ICOLL
 7052 FORMAT('      THE NUMBER OF DATA COLUMNS (',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7053)MAXCOL
 7053 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE (',I8,').')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7054)
 7054 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7055)
 7055 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7056)
 7056 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7057)
 7057 FORMAT('      AND THEN OVERWRITE SOME COLUMN.   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7058)
 7058 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7059)(IANS(I),I=1,IWIDTH)
 7059 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 7090 CONTINUE
      NINEW=NILEFT
      IF(ICASER.EQ.'VAR')NINEW=NIRIGH
C
      IF(ICASER.EQ.'DUMM')GOTO7100
      IF(ICASER.EQ.'ELEM')GOTO7200
      IF(ICASER.EQ.'PARA')GOTO7300
      IF(ICASER.EQ.'VAR')GOTO7300
C
 7100 CONTINUE
      NS2=0
      DO7150I=1,NINEW
      NS2=NS2+1
      RIGHT=I
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=RIGHT
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 7150 CONTINUE
      GOTO10000
C
 7200 CONTINUE
      IARG9I=INT1(9)
      IJ=MAXN*(ICOLR-1)+IARG9I
      IF(ICOLR.LE.MAXCOL)RIGHT=V(IJ)
      IF(ICOLR.EQ.MAXCP1)RIGHT=PRED(IARG9I)
      IF(ICOLR.EQ.MAXCP2)RIGHT=RES(IARG9I)
      IF(ICOLR.EQ.MAXCP3)RIGHT=YPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP4)RIGHT=XPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP5)RIGHT=X2PLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP6)RIGHT=TAGPLO(IARG9I)
      NS2=0
      DO7250I=1,NINEW
      NS2=NS2+1
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=RIGHT
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 7250 CONTINUE
      GOTO10000
C
 7300 CONTINUE
      IPASS=2
      NS2=0
      DO7350I=1,NINEW
      NS2=NS2+1
C
      IF(NUMPAR.LE.0)GOTO7390
      DO7355J=1,NUMPAR
      IPJ=IPARN(J)
      IPJ2=IPARN2(J)
      DO7356K=1,NUMNAM
      K2=K
      IF(IPJ.EQ.IHNAME(K).AND.IPJ2.EQ.IHNAM2(K).AND.
     1IUSE(K).EQ.'P')GOTO7360
      IF(IPJ.EQ.IHNAME(K).AND.IPJ2.EQ.IHNAM2(K).AND.
     1IUSE(K).EQ.'V')GOTO7370
 7356 CONTINUE
      GOTO7380
C
 7360 CONTINUE
      PARAM(J)=VALUE(K2)
      GOTO7355
C
 7370 CONTINUE
      ICOLK2=IVALUE(K2)
      IJ=MAXN*(ICOLK2-1)+I
      IF(ICOLK2.LE.MAXCOL)PARAM(J)=V(IJ)
      IF(ICOLK2.EQ.MAXCP1)PARAM(J)=PRED(I)
      IF(ICOLK2.EQ.MAXCP2)PARAM(J)=RES(I)
      IF(ICOLK2.EQ.MAXCP3)PARAM(J)=YPLOT(I)
      IF(ICOLK2.EQ.MAXCP4)PARAM(J)=XPLOT(I)
      IF(ICOLK2.EQ.MAXCP5)PARAM(J)=X2PLOT(I)
      IF(ICOLK2.EQ.MAXCP6)PARAM(J)=TAGPLO(I)
 7355 CONTINUE
      GOTO7390
C
 7380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7381)
 7381 FORMAT('***** INTERNAL ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7382)
 7382 FORMAT('      AT BRANCH POINT 7381--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7383)
 7383 FORMAT('      PARAMETER/VARIABLE NAME FOR FUNCTION ',
     1'EVALUATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7384)
 7384 FORMAT('      NOT FOUND IN INTERNAL LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7385)IPJ,IPJ2
 7385 FORMAT('      PARAMETER/VARIABLE NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7386)
 7386 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7387)(IANS(I3),I3=1,IWIDTH)
 7387 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 7390 CONTINUE
      CALL COMPIM(IA,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPAR,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,RIGHT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=RIGHT
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 7350 CONTINUE
      GOTO10000
C
C               *****************************************************
C               **  STEP 8--                                       **
C               **  TREAT THE PARTIAL VARIABLE SUBSET CASE.        **
C               **  EXAMPLES--                                     **
C               **            LET Y    = I         SUBSET 2 3 5    **
C               **            LET Y    = X(2)      SUBSET 2 3 5    **
C               **            LET Y    = 3*SIN(4)  SUBSET 2 3 5    **
C               **            LET Y    = B*SIN(B)  SUBSET 2 3 5    **
C               **            LET Y    = X*SIN(X)  SUBSET 2 3 5    **
C               **            LET Y(I) = I         SUBSET 2 3 5    **
C               **            LET Y(I) = X(2)      SUBSET 2 3 5    **
C               **            LET Y(I) = 3*SIN(4)  SUBSET 2 3 5    **
C               **            LET Y(I) = B*SIN(B)  SUBSET 2 3 5    **
C               **            LET Y(I) = X*SIN(X)  SUBSET 2 3 5    **
C               **            LET U    = I         SUBSET 2 3 5    **
C               **            LET U    = X(2)      SUBSET 2 3 5    **
C               **            LET U    = 3*SIN(4)  SUBSET 2 3 5    **
C               **            LET U    = B*SIN(B)  SUBSET 2 3 5    **
C               **            LET U    = X*SIN(X)  SUBSET 2 3 5    **
C               **            LET U(I) = I         SUBSET 2 3 5    **
C               **            LET U(I) = X(2)      SUBSET 2 3 5    **
C               **            LET U(I) = 3*SIN(4)  SUBSET 2 3 5    **
C               **            LET U(I) = B*SIN(B)  SUBSET 2 3 5    **
C               **            LET U(I) = X*SIN(X)  SUBSET 2 3 5    **
C               **  WHERE Y WAS A PREVIOUSLY-DEFINED VARIABLE      **
C               **  AND WHERE U WAS PREVIOUSLY UNDEFINED.          **
C               **  THEN JUMP TO STEP NUMBER 10 BELOW              **
C               **  FOR THE THE LIST UPDATING  AND                 **
C               **  GENERATE THE INFORMATIVE PRINTING.             **
C               **  THEN EXIT.                                     **
C               *****************************************************
C
 8000 CONTINUE
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEL.EQ.'VAR')ICOLL=IVALUE(ILISTL)
      IF(ICASEL.EQ.'UNKN')ICOLL=NUMCOL+1
      IF(ICOLL.LE.MAXCOL)GOTO8090
CCCCC THE FOLLOWING LINE WAS INSERTED MARCH 1988
CCCCC TO FIX THE PROBLEM OF LET PRED = ... SUBSET ...
CCCCC YIELDING A "TOO MANY VARIABLES" MESSAGE
      IF(ICASEL.EQ.'VAR')GOTO8090
      WRITE(ICOUT,8051)
 8051 FORMAT('***** ERROR IN DPFUEV AT 8051--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8052)
 8052 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8053)MAXCOL
 8053 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8054)
 8054 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8055)
 8055 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8056)
 8056 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8057)
 8057 FORMAT('      AND THEN OVERWRITE SOME COLUMN.   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8058)
 8058 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,8059)(IANS(I),I=1,IWIDTH)
 8059 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 8090 CONTINUE
      IHSET=IHOL(12)
      IHSET2=IHOL2(12)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
C
      NISET=IN(ILOC)
      CALL DPSUBS(NISET,ILOCS,NS,IBUGQ,IERROR)
C
      NINEW=NISET
      IF(ICASER.EQ.'VAR')NINEW=NIRIGH
C
      IF(ICASER.EQ.'DUMM')GOTO8100
      IF(ICASER.EQ.'ELEM')GOTO8200
      IF(ICASER.EQ.'PARA')GOTO8300
      IF(ICASER.EQ.'VAR')GOTO8300
C
 8100 CONTINUE
      NS2=0
      DO8150I=1,NISET
      IF(ISUB(I).EQ.0)GOTO8150
      NS2=NS2+1
      RIGHT=I
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=RIGHT
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 8150 CONTINUE
      GOTO10000
C
 8200 CONTINUE
      IARG9I=INT1(9)
      IJ=MAXN*(ICOLR-1)+IARG9I
C ???????????
      IF(ICOLR.LE.MAXCOL)RIGHT=V(IJ)
      IF(ICOLR.EQ.MAXCP1)RIGHT=PRED(IARG9I)
      IF(ICOLR.EQ.MAXCP2)RIGHT=RES(IARG9I)
      IF(ICOLR.EQ.MAXCP3)RIGHT=YPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP4)RIGHT=XPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP5)RIGHT=X2PLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP6)RIGHT=TAGPLO(IARG9I)
      NS2=0
      DO8250I=1,NISET
      IF(ISUB(I).EQ.0)GOTO8250
      NS2=NS2+1
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=RIGHT
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 8250 CONTINUE
      GOTO10000
C
 8300 CONTINUE
      IPASS=2
      IMAX=NISET
      IF(NINEW.LT.IMAX)IMAX=NINEW
      NS2=0
      DO8350I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO8350
      NS2=NS2+1
C
      IF(NUMPAR.LE.0)GOTO8390
      DO8355J=1,NUMPAR
      IPJ=IPARN(J)
      IPJ2=IPARN2(J)
      DO8356K=1,NUMNAM
      K2=K
      IF(IPJ.EQ.IHNAME(K).AND.IPJ2.EQ.IHNAM2(K).AND.
     1IUSE(K).EQ.'P')GOTO8360
      IF(IPJ.EQ.IHNAME(K).AND.IPJ2.EQ.IHNAM2(K).AND.
     1IUSE(K).EQ.'V')GOTO8370
 8356 CONTINUE
      GOTO8380
C
 8360 CONTINUE
      PARAM(J)=VALUE(K2)
      GOTO8355
C
 8370 CONTINUE
      ICOLK2=IVALUE(K2)
      IJ=MAXN*(ICOLK2-1)+I
      IF(ICOLK2.LE.MAXCOL)PARAM(J)=V(IJ)
      IF(ICOLK2.EQ.MAXCP1)PARAM(J)=PRED(I)
      IF(ICOLK2.EQ.MAXCP2)PARAM(J)=RES(I)
      IF(ICOLK2.EQ.MAXCP3)PARAM(J)=YPLOT(I)
      IF(ICOLK2.EQ.MAXCP4)PARAM(J)=XPLOT(I)
      IF(ICOLK2.EQ.MAXCP5)PARAM(J)=X2PLOT(I)
      IF(ICOLK2.EQ.MAXCP6)PARAM(J)=TAGPLO(I)
 8355 CONTINUE
      GOTO8390
C
 8380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8381)
 8381 FORMAT('***** INTERNAL ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8382)
 8382 FORMAT('      AT BRANCH POINT 8381--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8383)
 8383 FORMAT('      PARAMETER/VARIABLE NAME FOR FUNCTION ',
     1'EVALUATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8384)
 8384 FORMAT('      NOT FOUND IN INTERNAL LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8385)IPJ,IPJ2
 8385 FORMAT('      PARAMETER/VARIABLE NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8386)
 8386 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,8387)(IANS(I3),I3=1,IWIDTH)
 8387 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 8390 CONTINUE
      CALL COMPIM(IA,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPAR,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,RIGHT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=RIGHT
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 8350 CONTINUE
      GOTO10000
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  TREAT THE PARTIAL VARIABLE FOR CASE.           **
C               **  EXAMPLES--                                     **
C               **            LET Y    = I         FOR I = 1 2 10  **
C               **            LET Y    = X(2)      FOR I = 1 2 10  **
C               **            LET Y    = 3*SIN(4)  FOR I = 1 2 10  **
C               **            LET Y    = B*SIN(B)  FOR I = 1 2 10  **
C               **            LET Y    = X*SIN(X)  FOR I = 1 2 10  **
C               **            LET Y(I) = I         FOR I = 1 2 10  **
C               **            LET Y(I) = X(2)      FOR I = 1 2 10  **
C               **            LET Y(I) = 3*SIN(4)  FOR I = 1 2 10  **
C               **            LET Y(I) = B*SIN(B)  FOR I = 1 2 10  **
C               **            LET Y(I) = X*SIN(X)  FOR I = 1 2 10  **
C               **            LET U    = I         FOR I = 1 2 10  **
C               **            LET U    = X(2)      FOR I = 1 2 10  **
C               **            LET U    = 3*SIN(4)  FOR I = 1 2 10  **
C               **            LET U    = B*SIN(B)  FOR I = 1 2 10  **
C               **            LET U    = X*SIN(X)  FOR I = 1 2 10  **
C               **            LET U(I) = I         FOR I = 1 2 10  **
C               **            LET U(I) = X(2)      FOR I = 1 2 10  **
C               **            LET U(I) = 3*SIN(4)  FOR I = 1 2 10  **
C               **            LET U(I) = B*SIN(B)  FOR I = 1 2 10  **
C               **            LET U(I) = X*SIN(X)  FOR I = 1 2 10  **
C               **  WHERE Y WAS A PREVIOUSLY-DEFINED VARIABLE      **
C               **  AND WHERE U WAS PREVIOUSLY UNDEFINED.          **
C               **  THEN JUMP TO STEP NUMBER 10 BELOW              **
C               **  FOR THE THE LIST UPDATING  AND                 **
C               **  GENERATE THE INFORMATIVE PRINTING.             **
C               **  THEN EXIT.                                     **
C               *****************************************************
C
 9000 CONTINUE
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEL.EQ.'VAR')ICOLL=IVALUE(ILISTL)
      IF(ICASEL.EQ.'UNKN')ICOLL=NUMCOL+1
      IF(ICOLL.LE.MAXCOL)GOTO9090
CCCCC THE FOLLOWING LINE WAS INSERTED MARCH 1988
CCCCC TO FIX THE PROBLEM OF LET PRED = ... SUBSET ...
CCCCC YIELDING A "TOO MANY VARIABLES" MESSAGE
      IF(ICASEL.EQ.'VAR')GOTO9090
      WRITE(ICOUT,9051)
 9051 FORMAT('***** ERROR IN DPFUEV AT 9051--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)
 9052 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)MAXCOL
 9053 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9054)
 9054 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9055)
 9055 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9056)
 9056 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9057)
 9057 FORMAT('      AND THEN OVERWRITE SOME COLUMN.   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9058)
 9058 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,9059)(IANS(I),I=1,IWIDTH)
 9059 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 9090 CONTINUE
      NIOLD=IN(ILISTL)
      CALL DPFOR(NIOLD,NIFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
C
      NINEW=NIFOR
      IF(ICASER.EQ.'VAR')NINEW=NIRIGH
C
      IF(ICASER.EQ.'DUMM')GOTO9100
      IF(ICASER.EQ.'ELEM')GOTO9200
      IF(ICASER.EQ.'PARA')GOTO9300
      IF(ICASER.EQ.'VAR')GOTO9300
C
 9100 CONTINUE
      NS2=0
      DO9150I=1,NIFOR
      IF(ISUB(I).EQ.0)GOTO9150
      NS2=NS2+1
      RIGHT=I
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=RIGHT
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 9150 CONTINUE
      GOTO10000
C
 9200 CONTINUE
      IARG9I=INT1(9)
      IJ=MAXN*(ICOLR-1)+IARG9I
      IF(ICOLR.LE.MAXCOL)RIGHT=V(IJ)
      IF(ICOLR.EQ.MAXCP1)RIGHT=PRED(IARG9I)
      IF(ICOLR.EQ.MAXCP2)RIGHT=RES(IARG9I)
      IF(ICOLR.EQ.MAXCP3)RIGHT=YPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP4)RIGHT=XPLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP5)RIGHT=X2PLOT(IARG9I)
      IF(ICOLR.EQ.MAXCP6)RIGHT=TAGPLO(IARG9I)
      NS2=0
      DO9250I=1,NIFOR
      IF(ISUB(I).EQ.0)GOTO9250
      NS2=NS2+1
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=RIGHT
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 9250 CONTINUE
      GOTO10000
C
 9300 CONTINUE
      IPASS=2
      IMAX=NIFOR
      IF(NINEW.LT.IMAX)IMAX=NINEW
      NS2=0
      DO9350I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO9350
      NS2=NS2+1
C
      IF(NUMPAR.LE.0)GOTO9390
      DO9355J=1,NUMPAR
      IPJ=IPARN(J)
      IPJ2=IPARN2(J)
      DO9356K=1,NUMNAM
      K2=K
      IF(IPJ.EQ.IHNAME(K).AND.IPJ2.EQ.IHNAM2(K).AND.
     1IUSE(K).EQ.'P')GOTO9360
      IF(IPJ.EQ.IHNAME(K).AND.IPJ2.EQ.IHNAM2(K).AND.
     1IUSE(K).EQ.'V')GOTO9370
 9356 CONTINUE
      GOTO9380
C
 9360 CONTINUE
      PARAM(J)=VALUE(K2)
      GOTO9355
C
 9370 CONTINUE
      ICOLK2=IVALUE(K2)
      IJ=MAXN*(ICOLK2-1)+I
      IF(ICOLK2.LE.MAXCOL)PARAM(J)=V(IJ)
      IF(ICOLK2.EQ.MAXCP1)PARAM(J)=PRED(I)
      IF(ICOLK2.EQ.MAXCP2)PARAM(J)=RES(I)
      IF(ICOLK2.EQ.MAXCP3)PARAM(J)=YPLOT(I)
      IF(ICOLK2.EQ.MAXCP4)PARAM(J)=XPLOT(I)
      IF(ICOLK2.EQ.MAXCP5)PARAM(J)=X2PLOT(I)
      IF(ICOLK2.EQ.MAXCP6)PARAM(J)=TAGPLO(I)
 9355 CONTINUE
      GOTO9390
C
 9380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9381)
 9381 FORMAT('***** INTERNAL ERROR IN DPFUEV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9382)
 9382 FORMAT('      AT BRANCH POINT 9381--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9393)
 9393 FORMAT('      PARAMETER/VARIABLE NAME FOR FUNCTION ',
     1'EVALUATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9384)
 9384 FORMAT('      NOT FOUND IN INTERNAL LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9385)IPJ,IPJ2
 9385 FORMAT('      PARAMETER/VARIABLE NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9386)
 9386 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,9387)(IANS(I3),I3=1,IWIDTH)
 9387 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 9390 CONTINUE
      CALL COMPIM(IA,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPAR,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,RIGHT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(I)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(I)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=RIGHT
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 9350 CONTINUE
      GOTO10000
C
C               *******************************************
C               **  STEP 10--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING    **
C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
C               *******************************************
C
10000 CONTINUE
      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
      DO10100J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO10105
      GOTO10100
10105 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
10100 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO10099
      IF(IFEEDB.EQ.'OFF')GOTO10099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,10011)ILEFT,ILEFT2,NS2
10011 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,10021)ILEFT,ILEFT2,V(IJ),IROW1
10021 FORMAT('THE FIRST          COMPUTED VALUE OF ',A4,A4,
     1' = ',E13.6,' (ROW ',I5,')')
      IF(ICOLL.LE.MAXCOL)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1)WRITE(ICOUT,10021)ILEFT,ILEFT2,PRED(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2)WRITE(ICOUT,10021)ILEFT,ILEFT2,RES(IROW1),IROW1
      IF(ICOLL.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3)WRITE(ICOUT,10021)ILEFT,ILEFT2,YPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP3)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4)WRITE(ICOUT,10021)ILEFT,ILEFT2,XPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP4)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5)WRITE(ICOUT,10021)ILEFT,ILEFT2,X2PLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP5)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6)WRITE(ICOUT,10021)ILEFT,ILEFT2,TAGPLO(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP6)CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL-1)+IROWN
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)WRITE(ICOUT,10031)NS2,ILEFT,ILEFT2,V(IJ),IROWN
10031 FORMAT('THE LAST (',I5,'TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E13.6,' (ROW ',I5,')')
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS2.NE.1)WRITE(ICOUT,10031)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,10031)NS2,ILEFT,ILEFT2,YPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)WRITE(ICOUT,10031)NS2,ILEFT,ILEFT2,XPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)WRITE(ICOUT,10031)NS2,ILEFT,ILEFT2,X2PLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)WRITE(ICOUT,10031)NS2,ILEFT,ILEFT2,TAGPLO(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)WRITE(ICOUT,10031)NS2,ILEFT,ILEFT2,RES(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(NS2.NE.1)GOTO10090
      WRITE(ICOUT,10041)
10041 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,10042)
10042 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
10090 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,10092)ILEFT,ILEFT2,ICOLL
10092 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,10093)ILEFT,ILEFT2,NINEW
10093 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
10099 CONTINUE
      GOTO19000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
19000 CONTINUE
C
C  RESTORE ORIGINAL FUNCTION TABLE
C
      DO19001I=1,NUMCHF
        IFUNC(I)=IFSAVE(I)
19001 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO19090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19011)
19011 FORMAT('***** AT THE END       OF DPFUEV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19012)IBUGA3
19012 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19013)IBUGCO,IBUGEV
19013 FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19014)IBUGQ
19014 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19015)IANGLU
19015 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19016)IFOUND,IERROR
19016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19017)NUMNAM
19017 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19018)ICASEQ,ICASIF
19018 FORMAT('ICASEQ,ICASIF = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO19020I=1,NUMNAM
      WRITE(ICOUT,19021)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
19021 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
19020 CONTINUE
19090 CONTINUE
C
      RETURN
      END
