      SUBROUTINE DPECHO(IANS,IWIDTH)
C
C     PURPOSE--ECHO THE CURRENT COMMAND LINE.
C              THIS IS ESPECIALLY USEFUL WHEN A SET OF
C              DATAPLOT COMMANDS ARE 'ADDED' IN BULK
C              FROM A MACRO ON MASS STORAGE.
C     INPUT  ARGUMENTS--IANS   (A  HOLLERITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              ORIGINAL INPUT COMMAND LINE.
C                     --IWIDTH (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE ORIGINAL COMMAND LINE.
C     OUTPUT ARGUMENTS--NONE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
C
      CHARACTER*4 ISTAR
      CHARACTER*4 IBLANK
C
C---------------------------------------------------------------------
C
      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
      ISTAR='*'
      IBLANK=' '
C
      ISTART=1
      IF(IWIDTH.LE.0)GOTO240
      DO200I=1,IWIDTH
      IREV=IWIDTH-I+1
      IF(IANS(IREV).NE.' ')GOTO220
  200 CONTINUE
      ISTOP=ISTART
      GOTO260
  220 CONTINUE
      ISTOP=IREV
      GOTO260
  240 CONTINUE
      ISTOP=1
      GOTO260
  260 CONTINUE
C
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      ISTOP8=ISTOP+8
      WRITE(ICOUT,261)(ISTAR,I=1,ISTOP8)
  261 FORMAT(6X,124A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)ISTAR,ISTAR,IBLANK,IBLANK,
     1(IANS(I),I=ISTART,ISTOP),IBLANK,IBLANK,ISTAR,ISTAR
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)(ISTAR,I=1,ISTOP8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
  290 CONTINUE
      RETURN
      END
      SUBROUTINE DPECSW(IHARG,NUMARG,
     1IECHO,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY THE ECHO SWITCH WHICH IN TURN
C              DETERMINES WHETHER ENTERED COMMANDS WILL BE
C                 ECHOED BACK    (IN A BOX FOR ACCENTUATION)
C              TO THE TERMINAL.
C              THIS CAPABILITY IS USEFUL FOR MONITORING THE
C              PROGRESS OF A MACRO WHICH HAS BEEN ADDED
C              FROM MASS STORAGE.
C              THE SPECIFIED ECHO SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IECHO.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IECHO  (A HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IECHO
      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'
      IECHO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IECHO
 1181 FORMAT('THE ECHO SWITCH HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPEINL(ICAPSW,IFORSW,ISUBRO,IBUGA2,IBUGA3,IBUGQ,
     1                  IFOUND,IERROR)
C
C     PURPOSE--PERFORM AN INTERLABORATORY STUDY ACCORDING TO
C              ASTM E 691 STANDARD.
C
C              THE DATA CONSISTS OF DATA GROUPED BY MATERIALS AND
C              LABS.  EACH COMINATION OF MATERIAL AND LAB IS REFERRED
C              TO AS A CELL AND IT IS ASSUMED THAT THE CELLS HAVE
C              THE SAME NUMBER OF REPLICATIONS.
C
C              THERE ARE 4 BASIC
C              QUANTITIES COMPUTED:
C              1) REPEATABILITY STANDARD DEVIATION
C              2) REPRODUCABILITY STANDARD DEVIATION
C              3) H CONSISTENCY STATISTIC
C              4) K CONSISTENCY STATISTIC
C              THESE ARE ALL NOW AVAILABLE AS SEPARATE COMMANDS.
C              THE PRIMARY FUNCTION OF THIS
C
C                  E691 INTERLAB  Y  LABID  MATID
C
C              COMMAND IS TO GENERATE THE FOLLOWING 4 TABLES BASED
C              ON THESE BASIC QUANTITIES:
C              1) FOR EACH MATERIAL, PRINT
C                 A) LAB ID
C                 B) Cell Average
C                 C) Cell Standard Deviation
C                 D) Deviation of Cell Average from Overall Average
C                    (for that material)
C                 E) h Consistency Statistic for each cell
C                 F) k Consistency Statistic for each cell
C              2) A TWO-WAY TABLE (ROWS ARE LABS AND COLUMNS ARE
C                 MATERIALS) OF THE h CONSISTENCY STATISTIC
C              3) A TWO-WAY TABLE (ROWS ARE LABS AND COLUMNS ARE
C                 MATERIALS) OF THE k CONSISTENCY STATISTIC
C              4) A TABLE SUMMARIZING THE PRECISION STATISTICS
C                 FOR EACH MATERIAL.
C     WRITTEN BY--JAMES FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES----------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 IFORSW
      CHARACTER*4 ISUBRO
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
      CHARACTER*4 IHFACT
      CHARACTER*4 IHFAC2
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      REAL KCV
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION Y3(MAXOBV)
C
      DIMENSION Z1(MAXOBV)
      DIMENSION Z2(MAXOBV)
      DIMENSION Z3(MAXOBV)
      DIMENSION Z4(MAXOBV)
      DIMENSION Z5(MAXOBV)
      DIMENSION Z6(MAXOBV)
      DIMENSION Z7(MAXOBV)
      DIMENSION Z8(MAXOBV)
      DIMENSION Z9(MAXOBV)
      DIMENSION Z10(MAXOBV)
      DIMENSION Z11(MAXOBV)
      DIMENSION Z12(MAXOBV)
      DIMENSION Z13(MAXOBV)
      DIMENSION Z14(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
      EQUIVALENCE (GARBAG(IGARB4),Z1(1))
      EQUIVALENCE (GARBAG(IGARB5),Z2(1))
      EQUIVALENCE (GARBAG(IGARB7),Z3(1))
      EQUIVALENCE (GARBAG(IGARB9),Z4(1))
      EQUIVALENCE (GARBAG(JGAR11),Z5(1))
      EQUIVALENCE (GARBAG(JGAR12),Z6(1))
      EQUIVALENCE (GARBAG(JGAR13),Z7(1))
      EQUIVALENCE (GARBAG(JGAR14),Z8(1))
      EQUIVALENCE (GARBAG(JGAR15),Z9(1))
      EQUIVALENCE (GARBAG(JGAR16),Z10(1))
      EQUIVALENCE (GARBAG(JGAR17),Z11(1))
      EQUIVALENCE (GARBAG(JGAR18),Z12(1))
      EQUIVALENCE (GARBAG(JGAR19),Z13(1))
      EQUIVALENCE (GARBAG(JGAR20),Z14(1))
C
      DIMENSION ICOLIV(10)
      DIMENSION NIV(10)
C
C-----COMMON----------------------------------------------------
C
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.INC'
C
C----------------------------------------------------------------
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='DPEI'
      ISUBN2='LA  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      MAXV2=100
      MINN2=2
C
      ICASEQ='UNKN'
C
C               *********************************************
C               **  TREAT THE E691 INTERLAB ANALYSIS CASE  **
C               *********************************************
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPEINL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ
   52   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.ICOM.EQ.'E691'.AND.
     1   IHARG(1).EQ.'INTE'.AND.IHARG(2).EQ.'ANAL')THEN
        ILASTC=2
      ELSEIF(NUMARG.GE.1.AND.ICOM.EQ.'E691'.AND.
     1   IHARG(1).EQ.'INTE')THEN
        ILASTC=1
      ELSE
        IFOUND='NO'
        GOTO9000
      ENDIF
C
      IFOUND='YES'
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
C
C               **************************************************
C               **  STEP 2--                                    **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT        **
C               **  ARGUMENTS.                                  **
C               **************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL 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 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               *************************************************
C               **  STEP 4--                                   **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS**
C               **  (NLEFT)                                    **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.    **
C               *************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,311)
  311   FORMAT('***** ERROR IN E691 INTERLAB ANALYSIS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,312)
  312   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH AN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,313)
  313   FORMAT('      E691 INTERLAB ANALYSIS WAS TO HAVE BEEN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,315)MINN2
  315   FORMAT('      PERFORMED MUST BE ',I8,' OR LARGER;  SUCH WAS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,316)NLEFT
  316   FORMAT('      NOT THE CASE HERE.  NLEFT = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,318)
  318   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,319)(IANS(I),I=1,MAX(IWIDTH,80))
  319     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')THEN
        WRITE(ICOUT,491)NUMARG,ILOCQ
  491   FORMAT('NUMARG,ILOCQ = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ******************************************
C               **  STEP 6--                            **
C               **  CHECK FOR A VALID NUMBER            **
C               **  OF VARIABLES (3).                   **
C               **  CHECK THE VALIDITY OF EACH          **
C               **  OF THE VARIABLES (THAT IS, FOR EACH **
C               **  OF THE VARIABLES, DOES THE NAME     **
C               **  EXIST IN THE TABLE?  DOES THE NUMBER**
C               **  OF ELEMENTS  AGREE WITH THE NUMBER  **
C               **  OF ELEMENTS IN THE FIRST VARIABLE?  **
C               ******************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.LT.3 .OR. NUMVAR.GT.100)THEN
        WRITE(ICOUT,511)
  511   FORMAT('***** ERROR IN E691 INTERLAB ANALYSIS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,512)
  512   FORMAT('      FOR AN E691 INTERLAB ANALYSIS, THE NUMBER OF')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,514)MAXV2
  514   FORMAT('      VARIABLES MUST BE AT LEAST 3 AND AT MOST ',
     1         I8,'  ;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,515)
  515   FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,517)NUMVAR
  517   FORMAT('      NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,518)
  518   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,519)(IANS(I),I=1,MAX(80,IWIDTH))
  519     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO530IFAC=2,NUMVAR
        J=IFAC
        IHFACT=IHARG(J)
        IHFAC2=IHARG2(J)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHFACT,IHFAC2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IF(IFAC.EQ.2)THEN
          IHRIGH=IHFACT
          IHRIG2=IHFAC2
        ELSEIF(IFAC.EQ.3)THEN
          IHRI21=IHFACT
          IHRI22=IHFAC2
        ENDIF
        ICOLIV(IFAC-1)=IVALUE(ILOCV)
        NIV(IFAC-1)=IN(ILOCV)
        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')THEN
          WRITE(ICOUT,532)IFAC,IHFACT,IHFAC2,ICOLIV(IFAC-1),NIV(IFAC-1)
  532     FORMAT('IFAC,IHFACT,IHFAC2,ICOLIV(IFAC-1),NIV(IFAC-1) = ',
     1           I8,2X,A4,2X,A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
  530 CONTINUE
C
      DO540IFAC=1,NUMVAR-1
        IF(NIV(IFAC).NE.NLEFT)THEN
          WRITE(ICOUT,551)
  551     FORMAT('***** ERROR IN E691 INTERLAB ANALYSIS--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,552)
  552     FORMAT('      FOR A E691 INTERLAB ANALYSIS, THE NUMBER OF')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,554)
  554     FORMAT('      ELEMENTS IN EACH VARIABLE SHOULD BE THE SAME;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,557)
  557     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          DO565IFAC2=1,NUMVAR
            IF(IFAC2.EQ.1)THEN
              NELEM=NLEFT
            ELSE
              NELEM=NIV(IFAC2-1)
            ENDIF
            WRITE(ICOUT,566)IHARG(IFAC2),IHARG2(IFAC2),NELEM
  566      FORMAT('      VARIABLE',A4,A4,'  HAS ',I8,' ELEMENTS')
           CALL DPWRST('XXX','BUG ')
  565    CONTINUE
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,567)
  567    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
           WRITE(ICOUT,568)(IANS(I),I=1,MAX(80,IWIDTH))
  568      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
        ENDIF
  540 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
         IF(ISUB(I).EQ.0)GOTO660
         J=J+1
C
         IJ=MAXN*(ICOLL-1)+I
         IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
         IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
         IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
         IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
         IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
         IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
         IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
         IFAC=1
         ICOLR=ICOLIV(IFAC)
         IJ=MAXN*(ICOLR-1)+I
         IF(ICOLR.LE.MAXCOL)Y2(J)=V(IJ)
         IF(ICOLR.EQ.MAXCP1)Y2(J)=PRED(I)
         IF(ICOLR.EQ.MAXCP2)Y2(J)=RES(I)
         IF(ICOLR.EQ.MAXCP3)Y2(J)=YPLOT(I)
         IF(ICOLR.EQ.MAXCP4)Y2(J)=XPLOT(I)
         IF(ICOLR.EQ.MAXCP5)Y2(J)=X2PLOT(I)
         IF(ICOLR.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
         IFAC=2
         ICOLR=ICOLIV(IFAC)
         IJ=MAXN*(ICOLR-1)+I
         IF(ICOLR.LE.MAXCOL)Y3(J)=V(IJ)
         IF(ICOLR.EQ.MAXCP1)Y3(J)=PRED(I)
         IF(ICOLR.EQ.MAXCP2)Y3(J)=RES(I)
         IF(ICOLR.EQ.MAXCP3)Y3(J)=YPLOT(I)
         IF(ICOLR.EQ.MAXCP4)Y3(J)=XPLOT(I)
         IF(ICOLR.EQ.MAXCP5)Y3(J)=X2PLOT(I)
         IF(ICOLR.EQ.MAXCP6)Y3(J)=TAGPLO(I)
C
  660 CONTINUE
      NS=J
C
C               **************************************************
C               **  STEP 8--                                    **
C               **  PREPARE FOR ENTRANCE INTO DPMAN2--          **
C               **************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH='ALPH'
      IH2='A   '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        ALPHA=0.005
      ELSE
        ALPHA=VALUE(ILOCP)
      ENDIF
      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)ALPHA=0.005
      IF(ALPHA.GT.0.50)ALPHA=1.0 - ALPHA
C
C               ***********************************************
C               **  STEP 9--                                 **
C               **  CARRY OUT THE E691 INTERLAB ANALYSIS     **
C               ***********************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,711)
  711   FORMAT('***** FROM DPEINL, AS WE ARE ABOUT TO CALL DPEIN2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,712)NLEFT,MAXN,NS,NUMVAR
  712   FORMAT('NLEFT,MAXN,NS,NUMVAR = ',4I8)
        CALL DPWRST('XXX','BUG ')
        DO715I=1,NS
          WRITE(ICOUT,716)I,Y(I),Y2(I),Y3(I)
  716     FORMAT('I,Y1(I),Y2(I),Y3(I) = ',
     1           I6,2X,3G15.7)
          CALL DPWRST('XXX','BUG ')
  715   CONTINUE
        WRITE(ICOUT,731)IBUGA3
  731   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IWRITE='OFF'
      CALL DPEIN2(Y1,Y2,Y3,NS,
     1Z1,Z2,Z3,Z4,Z5,Z6,Z7,Z8,Z9,Z10,Z11,Z12,Z13,Z14,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
     1ALPHA,HCV,KCV,
     1IWRITE,
     1IFORSW,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 10--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='10'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'EINL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH='HCV '
      IH2='    '
      VALUE0=HCV
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='KCV '
      IH2='    '
      VALUE0=KCV
      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.'EINL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPEINL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012   FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)NS,NUMVAR
 9014   FORMAT('NS,NUMVAR = ',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 DPEIN2(Y,X1,X2,N,XIDTEM,XIDTE2,
     1XBAR,XBARI,SDI,SDXBRI,DXBARI,H,AK,SRPT,SRPRD,
     1TEMP1,TEMP2,TAG,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
     1ALPHA,HCV,KCV,
     1IWRITE,
     1IFORSW,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--PERFORM AN INTERLABORATORY STUDY ACCORDING TO
C              ASTM E 691 STANDARD.
C
C              THE DATA CONSISTS OF DATA GROUPED BY MATERIALS AND
C              LABS.  EACH COMINATION OF MATERIAL AND LAB IS REFERRED
C              TO AS A CELL AND IT IS ASSUMED THAT THE CELLS HAVE
C              THE SAME NUMBER OF REPLICATIONS.
C
C              THERE ARE 4 BASIC
C              QUANTITIES COMPUTED:
C              1) REPEATABILITY STANDARD DEVIATION
C              2) REPRODUCABILITY STANDARD DEVIATION
C              3) H CONSISTENCY STATISTIC
C              4) K CONSISTENCY STATISTIC
C              THESE ARE ALL NOW AVAILABLE AS SEPARATE COMMANDS.
C              THE PRIMARY FUNCTION OF THIS
C
C                  E691 INTERLAB  Y  LABID  MATID
C
C              COMMAND IS TO GENERATE THE FOLLOWING 4 TABLES BASED
C              ON THESE BASIC QUANTITIES:
C              1) FOR EACH MATERIAL, PRINT
C                 A) LAB ID
C                 B) Cell Average
C                 C) Cell Standard Deviation
C                 D) Deviation of Cell Average from Overall Average
C                    (for that material)
C                 E) h Consistency Statistic for each cell
C                 F) k Consistency Statistic for each cell
C              2) A TWO-WAY TABLE (ROWS ARE LABS AND COLUMNS ARE
C                 MATERIALS) OF THE h CONSISTENCY STATISTIC
C              3) A TWO-WAY TABLE (ROWS ARE LABS AND COLUMNS ARE
C                 MATERIALS) OF THE k CONSISTENCY STATISTIC
C              4) A TABLE SUMMARIZING THE PRECISION STATISTICS
C                 FOR EACH MATERIAL.
C     PRINTING--YES
C     SUBROUTINES NEEDED--FCDF
C     WRITTEN BY--JAMES FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLGY
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      CHARACTER*4 IFORSW
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IPTEMP
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IFORMT
      CHARACTER*10 IFRMT2
      CHARACTER*10 IFRMT3
      CHARACTER*25 IFRMT4
      CHARACTER*40 IFRMT5
      CHARACTER*1  IEQUAL(200)
C
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
      CHARACTER*80 IFILE4
      CHARACTER*12 ISTAT4
      CHARACTER*12 IFORM4
      CHARACTER*12 IACCE4
      CHARACTER*12 IPROT4
      CHARACTER*12 ICURS4
      CHARACTER*4 IERRF4
      CHARACTER*4 IENDF4
      CHARACTER*4 IREWI4
C
      REAL KCV
C
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DXREP
      DOUBLE PRECISION XREPRD
C
C----------------------------------------------------------------
C
      REAL Y(*)
      REAL X1(*)
      REAL X2(*)
      REAL XIDTEM(*)
      REAL XIDTE2(*)
      REAL XBAR(*)
      REAL XBARI(*)
      REAL SDI(*)
      REAL SDXBRI(*)
      REAL DXBARI(*)
      REAL H(*)
      REAL AK(*)
      REAL SRPT(*)
      REAL SRPRD(*)
      REAL TEMP1(*)
      REAL TEMP2(*)
      REAL TAG(*)
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*25 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
      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='DPEI'
      ISUBN2='L2  '
C
      NUMDIG=4
      IF(IFORSW.EQ.'1')NUMDIG=2
      IF(IFORSW.EQ.'2')NUMDIG=2
      IF(IFORSW.EQ.'3')NUMDIG=3
      IF(IFORSW.EQ.'4')NUMDIG=4
      IF(IFORSW.EQ.'5')NUMDIG=5
      IF(IFORSW.EQ.'6')NUMDIG=6
      IF(IFORSW.EQ.'7')NUMDIG=7
      IF(IFORSW.EQ.'8')NUMDIG=7
      IF(IFORSW.EQ.'9')NUMDIG=7
      IF(IFORSW.EQ.'0')NUMDIG=7
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'EIN2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPEIN2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)N
   52   FORMAT('N = ',I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,N
          WRITE(ICOUT,56)I,Y(I),X1(I),X2(I)
   56     FORMAT('I,Y(I),X1(I),X2(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,101)
  101   FORMAT('***** ERROR IN E691 INTERLAB ANALYSIS--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,102)
  102   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
     1         'E691 INTERLAB ANALYSIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,103)N
  103   FORMAT('      MUST BE AT LEAST 2; THE ENTERED NUMBER OF ',
     1         'OBSERVATIONS = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               **************************************************
C               **  STEP 1.1--                                  **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
      ISTEPN='1.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EIN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='EIN2'
      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='EIN2'
      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
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='EIN2'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
      IOUNI4=IST4NU
      IFILE4=IST4NA
      ISTAT4=IST4ST
      IFORM4=IST4FO
      IACCE4=IST4AC
      IPROT4=IST4PR
      ICURS4=IST4CS
      ISUBN0='EIN2'
      IERRF4='NO'
C
      IREWI4='ON'
      CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               ***********************************************
C               **  STEP 2.1--                               **
C               **  PERFORM THE BASIC CALCULATIONS.  OBTAIN: **
C               **  1) REPEATABILITY STANDARD DEVIATION      **
C               **  2) REPRODUCABILITY STANDARD DEVIATION    **
C               **  3) H CONSISTENCY STATISTIC               **
C               **  4) K CONSISTENCY STATISTIC               **
C               ***********************************************
C
      ISTEPN='2.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EIN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL DISTIN(X1,N,IWRITE,XIDTEM,NUMSE1,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      CALL SORT(XIDTEM,NUMSE1,XIDTEM)
      CALL DISTIN(X2,N,IWRITE,XIDTE2,NUMSE2,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      CALL SORT(XIDTE2,NUMSE2,XIDTEM)
      NLAB=NUMSE1
      NMAT=NUMSE2
C
      IF(NLAB.LT.2 .OR. NLAB.GE.N)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,101)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,212)
  212   FORMAT('      FOR THE E691 INTERLAB COMMAND, THE SECOND ',
     1         'VARIABLE IS THE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,214)
  214   FORMAT('      LAB ID VARIABLE.  THE NUMBER OF LABS SHOULD ',
     1         'BE AT LEAST 2')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,216)
  216   FORMAT('      AND LESS THAN THE NUMBER OF POINTS.  SUCH WAS ',
     1         'NOT THE CASE HERE.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,218)NLAB
  218   FORMAT('      THE NUMBER OF UNIQUE LAB IDS = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,219)N
  219   FORMAT('      THE TOTAL NUMBER OF POINTS   = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NMAT.LT.2 .OR. NMAT.GE.N)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,101)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,222)
  222   FORMAT('      FOR THE E691 INTERLAB COMMAND, THE THIRD ',
     1         'VARIABLE IS THE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,224)
  224   FORMAT('      MATERIAL ID VARIABLE.  THE NUMBER OF LABS ',
     1         'SHOULD BE AT LEAST 2')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,226)
  226   FORMAT('      AND LESS THAN THE NUMBER OF POINTS.  SUCH WAS ',
     1         'NOT THE CASE HERE.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,228)NMAT
  228   FORMAT('      THE NUMBER OF UNIQUE MATERIAL IDS = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,229)N
  229   FORMAT('      THE TOTAL NUMBER OF POINTS        = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      ISTEPN='2.2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EIN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      NOUT=0
      DO1110ISET2=1,NUMSE2
C
C  STEP 1: COMPUTE OVERALL MEAN FOR CURRENT MATERIAL
C
        K=0
        DO1120I=1,N
          IF(XIDTE2(ISET2).EQ.X2(I))THEN
            K=K+1
            TEMP1(K)=Y(I)
          ENDIF
 1120   CONTINUE
        NTEMP=K
        CALL MEAN(TEMP1,NTEMP,IWRITE,XMEAN,IBUGA3,IERROR)
        XBAR(ISET2)=XMEAN
C
        DSUM=0.0D0
        DO1130ISET1=1,NUMSE1
C
          NOUT=(ISET2-1)*NUMSE1 + ISET1
          TAG(NOUT)=REAL(ISET2)
C
          K=0
          DO1140I=1,N
            IF(XIDTEM(ISET1).EQ.X1(I).AND.XIDTE2(ISET2).EQ.X2(I))THEN
              K=K+1
              TEMP1(K)=Y(I)
            ENDIF
 1140     CONTINUE
          NTEMP=K
C
          IF(ISET1.EQ.1 .AND. ISET2.EQ.1)THEN
            NHOLD=NTEMP
          ELSE
            IF(NTEMP.NE.NHOLD)THEN
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,101)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,1141)ISET1,ISET2
 1141         FORMAT('      FOR LAB ',I8,' AND MATERIAL ',I8)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,1143)NHOLD,NTEMP
 1143         FORMAT('      ',I8,' ELEMENTS EXPECTED BUT ',I8,
     1               ' ELEMENTS FOUND.')
              CALL DPWRST('XXX','BUG ')
              IERROR='YES'
              GOTO9000
            ENDIF
          ENDIF
C
          CALL MEAN(TEMP1,NTEMP,IWRITE,XMEAN,IBUGA3,IERROR)
          CALL SD(TEMP1,NTEMP,IWRITE,XSD,IBUGA3,IERROR)
          DSUM=DSUM + DBLE(XSD)**2
          XBARI(NOUT)=XMEAN
          SDI(NOUT)=XSD
          AK(NOUT)=SDI(NOUT)
          DXBARI(NOUT)=XBARI(NOUT) - XBAR(ISET2)
          H(NOUT)=XBARI(NOUT) - XBAR(ISET2)
          TEMP2(ISET1)=XBARI(NOUT)
C
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'ONS2')THEN
            WRITE(ICOUT,1146)ISET1,ISET2,XBAR(ISET2),XBARI(NOUT)
 1146       FORMAT('ISET1,ISET2,XBAR(ISET2),XBARI(NOUT) = ',
     1             2I8,2G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
 1130   CONTINUE
C
        CALL SD(TEMP2,NUMSE1,IWRITE,XSD,IBUGA3,IERROR)
        SDXBRI(ISET2)=XSD
        DXREP=DSQRT(DSUM/DBLE(NUMSE1))
        SRPT(ISET2)=REAL(DXREP)
C
        DXREP=DSUM/DBLE(NUMSE1)
        XREPRD=DSQRT(DBLE(XSD**2) + DXREP*DBLE(NHOLD-1)/DBLE(NHOLD))
        SRPRD(ISET2)=REAL(MAX(DSQRT(DXREP),XREPRD))
C
        DO1150I=(ISET2-1)*NUMSE1+1,ISET2*NUMSE1
          H(I)=H(I)/SDXBRI(ISET2)
          AK(I)=AK(I)/SRPT(ISET2)
 1150   CONTINUE
C
 1110 CONTINUE
      NOUT=NUMSE1*NUMSE2
C
      ANLAB=REAL(NLAB)
      IDF=NLAB-2
      ALP2=1.0  - (ALPHA/2.0)
      CALL TPPF(ALP2,IDF,TVAL)
      HCV=(ANLAB - 1.0)*TVAL/SQRT(ANLAB*(TVAL**2 + ANLAB - 2.0))
      HCV=REAL(INT(HCV*100.0 + 0.5))
      HCV=HCV/100.0
      IDF1=NHOLD-1
      IDF2=(NHOLD-1)*(NLAB-1)
      ALP2=1.0 - ALPHA
      CALL FPPF(ALP2,IDF1,IDF2,FVAL)
      KCV=SQRT(ANLAB/(1.0 + (ANLAB-1.0)/FVAL))
      KCV=REAL(INT(KCV*100.0 + 0.5))
      KCV=KCV/100.0
C
C               ***********************************************
C               **  STEP 3.1--                               **
C               **  WRITE COMPUTED INFORMATION TO FILE       **
C               ***********************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EIN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICNT=0
      DO3100ISET2=1,NUMSE2
        IMAT=INT(XIDTE2(ISET2)+0.5)
        DO3110ISET1=1,NUMSE1
          ILAB=INT(XIDTEM(ISET1)+0.5)
          ICNT=ICNT+1
          WRITE(IOUNI1,3119)IMAT,ILAB,XBARI(ICNT),SDI(ICNT),
     1                      DXBARI(ICNT),H(ICNT),AK(ICNT)
 3119     FORMAT(I8,1X,I8,3(1X,E15.7),2(1X,F10.2))
 3110   CONTINUE
 3100 CONTINUE
C
      ICNT=0
      IFORMT=' '
      IFORMT(1:15)='(I8,1X,  F10.2)'
      IF(NMAT.LE.9)THEN
        WRITE(IFORMT(9:9),'(I1)')NMAT
      ELSE
        WRITE(IFORMT(8:9),'(I2)')NMAT
      ENDIF
      DO3200ISET1=1,NUMSE1
        ILAB=INT(XIDTEM(ISET1)+0.5)
        WRITE(IOUNI2,IFORMT)ILAB,(H(II),II=ILAB,NMAT*NLAB,NUMSE1)
        WRITE(IOUNI3,IFORMT)ILAB,(AK(II),II=ILAB,NMAT*NLAB,NUMSE1)
 3200 CONTINUE
C
      AR=2.8
      DO3400ISET2=1,NUMSE2
        IMAT=INT(XIDTE2(ISET2)+0.5)
        AR1=2.8*SRPT(ISET2)
        AR2=2.8*SRPRD(ISET2)
        WRITE(IOUNI4,3419)IMAT,XBAR(ISET2),SDXBRI(ISET2),
     1                      SRPT(ISET2),SRPRD(ISET2),AR1,AR2
 3419   FORMAT(I8,4(1X,E15.7),2(1X,F7.2))
 3400 CONTINUE
C
      ISTEPN='3.2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EIN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IENDF3,IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IENDF4='OFF'
      IREWI4='ON'
      CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C
C               ***********************************************
C               **  STEP 2.1--                               **
C               **  PERFORM THE BASIC CALCULATIONS.  OBTAIN: **
C               **  1) REPEATABILITY STANDARD DEVIATION      **
C               **  2) REPRODUCABILITY STANDARD DEVIATION    **
C               **  3) H CONSISTENCY STATISTIC               **
C               **  4) K CONSISTENCY STATISTIC               **
C               ***********************************************
C
      ISTEPN='2.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EIN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  WRITE HEADER LINE
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        ITTEMP(1:NCTABT)=ITABTI(1:NCTABT)
        NCTEMP=NCTABT
        WRITE(ICOUT,5001)
 5001   FORMAT('<CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
 5002   FORMAT('<H2>INTERLABORATRY ANALYSIS (BASED ON E 691 - 99)',
     1         '</H2>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5003)
 5003   FORMAT('</CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5005)
 5005   FORMAT('<BR> <BR>')
        CALL DPWRST('XXX','WRIT')
C
C  TABLE 1
C
        ICNT=0
        IFRMT5=' '
        IFRMT5(1:34)='(2X,I4,4X,3(1X,F15.7),2(1X,F10.2))'
        WRITE(IFRMT5(20:20),'(I1)')NUMDIG
C
        DO5100ISET2=1,NUMSE2
          IMAT=INT(XIDTE2(ISET2)+0.5)
          IFLAG1=.FALSE.
          IFLAG2=.TRUE.
          NSTRT=NCTABT+1
          ITTEMP(NSTRT:NSTRT+31)='<BR>Initial Preparation of Test'
          ITTEMP(NSTRT+32:NSTRT+58)=' Result Data for Material: '
          WRITE(ITTEMP(NSTRT+59:NSTRT+60),'(I2)')IMAT
          NCTEMP=NSTRT+60
          CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
          DO5105ISET1=1,MIN(NUMSE1+1,MAXHED)
            IWIDTH(ISET1)=75
            VALIGN(ISET1)='BOTTOM'
            ALIGN(ISET1)='RIGHT'
            NUMDI2(ISET1)=-2
 5105     CONTINUE
          ALIGN(1)='CENTER'
          NUMDI2(1)=0
          NUMDI2(2)=NUMDIG
          NUMDI2(3)=NUMDIG
          NUMDI2(4)=NUMDIG
          NUMDI2(5)=2
          NUMDI2(6)=2
          IVALUE(1)='Laboratory<BR>Number'
          NCHAR(1)=20
          IVALUE(2)='Cell<BR>Mean'
          NCHAR(2)=12
          IVALUE(3)='Cell<BR>SD'
          NCHAR(3)=10
          IVALUE(4)='<i>d</i>'
          NCHAR(4)=8
          IVALUE(5)='<i>h</i>'
          NCHAR(5)=8
          IVALUE(6)='<i>k</i>'
          NCHAR(6)=8
          NHEAD=6
          IFLAG1=.TRUE.
          IFLAG2=.TRUE.
          CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
          NCHAR(1)=0
          IVALUE(1)=' '
          DO5110ISET1=1,NUMSE1
            ICNT=ICNT+1
            AVALUE(1)=XIDTEM(ISET1)
            AVALUE(2)=XBARI(ICNT)
            AVALUE(3)=SDI(ICNT)
            AVALUE(4)=DXBARI(ICNT)
            AVALUE(5)=H(ICNT)
            AVALUE(6)=AK(ICNT)
            CALL DPHTM5(IVALUE,NCHAR(1),AVALUE,NHEAD)
 5110     CONTINUE
C
          CALL DPHTM6(NHEAD)
          IFLAG1=.TRUE.
          IFLAG2=.FALSE.
          CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
          WRITE(ICOUT,5115)
 5115     FORMAT('<BR>')
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5147)
 5147     FORMAT('<UL>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5131)XBAR(ISET2)
 5131     FORMAT('Average of cell averages  = ',F12.5,'<BR>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5133)SDXBRI(ISET2)
 5133     FORMAT('Standard deviation of cell averages = ',F12.5,
     1           '<BR>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5135)SRPT(ISET2)
 5135     FORMAT('Repeatability standard deviation = ',F12.5,'<BR>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5137)SRPRD(ISET2)
 5137     FORMAT('Reproducability standard deviation = ',F12.5,
     1           '<BR>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
 5148     FORMAT('</UL>')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5005)
          CALL DPWRST('XXX','WRIT')
 5100   CONTINUE
C
C  TABLE 2
C
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        ITTEMP(NCTABT+1:NCTABT+2)='-h'
        NCTEMP=NCTABT+2
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
        NHEAD=NUMSE2+1
        CALL DPHTM6(NHEAD)
C
 5201   FORMAT('   <TR>')
 5203   FORMAT('      <TD>')
 5204   FORMAT('         &nbsp;')
 5205   FORMAT('      <TD ALIGN=CENTER COLSPAN=',I5,'>')
 5207   FORMAT('         Material')
 5208   FORMAT('      </TD>')
 5209   FORMAT('   </TR>')
        WRITE(ICOUT,5201)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5203)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5204)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5208)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5205)NUMSE2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5207)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5208)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5209)
        CALL DPWRST('XXX','WRIT')
C
        DO5215ISET1=1,MIN(NUMSE2+2,MAXHED)
          IWIDTH(ISET1)=75
          VALIGN(ISET1)='BOTTOM'
          ALIGN(ISET1)='RIGHT'
          NUMDI2(ISET1)=-2
 5215   CONTINUE
        ALIGN(1)='CENTER'
        NUMDI2(1)=0
        IVALUE(1)='Laboratory'
        NCHAR(1)=10
        DO5217II=2,NMAT+1
          NUMDI2(II)=2
          WRITE(IVALUE(II)(1:2),'(I2)')II-1
          NCHAR(II)=2
 5217   CONTINUE
        NHEAD=NMAT+1
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NCHAR(1)=0
        IVALUE(1)=' '
        ALIGN(2)='CENTER'
        NHEAD=NMAT+1
        NSTOP=NMAT*NLAB
        DO5220ISET1=1,NLAB
          ILAB=INT(XIDTEM(ISET1)+0.5)
          AVALUE(1)=XIDTEM(ISET1)
          ICNT=1
          DO5225II=ILAB,NSTOP,NLAB
            ICNT=ICNT+1
            AVALUE(ICNT)=H(II)
 5225     CONTINUE
          CALL DPHTM5(IVALUE(1),NCHAR(1),AVALUE,NHEAD)
 5220   CONTINUE
C
        CALL DPHTM6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
        WRITE(ICOUT,5235)
 5235   FORMAT('<BR>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)HCV
 5241   FORMAT('Critical Value  = ',F7.2,'<BR> <BR>')
        CALL DPWRST('XXX','WRIT')
C
C  TABLE 3
C
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        ITTEMP(NCTABT+1:NCTABT+2)='-k'
        NCTEMP=NCTABT+2
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
        NHEAD=NUMSE2+1
        CALL DPHTM6(NHEAD)
C
 5301   FORMAT('   <TR>')
 5303   FORMAT('      <TD>')
 5304   FORMAT('         &nbsp;')
 5305   FORMAT('      <TD ALIGN=CENTER COLSPAN=',I5,'>')
 5307   FORMAT('         Material')
 5308   FORMAT('      </TD>')
 5309   FORMAT('   </TR>')
        WRITE(ICOUT,5301)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5303)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5304)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5308)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5305)NUMSE2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5307)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5308)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5309)
        CALL DPWRST('XXX','WRIT')
C
        DO5315ISET1=1,MIN(NUMSE2+2,MAXHED)
          IWIDTH(ISET1)=75
          VALIGN(ISET1)='BOTTOM'
          ALIGN(ISET1)='RIGHT'
          NUMDI2(ISET1)=-2
 5315   CONTINUE
        ALIGN(1)='CENTER'
        NUMDI2(1)=0
        IVALUE(1)='Laboratory'
        NCHAR(1)=10
        DO5317II=2,NMAT+1
          NUMDI2(II)=2
          WRITE(IVALUE(II)(1:2),'(I2)')II-1
          NCHAR(II)=2
 5317   CONTINUE
        NHEAD=NMAT+1
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        ALIGN(2)='CENTER'
        NCHAR(1)=0
        NHEAD=NMAT+1
        NSTOP=NMAT*NLAB
        NINC=NLAB
        DO5320ISET1=1,NLAB
          ILAB=INT(XIDTEM(ISET1)+0.5)
          AVALUE(1)=XIDTEM(ISET1)
          ICNT=1
          DO5325II=ILAB,NSTOP,NINC
            ICNT=ICNT+1
            AVALUE(ICNT)=AK(II)
 5325     CONTINUE
          CALL DPHTM5(IVALUE(1),NCHAR(1),AVALUE,NHEAD)
 5320   CONTINUE
C
        CALL DPHTM6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
        WRITE(ICOUT,5335)
 5335   FORMAT('<BR>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5341)KCV
 5341   FORMAT('Critical Value  = ',F7.2,'<BR> <BR>')
        CALL DPWRST('XXX','WRIT')
C
C  TABLE 4
C
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        ITTEMP(NCTABT+1:NCTABT+21)='-Precision Statistics'
        NCTEMP=NCTABT+21
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
        NHEAD=NUMSE2+1
C
        DO5415ISET1=1,6
          IWIDTH(ISET1)=75
          VALIGN(ISET1)='BOTTOM'
          ALIGN(ISET1)='RIGHT'
          NUMDI2(ISET1)=NUMDIG
 5415   CONTINUE
        NUMDI2(1)=0
        NUMDI2(6)=2
        NUMDI2(7)=2
        IVALUE(1)='Material'
        NCHAR(1)=8
        IVALUE(2)='<i>Xbar</i>'
        NCHAR(2)=11
        IVALUE(3)='<i>s<sub>x<sub></i>'
        NCHAR(3)=19
        IVALUE(4)='<i>s<sub>r<sub></i>'
        NCHAR(4)=19
        IVALUE(5)='<i>s<sub>R<sub></i>'
        NCHAR(5)=19
        IVALUE(6)='<i>r</i>'
        NCHAR(6)=8
        IVALUE(7)='<i>R</i>'
        NCHAR(7)=8
        NHEAD=7
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        AR=2.8
        NCHAR(1)=0
        NHEAD=7
        DO5430ISET2=1,NUMSE2
          AVALUE(1)=XIDTE2(ISET2)
          AVALUE(2)=XBAR(ISET2)
          AVALUE(3)=SDXBRI(ISET2)
          AVALUE(4)=SRPT(ISET2)
          AVALUE(5)=SRPRD(ISET2)
          AR1=2.8*SRPT(ISET2)
          AR2=2.8*SRPRD(ISET2)
          AVALUE(6)=AR1
          AVALUE(7)=AR2
          CALL DPHTM5(IVALUE,NCHAR(1),AVALUE,NHEAD)
 5430   CONTINUE
C
        CALL DPHTM6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
        WRITE(ICOUT,5435)
 5435   FORMAT('<BR>')
        CALL DPWRST('XXX','WRIT')
C
C  RESET <PRE> MODE
C
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        NHEAD=0
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  WRITE HEADER LINE
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        CALL DPCONA(92,IBASLC)
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IHEAD(1:46)='INTERLABORATRY ANALYSIS (BASED ON E 691 - 99)'
        NHEAD=46
        CALL DPLAT8(IHEAD,NHEAD,IFLAG1,IFLAG2)
        NHEAD=0
C
C  TABLE 1
C
        ITTEMP(1:NCTABT)=ITABTI(1:NCTABT)
        NCTEMP=NCTABT
        ICNT=0
        IFRMT5=' '
        IFRMT5(1:34)='(2X,I4,4X,3(1X,F15.7),2(1X,F10.2))'
        WRITE(IFRMT5(20:20),'(I1)')NUMDIG
C
        DO6100ISET2=1,NUMSE2
C
          IMAT=INT(XIDTE2(ISET2)+0.5)
C
          IHEAD(1:27)='Initial Preparation of Test'
          IHEAD(28:54)=' Result Data for Material: '
          WRITE(IHEAD(55:56),'(I2)')IMAT
          NHEAD=56
          IFLAG1=.TRUE.
          IF(ISET2.EQ.1)IFLAG1=.FALSE.
          CALL DPLAT1(ITTEMP,NCTEMP,IHEAD,NHEAD,IFLAG1)
C
          DO6105ISET1=1,MIN(NUMSE1+1,MAXHED)
            IWIDTH(ISET1)=0
            VALIGN(ISET1)=' '
            ALIGN(ISET1)='r'
            NUMDI2(ISET1)=-2
 6105     CONTINUE
          ALIGN(1)='c'
          NUMDI2(1)=0
          NUMDI2(2)=NUMDIG
          NUMDI2(3)=NUMDIG
          NUMDI2(4)=NUMDIG
          NUMDI2(5)=2
          NUMDI2(6)=2
          IVALUE(1)='Laboratory Number'
          NCHAR(1)=17
          IVALUE(2)='Cell Mean'
          NCHAR(2)=9
          IVALUE(3)='Cell SD'
          NCHAR(3)=7
          IVALUE(4)='${d}$'
          NCHAR(4)=5
          IVALUE(5)='h'
          IVALUE(5)='${h}$'
          NCHAR(5)=5
          IVALUE(6)='${k}$'
          NCHAR(6)=5
          NHEAD=6
          IFLAG1=.TRUE.
          IFLAG2=.TRUE.
          CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
          NCHAR(1)=0
          IVALUE(1)=' '
          IFLAG1=.FALSE.
          DO6110ISET1=1,NUMSE1
            ICNT=ICNT+1
            AVALUE(1)=XIDTEM(ISET1)
            AVALUE(2)=XBARI(ICNT)
            AVALUE(3)=SDI(ICNT)
            AVALUE(4)=DXBARI(ICNT)
            AVALUE(5)=H(ICNT)
            AVALUE(6)=AK(ICNT)
            IF(ISET1.EQ.NUMSE1)IFLAG1=.TRUE.
            CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6110     CONTINUE
C
          IFLAG1=.TRUE.
          IFLAG2=.FALSE.
          IFLAG3=.FALSE.
          CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
          IHEAD(1:28)='Average of cell averages  = '
          NCHAR(1)=28
          CALL DPLAT7(IHEAD,NCHAR(1),XBAR(ISET2))
          IHEAD(1:39)='Standard Deviation of cell averages  = '
          NCHAR(1)=39
          CALL DPLAT7(IHEAD,NCHAR(1),SDXBRI(ISET2))
          IHEAD(1:36)='Repeatability Standard Deviation = '
          NCHAR(1)=36
          CALL DPLAT7(IHEAD,NCHAR(1),SRPT(ISET2))
          IHEAD(1:38)='Reproducability Standard Deviation = '
          NCHAR(1)=38
          CALL DPLAT7(IHEAD,NCHAR(1),SRPT(ISET2))
          IFLAG1=.FALSE.
          IFLAG2=.TRUE.
          IFLAG3=.FALSE.
          CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
 6100   CONTINUE
C
C  TABLE 2
C
        ITTEMP(NCTABT+1:NCTABT+2)='-h'
        NCTEMP=NCTABT+2
        NHEAD=0
        IFLAG1=.TRUE.
        CALL DPLAT1(IHEAD,NHEAD,ITTEMP,NCTEMP,IFLAG1)
        NHEAD=NUMSE2+1
        IFLAG1=.FALSE.
        IHEAD(1:8)='Material'
        NHEAD=8
        IFLAG2=.FALSE.
        CALL DPLAT8(IHEAD,NHEAD,IFLAG1,IFLAG2)
C
        DO6215ISET1=1,MIN(NUMSE2+1,MAXHED)
          IWIDTH(ISET1)=75
          VALIGN(ISET1)='BOTTOM'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=-2
 6215   CONTINUE
        ALIGN(1)='c'
        NUMDI2(1)=0
        IVALUE(1)='Laboratory'
        NCHAR(1)=10
        DO6217II=2,NMAT+1
          NUMDI2(II)=2
          WRITE(IVALUE(II)(1:2),'(I2)')II-1
          NCHAR(II)=2
 6217   CONTINUE
        NHEAD=NMAT+1
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NCHAR(1)=0
        IVALUE(1)=' '
        NHEAD=NMAT+1
        NSTOP=NMAT*NLAB
        IFLAG1=.FALSE.
        DO6220ISET1=1,NLAB
          ILAB=INT(XIDTEM(ISET1)+0.5)
          AVALUE(1)=XIDTEM(ISET1)
          ICNT=1
          DO6225II=ILAB,NSTOP,NLAB
            ICNT=ICNT+1
            AVALUE(ICNT)=H(II)
 6225     CONTINUE
          IF(ISET1.EQ.NLAB)IFLAG1=.TRUE.
          CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6220   CONTINUE
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        IHEAD(1:18)='Critical Value  = '
        NCHAR(1)=18
        CALL DPLAT7(IHEAD,NCHAR(1),HCV)
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
C  TABLE 3
C
        ITTEMP(NCTABT+1:NCTABT+2)='-k'
        NCTEMP=NCTABT+2
        NHEAD=0
        IFLAG1=.TRUE.
        CALL DPLAT1(IHEAD,NHEAD,ITTEMP,NCTEMP,IFLAG1)
        NHEAD=NUMSE2+1
        IFLAG1=.FALSE.
        IHEAD(1:8)='Material'
        NHEAD=8
        IFLAG2=.FALSE.
        CALL DPLAT8(IHEAD,NHEAD,IFLAG1,IFLAG2)
C
        DO6315ISET1=1,MIN(NUMSE2+1,MAXHED)
          IWIDTH(ISET1)=75
          VALIGN(ISET1)='BOTTOM'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=-2
 6315   CONTINUE
        ALIGN(1)='c'
        NUMDI2(1)=0
        IVALUE(1)='Laboratory'
        NCHAR(1)=10
        DO6317II=2,NMAT+1
          NUMDI2(II)=2
          WRITE(IVALUE(II)(1:2),'(I2)')II-1
          NCHAR(II)=2
 6317   CONTINUE
        NHEAD=NMAT+1
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NCHAR(1)=0
        IVALUE(1)=' '
        NHEAD=NMAT+1
        NSTOP=NMAT*NLAB
        IFLAG1=.FALSE.
        DO6320ISET1=1,NLAB
          ILAB=INT(XIDTEM(ISET1)+0.5)
          AVALUE(1)=XIDTEM(ISET1)
          ICNT=1
          DO6325II=ILAB,NSTOP,NLAB
            ICNT=ICNT+1
            AVALUE(ICNT)=AK(II)
 6325     CONTINUE
          IF(ISET1.EQ.NLAB)IFLAG1=.TRUE.
          CALL DPLAT5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6320   CONTINUE
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        IHEAD(1:18)='Critical Value  = '
        NCHAR(1)=18
        CALL DPLAT7(IHEAD,NCHAR(1),KCV)
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
C  TABLE 4
C
        ITTEMP(NCTABT+1:NCTABT+21)='-Precision Statistics'
        NCTEMP=NCTABT+21
        NHEAD=0
        IFLAG1=.TRUE.
        CALL DPLAT1(IHEAD,NHEAD,ITTEMP,NCTEMP,IFLAG1)
        NHEAD=NUMSE2+1
C
        DO6415ISET1=1,6
          IWIDTH(ISET1)=75
          VALIGN(ISET1)='BOTTOM'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=NUMDIG
 6415   CONTINUE
        NUMDI2(1)=0
        NUMDI2(6)=2
        NUMDI2(7)=2
        IVALUE(1)='Material'
        NCHAR(1)=8
        IVALUE(2)='$ bar{X}$'
        IVALUE(2)(2:2)=IBASLC
        NCHAR(2)=9
        IVALUE(3)='$s_{x}$'
        NCHAR(3)=7
        IVALUE(4)='$s_{r}$'
        NCHAR(4)=7
        IVALUE(5)='$s_{R}$'
        NCHAR(5)=7
        IVALUE(6)='r'
        NCHAR(6)=1
        IVALUE(7)='R'
        NCHAR(7)=1
        NHEAD=7
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        AR=2.8
        NCHAR(1)=0
        NHEAD=7
        IFLAG1=.FALSE.
        DO6430ISET2=1,NUMSE2
          AVALUE(1)=XIDTE2(ISET2)
          AVALUE(2)=XBAR(ISET2)
          AVALUE(3)=SDXBRI(ISET2)
          AVALUE(4)=SRPT(ISET2)
          AVALUE(5)=SRPRD(ISET2)
          AR1=2.8*SRPT(ISET2)
          AR2=2.8*SRPRD(ISET2)
          AVALUE(6)=AR1
          AVALUE(7)=AR2
          IF(ISET2.EQ.NUMSE2)IFLAG1=.TRUE.
          CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6430   CONTINUE
C
C  END TABLE AND RESET "ASIS" MODE
C
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
 6591   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFF.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFF.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFF.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFF.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFF.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFF.EQ.'Verdana')THEN
          ITEMP=7
        ENDIF 
C
C  WRITE HEADER LINE
C
        IRTFMD='OFF'
        CALL DPCONA(92,IBASLC)
        IFLAG1=.TRUE.
        IHEAD(1:46)='INTERLABORATRY ANALYSIS (BASED ON E 691 - 99)'
        NHEAD=46
        CALL DPRTF8(IHEAD,NHEAD,ITEMP,IFLAG1)
        NHEAD=0
C
C  TABLE 1
C
        ITTEMP(1:NCTABT)=ITABTI(1:NCTABT)
        NCTEMP=NCTABT
        ICNT=0
        IFRMT5=' '
        IFRMT5(1:34)='(2X,I4,4X,3(1X,F15.7),2(1X,F10.2))'
        WRITE(IFRMT5(20:20),'(I1)')NUMDIG
C
        IDEFPS=20
        IFRST=IRTFPS*1400/IDEFPS
        IINC1=IRTFPS*1440/IDEFPS
        IINC2=IRTFPS*800/IDEFPS
        DO6605ISET1=1,6
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=-2
 6605   CONTINUE
        IWIDTH(1)=IFRST
        ALIGN(1)='c'
        DO6608I=2,4
          IWIDTH(I)=IWIDTH(I-1) + IINC1
 6608   CONTINUE
        IWIDTH(5)=IWIDTH(4) + IINC2
        IWIDTH(6)=IWIDTH(5) + IINC2
        NUMDI2(1)=0
        NUMDI2(2)=NUMDIG
        NUMDI2(3)=NUMDIG
        NUMDI2(4)=NUMDIG
        NUMDI2(5)=2
        NUMDI2(6)=2
        IVALUE(2)=' b Cell line Mean'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(8:8)=IBASLC
        NCHAR(2)=17
        IVALUE(3)=' b Cell line SD'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(8:8)=IBASLC
        NCHAR(3)=15
        IVALUE(4)=' b i d'
        IVALUE(4)(1:1)=IBASLC
        IVALUE(4)(3:3)=IBASLC
        NCHAR(4)=6
        IVALUE(5)=' b i h'
        IVALUE(5)(1:1)=IBASLC
        IVALUE(5)(3:3)=IBASLC
        NCHAR(5)=6
        IVALUE(6)=' b i k'
        IVALUE(6)(1:1)=IBASLC
        IVALUE(6)(3:3)=IBASLC
        NCHAR(6)=6
        NHEAD=6
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
C
        DO6600ISET2=1,NUMSE2
C
          IMAT=INT(XIDTE2(ISET2)+0.5)
          IFLAG1=.TRUE.
          IFLAG2=.TRUE.
C
          IHEAD(1:27)='Initial Preparation of Test'
          IHEAD(28:54)=' Result Data for Material: '
          WRITE(IHEAD(55:56),'(I2)')IMAT
          NHEAD=56
          CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
          IVALUE(1)=' b Laboratory line Number'
          IVALUE(1)(1:1)=IBASLC
          IVALUE(1)(14:14)=IBASLC
          NCHAR(1)=25
          NHEAD=6
          CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
          DO6615II=2,6
            ALIGN(II)='r'
 6615     CONTINUE
          NCHAR(1)=0
          IVALUE(1)=' '
          IFLAG1=.FALSE.
          DO6610ISET1=1,NUMSE1
            ICNT=ICNT+1
            AVALUE(1)=XIDTEM(ISET1)
            AVALUE(2)=XBARI(ICNT)
            AVALUE(3)=SDI(ICNT)
            AVALUE(4)=DXBARI(ICNT)
            AVALUE(5)=H(ICNT)
            AVALUE(6)=AK(ICNT)
            IF(ISET1.EQ.NUMSE1)IFLAG1=.TRUE.
            CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6610     CONTINUE
C
          CALL DPRTF6(NHEAD)
          IFLAG1=.TRUE.
          IFLAG2=.FALSE.
CCCCC     CALL DPRTF2(IFLAG1,IFLAG2,NHEAD)
C
          IF(IRTFFF.EQ.'Courier New')THEN
            ITEMP=1
          ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
            ITEMP=8
          ENDIF 
          WRITE(ICOUT,6591)IBASLC,ITEMP
          CALL DPWRST(ICOUT,'WRIT')
          IHEAD(1:39)='Average of cell averages             = '
          NCHAR(1)=39
          CALL DPRTF7(IHEAD,NCHAR(1),XBAR(ISET2))
          IHEAD(1:39)='Standard Deviation of cell averages  = '
          NCHAR(1)=39
          CALL DPRTF7(IHEAD,NCHAR(1),SDXBRI(ISET2))
          IHEAD(1:39)='Repeatability Standard Deviation     = '
          NCHAR(1)=39
          CALL DPRTF7(IHEAD,NCHAR(1),SRPT(ISET2))
          IHEAD(1:39)='Reproducability Standard Deviation   = '
          NCHAR(1)=39
          CALL DPRTF7(IHEAD,NCHAR(1),SRPT(ISET2))
C
          CALL DPRTF6(NHEAD)
          CALL DPRTF6(NHEAD)
          IF(IRTFFF.EQ.'Times New Roman')THEN
            ITEMP=0
          ELSEIF(IRTFFF.EQ.'Lucida Sans')THEN
            ITEMP=6
          ELSEIF(IRTFFF.EQ.'Arial')THEN
            ITEMP=2
          ELSEIF(IRTFFF.EQ.'Bookman')THEN
            ITEMP=3
          ELSEIF(IRTFFF.EQ.'Georgia')THEN
            ITEMP=4
          ELSEIF(IRTFFF.EQ.'Tahoma')THEN
            ITEMP=5
          ELSEIF(IRTFFF.EQ.'Verdana')THEN
            ITEMP=7
          ENDIF 
          WRITE(ICOUT,6591)IBASLC,ITEMP
          CALL DPWRST(ICOUT,'WRIT')
C
 6600   CONTINUE
C
C  TABLE 2
C
C  TABLES 2 AND 3 HAVE A VARIABLE NUMBER OF COLUMNS.  BASED ON:
C  1) NMAT + 2 COLUMNS (2 COLUMNS FOR LABORATORY LABEL)
C  2) THERE 1,440 TWIPS PER INCH
C  3) FOR DEFAULT POINT SIZE (10), A WIDTH OF 800 TWIPS PER COLUMN
C     SEEMS TO WORK WELL
C  DETERMINE A MAXIMUM POINT SIZE.
C
        AINC=6.5*1440.0/REAL(NMAT+2)
        AMXPS=AINC/80.0
        IMXPS=INT(AMXPS+0.99)
        IF(IRTFPS.GT.IMXPS)THEN
          IPTSZ=IMXPS
          IF(2*IMXPS.LE.9)THEN
            WRITE(ICOUT,6702)IBASLC,2*IMXPS
 6702       FORMAT(A1,'fs',I1)
            CALL DPWRST(ICOUT,'WRIT')
          ELSEIF(2*IMXPS.LE.9)THEN
            WRITE(ICOUT,6703)IBASLC,2*IMXPS
 6703       FORMAT(A1,'fs',I2)
            CALL DPWRST(ICOUT,'WRIT')
          ENDIF
        ELSE
          IPTSZ=IRTFPS
        ENDIF
C
        IINC1=80*IPTSZ
C
        ITTEMP(NCTABT+1:NCTABT+2)='-h'
        NCTEMP=NCTABT+2
        NHEAD=0
        CALL DPRTF1(IHEAD,NHEAD,ITTEMP,NCTEMP)
C
        IWIDTH(1)=2*IINC1
        IWIDTH(2)=IWIDTH(1) + NUMSE2*IINC1
        ALIGN(1)='c'
        ALIGN(2)='c'
        VALIGN(1)='b'
        VALIGN(2)='b'
        NHEAD=2
        IFLAG1=.TRUE.
        IFLAG1=.TRUE.
        IVALUE(1)=' '
        NCHAR(1)=1
        IVALUE(2)(1:8)='Material'
        NCHAR(2)=8
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NUMDI2(1)=0
        IWIDTH(1)=2*IINC1
        DO6705ISET1=2,MIN(NUMSE2+1,MAXHED)
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=2
          IWIDTH(ISET1)=IWIDTH(ISET1-1) + IINC1
 6705   CONTINUE
        ALIGN(1)='c'
C
        IVALUE(1)='Laboratory'
        NCHAR(1)=10
        DO6717II=2,MIN(NUMSE2+1,MAXHED)
          WRITE(IVALUE(II)(1:2),'(I2)')II-1
          NCHAR(II)=2
 6717   CONTINUE
        NHEAD=MIN(NUMSE2+1,MAXHED)
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NCHAR(1)=0
        IVALUE(1)=' '
        NHEAD=NMAT+1
        NSTOP=NMAT*NLAB
        IFLAG1=.FALSE.
        DO6720ISET1=1,NLAB
          ILAB=INT(XIDTEM(ISET1)+0.5)
          AVALUE(1)=XIDTEM(ISET1)
          ICNT=1
          DO6725II=ILAB,NSTOP,NLAB
            ICNT=ICNT+1
            AVALUE(ICNT)=H(II)
 6725     CONTINUE
          IF(ISET1.EQ.NLAB)IFLAG1=.TRUE.
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6720   CONTINUE
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
CCCCC   CALL DPRTF2(IFLAG1,IFLAG2,NHEAD)
C
        IHEAD(1:18)='Critical Value  = '
        NCHAR(1)=18
        CALL DPRTF7(IHEAD,NCHAR(1),HCV)
        CALL DPRTF6(NHEAD)
        CALL DPRTF6(NHEAD)
C
C  TABLE 3
C
        ITTEMP(NCTABT+1:NCTABT+2)='-k'
        NCTEMP=NCTABT+2
        NHEAD=0
        CALL DPRTF1(IHEAD,NHEAD,ITTEMP,NCTEMP)
C
        IWIDTH(1)=2*IINC1
        IWIDTH(2)=IWIDTH(1) + NUMSE2*IINC1
        ALIGN(1)='c'
        ALIGN(2)='c'
        VALIGN(1)='b'
        VALIGN(2)='b'
        NHEAD=2
        IFLAG1=.TRUE.
        IFLAG1=.TRUE.
        IVALUE(1)=' '
        NCHAR(1)=1
        IVALUE(2)(1:8)='Material'
        NCHAR(2)=8
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NUMDI2(1)=0
        IWIDTH(1)=2*IINC1
        DO6805ISET1=2,MIN(NUMSE2+1,MAXHED)
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=2
          IWIDTH(ISET1)=IWIDTH(ISET1-1) + IINC1
 6805   CONTINUE
        ALIGN(1)='c'
C
        IVALUE(1)='Laboratory'
        NCHAR(1)=10
        DO6817II=2,MIN(NUMSE2+1,MAXHED)
          WRITE(IVALUE(II)(1:2),'(I2)')II-1
          NCHAR(II)=2
 6817   CONTINUE
        NHEAD=MIN(NUMSE2+1,MAXHED)
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NCHAR(1)=0
        IVALUE(1)=' '
        NHEAD=NMAT+1
        NSTOP=NMAT*NLAB
        IFLAG1=.FALSE.
        DO6820ISET1=1,NLAB
          ILAB=INT(XIDTEM(ISET1)+0.5)
          AVALUE(1)=XIDTEM(ISET1)
          ICNT=1
          DO6825II=ILAB,NSTOP,NLAB
            ICNT=ICNT+1
            AVALUE(ICNT)=AK(II)
 6825     CONTINUE
          IF(ISET1.EQ.NLAB)IFLAG1=.TRUE.
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6820   CONTINUE
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
CCCCC   CALL DPRTF2(IFLAG1,IFLAG2,NHEAD)
C
        IHEAD(1:18)='Critical Value  = '
        NCHAR(1)=18
        CALL DPRTF7(IHEAD,NCHAR(1),KCV)
        CALL DPRTF6(NHEAD)
        CALL DPRTF6(NHEAD)
        IF(IRTFPS.GT.IMXPS)THEN
          IF(2*IRTFPS.LE.9)THEN
            WRITE(ICOUT,6702)IBASLC,2*IRTFPS
            CALL DPWRST(ICOUT,'WRIT')
          ELSEIF(2*IRTFPS.LE.9)THEN
            WRITE(ICOUT,6703)IBASLC,2*IRTFPS
            CALL DPWRST(ICOUT,'WRIT')
          ENDIF
        ENDIF
C
C  TABLE 4
C
        ITTEMP(NCTABT+1:NCTABT+21)='-Precision Statistics'
        NCTEMP=NCTABT+21
        NHEAD=0
        IFLAG1=.TRUE.
        CALL DPRTF1(IHEAD,NHEAD,ITTEMP,NCTEMP)
        NHEAD=NUMSE2+1
C
        IDEFPS=20
        IFRST=IRTFPS*1400/IDEFPS
        IINC1=IRTFPS*1400/IDEFPS
        IINC2=IRTFPS*800/IDEFPS
        DO6915ISET1=1,7
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=NUMDIG
 6915   CONTINUE
        ALIGN(1)='c'
        IWIDTH(1)=IFRST
        DO6918I=2,5
          IWIDTH(I)=IWIDTH(I-1) + IINC1
 6918   CONTINUE
        IWIDTH(6)=IWIDTH(5) + IINC2
        IWIDTH(7)=IWIDTH(6) + IINC2
        NUMDI2(1)=0
        NUMDI2(6)=2
        NUMDI2(7)=2
        IVALUE(1)=' b Material'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=11
        IVALUE(2)=' b Xbar'
        IVALUE(2)(1:1)=IBASLC
        NCHAR(2)=7
        IVALUE(3)=' b i s{ sub x}'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(3:3)=IBASLC
        IVALUE(3)(8:8)=IBASLC
        NCHAR(3)=14
        IVALUE(4)=' b i s{ sub r}'
        IVALUE(4)(1:1)=IBASLC
        IVALUE(4)(3:3)=IBASLC
        IVALUE(4)(8:8)=IBASLC
        NCHAR(4)=14
        IVALUE(5)=' b i s{ sub R}'
        IVALUE(5)(1:1)=IBASLC
        IVALUE(5)(3:3)=IBASLC
        IVALUE(5)(8:8)=IBASLC
        NCHAR(5)=14
        IVALUE(6)=' b i r'
        IVALUE(6)(1:1)=IBASLC
        IVALUE(6)(3:3)=IBASLC
        NCHAR(6)=6
        IVALUE(7)=' b i R'
        IVALUE(7)(1:1)=IBASLC
        IVALUE(7)(3:3)=IBASLC
        NCHAR(7)=6
        NHEAD=7
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        AR=2.8
        NCHAR(1)=0
        NHEAD=7
        IFLAG1=.FALSE.
        DO6930ISET2=1,NUMSE2
          AVALUE(1)=XIDTE2(ISET2)
          AVALUE(2)=XBAR(ISET2)
          AVALUE(3)=SDXBRI(ISET2)
          AVALUE(4)=SRPT(ISET2)
          AVALUE(5)=SRPRD(ISET2)
          AR1=2.8*SRPT(ISET2)
          AR2=2.8*SRPRD(ISET2)
          AVALUE(6)=AR1
          AVALUE(7)=AR2
          IF(ISET2.EQ.NUMSE2)IFLAG1=.TRUE.
          CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6930   CONTINUE
C
        CALL DPRTF6(NHEAD)
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFF.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFF.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFF.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFF.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFF.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFF.EQ.'Verdana')THEN
          ITEMP=7
        ENDIF 
        WRITE(ICOUT,6591)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IRTFMD='VERB'
C
      ELSE
        ISTEPN='7.1'
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EIN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  HEADER
C
        IFRMT2='(A  )'
        WRITE(IFRMT2(3:4),'(I2)')NCTABT
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7001)
 7001   FORMAT(15X,'INTERLABORATORY ANALYSIS (BASED ON E 691 - 99 ',
     1         'STANDARD)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  TABLE 1
C
        ICNT=0
        IFRMT5=' '
        IFRMT5(1:34)='(2X,I4,4X,3(1X,F15.7),2(1X,F10.2))'
        WRITE(IFRMT5(20:20),'(I1)')NUMDIG
C
        DO7100ISET2=1,NUMSE2
          IMAT=INT(XIDTE2(ISET2)+0.5)
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFRMT2)ITABTI(1:NCTABT)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7013)IMAT
 7013     FORMAT('Initial Preparation of Test Result Data for ',
     1           'Material: ',I8)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7015)
 7015     FORMAT('=================================================',
     1           '===============================')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7017)
 7017     FORMAT('Laboratory            Cell            Cell',
     1           '                ',
     1           '                               ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7018)
 7018     FORMAT('  Number              Mean              SD',
     1           '               d',
     1           '          h          k')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7015)
          CALL DPWRST('XXX','WRIT')
          DO7110ISET1=1,NUMSE1
            ILAB=INT(XIDTEM(ISET1)+0.5)
            ICNT=ICNT+1
            WRITE(ICOUT,IFRMT5)ILAB,XBARI(ICNT),SDI(ICNT),
     1                      DXBARI(ICNT),H(ICNT),AK(ICNT)
            CALL DPWRST('XXX','WRIT')
 7110     CONTINUE
C
          WRITE(ICOUT,7015)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7131)XBAR(ISET2)
 7131     FORMAT(2X,'Average of cell averages             = ',F12.5)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7133)SDXBRI(ISET2)
 7133     FORMAT(2X,'Standard deviation of cell averages = ',F12.5)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7135)SRPT(ISET2)
 7135     FORMAT(2X,'Repeatability standard deviation    = ',F12.5)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7137)SRPRD(ISET2)
 7137     FORMAT(2X,'Reproducability standard deviation  = ',F12.5)
          CALL DPWRST('XXX','WRIT')
 7100   CONTINUE
C
C  TABLE 2
C
C  NOTE: DETERMINE HOW MANY MATERIALS CAN REASONABLY BE PRINTED FOR
C        THE TABLE (I.E., DOES THE TABLE NEED TO BE PRINTED IN
C        MORE THAN 1 ITERATION).
C
        NITEMS=(ILPRCO - 11)/10
        NIT=(NMAT/NITEMS) + 1
        IF(MOD(NMAT,NITEMS).EQ.0)NIT=NIT-1
C
        DO7200ITER=1,MAX(NIT,1)
C
          IFRST=(ITER-1)*NITEMS + 1
          ILAST=MIN(ITER*NITEMS,NMAT)
          NTEMP=ILAST-IFRST+1
C
          IFRMT2='(A  ,A2)'
          WRITE(IFRMT2(3:4),'(I2)')NCTABT
          NEQ=11 + NTEMP*10
          IFRMT3=' '
          IFRMT3(1:7)='(   A1)'
          WRITE(IFRMT3(2:4),'(I3)')NEQ
          DO7201I=1,MIN(NEQ,200)
            IEQUAL(I)='='
 7201     CONTINUE
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFRMT2)ITABTI(1:NCTABT),'-h'
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFRMT3)(IEQUAL(JJ),JJ=1,NEQ)
          CALL DPWRST('XXX','WRIT')
          IFRMT4=' '
          IFRMT4='(   X,A8)'
          NSPAC=6 + (NTEMP*10/2)
          WRITE(IFRMT4(2:4),'(I3)')NSPAC
          WRITE(ICOUT,IFRMT4)'Material'
          CALL DPWRST('XXX','WRIT')
          IFRMT4=' '
          IFRMT4='(A10,2X,   (2X,I5,3X))'
          WRITE(IFRMT4(9:11),'(I3)')NTEMP
          WRITE(ICOUT,IFRMT4)'Laboratory',
     1                       (INT(XIDTE2(JJ)+0.5),JJ=IFRST,ILAST)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFRMT3)(IEQUAL(JJ),JJ=1,NEQ)
          CALL DPWRST('XXX','WRIT')
          ICNT=0
          IFORMT=' '
          IFORMT(1:15)='(I6,5X,  F10.2)'
          IF(NTEMP.LE.9)THEN
            WRITE(IFORMT(9:9),'(I1)')NTEMP
          ELSE
            WRITE(IFORMT(8:9),'(I2)')NTEMP
          ENDIF
C
          DO7290ISET1=1,NUMSE1
            ILAB=INT(XIDTEM(ISET1)+0.5)
            NSTRT=ILAB + (IFRST-1)*NUMSE1
            NSTOP=ILAST*NLAB
            WRITE(ICOUT,IFORMT)ILAB,(H(II),II=NSTRT,NSTOP,NUMSE1)
            CALL DPWRST('XXX','WRIT')
 7290     CONTINUE
          WRITE(ICOUT,IFRMT3)(IEQUAL(JJ),JJ=1,NEQ)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7229)HCV
 7229     FORMAT(2X,'CRITICAL VALUE = ',F7.2)
          CALL DPWRST('XXX','WRIT')
 7200   CONTINUE
C
C  TABLE 3
C
C  NOTE: DETERMINE HOW MANY MATERIALS CAN REASONABLY BE PRINTED FOR
C        THE TABLE (I.E., DOES THE TABLE NEED TO BE PRINTED IN
C        MORE THAN 1 ITERATION).
C
        NITEMS=(ILPRCO - 11)/10
        NIT=(NMAT/NITEMS) + 1
        IF(MOD(NMAT,NITEMS).EQ.0)NIT=NIT-1
C
        DO7300ITER=1,MAX(NIT,1)
C
          IFRST=(ITER-1)*NITEMS + 1
          ILAST=MIN(ITER*NITEMS,NMAT)
          NTEMP=ILAST-IFRST+1
C
          NEQ=11 + NTEMP*10
          IFRMT3=' '
          IFRMT3(1:7)='(   A1)'
          WRITE(IFRMT3(2:4),'(I3)')NEQ
          DO7301I=1,MIN(NEQ,200)
            IEQUAL(I)='='
 7301     CONTINUE
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFRMT2)ITABTI(1:NCTABT),'-k'
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFRMT3)(IEQUAL(JJ),JJ=1,NEQ)
C
          IFRMT4=' '
          IFRMT4='(   X,A8)'
          NSPAC=6 + (NTEMP*10/2)
          WRITE(IFRMT4(2:4),'(I3)')NSPAC
          WRITE(ICOUT,IFRMT4)'Material'
          CALL DPWRST('XXX','WRIT')
          IFRMT4=' '
          IFRMT4='(A10,2X,   (2X,I5,3X))'
          WRITE(IFRMT4(9:11),'(I3)')NTEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFRMT4)'Laboratory',
     1                       (INT(XIDTE2(JJ)+0.5),JJ=IFRST,ILAST)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,IFRMT3)(IEQUAL(JJ),JJ=1,NEQ)
          CALL DPWRST('XXX','WRIT')
          ICNT=0
          IFORMT=' '
          IFORMT(1:15)='(I6,5X,  F10.2)'
          IF(NTEMP.LE.9)THEN
            WRITE(IFORMT(9:9),'(I1)')NTEMP
          ELSE
            WRITE(IFORMT(8:9),'(I2)')NTEMP
          ENDIF
C
          DO7390ISET1=1,NUMSE1
            ILAB=INT(XIDTEM(ISET1)+0.5)
            NSTRT=ILAB + (IFRST-1)*NUMSE1
            NSTOP=ILAST*NLAB
            WRITE(ICOUT,IFORMT)ILAB,(AK(II),II=NSTRT,NSTOP,NUMSE1)
            CALL DPWRST('XXX','WRIT')
 7390     CONTINUE
          WRITE(ICOUT,IFRMT3)(IEQUAL(JJ),JJ=1,NEQ)
          CALL DPWRST('XXX','WRIT')
 7300   CONTINUE
        WRITE(ICOUT,7329)KCV
 7329   FORMAT(2X,'CRITICAL VALUE = ',F7.2)
        CALL DPWRST('XXX','WRIT')
C
C  TABLE 4
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IFRMT2='(A  ,A21)'
        WRITE(IFRMT2(3:4),'(I2)')NCTABT
        NEQ=88
        IFRMT3=' '
        IFRMT3(1:7)='(   A1)'
        WRITE(IFRMT3(2:4),'(I3)')NEQ
        DO7401I=1,MIN(NEQ,500)
          IEQUAL(I)='='
 7401   CONTINUE
C
        IFRMT5=' '
        IFRMT5(1:30)='(I5,3X,4(1X,F15.7),2(1X,F7.2))'
        WRITE(IFRMT5(17:17),'(I1)')NUMDIG
C
        WRITE(ICOUT,IFRMT2)ITABTI(1:NCTABT),'-Precision Statistics'
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,IFRMT3)(IEQUAL(JJ),JJ=1,NEQ)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7417)
 7417   FORMAT('Material            Xbar            s(x)',
     1         '            s(r) ',
     1         '           s(R)       r       R')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,IFRMT3)(IEQUAL(JJ),JJ=1,NEQ)
        CALL DPWRST('XXX','WRIT')
C
        AR=2.8
        DO7400ISET2=1,NUMSE2
          IMAT=INT(XIDTE2(ISET2)+0.5)
          AR1=2.8*SRPT(ISET2)
          AR2=2.8*SRPRD(ISET2)
          WRITE(ICOUT,IFRMT5)IMAT,XBAR(ISET2),SDXBRI(ISET2),
     1                       SRPT(ISET2),SRPRD(ISET2),AR1,AR2
          CALL DPWRST('XXX','WRIT')
 7400   CONTINUE
        WRITE(ICOUT,IFRMT3)(IEQUAL(JJ),JJ=1,NEQ)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      IF(IFEEDB.EQ.'OFF')GOTO8099
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')GOTO8099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8005)
 8005 FORMAT('THE FOLLOWING VARIABLES WERE WRITTEN TO THE FILE ',
     1       'dpst1f.dat:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('   1. MATERIAL ID')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8013)
 8013 FORMAT('   2. LAB ID')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8021)
 8021 FORMAT('   3. CELL AVERAGE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8023)
 8023 FORMAT('   4. CELL STANDARD DEVIATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8025)
 8025 FORMAT('   5. CELL AVERAGE - OVERALL AVERAGE FOR MATERIAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8027)
 8027 FORMAT('   6. H-CONSISTENCY STATISTIC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8029)
 8029 FORMAT('   7. VARIANCE OF MEAN OF LAB')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8041)
 8041 FORMAT('THE H-CONSISTECNY STATISTICS WERE WRITTEN TO THE FILE ',
     1       'dpst2f.dat:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8043)
 8043 FORMAT('   THE ROWS REPRESENT THE LAB AND THE COLUMNS REPRESENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8045)
 8045 FORMAT('   THE MATERIALS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8051)
 8051 FORMAT('THE K-CONSISTECNY STATISTICS WERE WRITTEN TO THE FILE ',
     1       'dpst3f.dat:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8053)
 8053 FORMAT('   THE ROWS REPRESENT THE LAB AND THE COLUMNS REPRESENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8055)
 8055 FORMAT('   THE MATERIALS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,8071)
 8071 FORMAT('THE FOLLOWING VARIABLES WERE WRITTEN TO THE FILE ',
     1       'dpst4f.dat:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8073)
 8073 FORMAT('   1. MATERIAL ID')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8075)
 8075 FORMAT('   2. MEAN OF THE CELL AVERAGES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8077)
 8077 FORMAT('   3. STANDARD DEVIATION OF THE CELL AVERAGES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8079)
 8079 FORMAT('   4. REPEATABILITY STANDARD DEVIATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8081)
 8081 FORMAT('   5. REPRODUCABILITY STANDARD DEVIATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8083)
 8083 FORMAT('   6. 95% REPEATABILITY STANDARD DEVIATION LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8085)
 8085 FORMAT('   7. 95% REPRODUCABILITY STANDARD DEVIATION LIMIT')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8091)
 8091 FORMAT('   H- AND K-CONSISTENCY STATISTIC CRITICAL VALUES ',
     1       'SAVED AS INTERNAL PARAMETERS HCV AND KCV.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
 8099 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'EIN2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPEIN2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR,IBUGA3
 9012   FORMAT('IERROR,IBUGA3 = ',A4,1X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)N
 9013   FORMAT('N = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPELL2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A ELLIPSE
C              WITH ONE END OF THE MAJOR AXIS AT (X1,Y1)
C              WITH ONE END OF THE MINOR AXIS AT (X2,Y2)
C              AND THE OTHER END OF MAJOR AXIS AT (X3,Y3).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --FEBRUARY  1994.  ARRAY TO GARBAGE COMMON
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IPATT2
      CHARACTER*4 IFIG
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ELL2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPELL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)X3,Y3
   55 FORMAT('X3,Y3 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE ELLIPSE            **
C               *********************************
C
      DELX=X3-X1
      DELY=Y3-Y1
      ALEN=0.0
      TERM=DELX**2+DELY**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      A=ALEN/2.0
C
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      XCENT=(X1+X3)/2.0
      YCENT=(Y1+Y3)/2.0
C
      DELX2=X2-XCENT
      DELY2=Y2-YCENT
      ALEN=0.0
      TERM=DELX2**2+DELY2**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      B=ALEN
C
      K=0
C
      X=0.0
      Y=0.0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO3010I=181,541,5
      IREV=541-I+181
      PHI2=IREV-1
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=A*COS(PHI2)+A
      Y=B*SIN(PHI2)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 3010 CONTINUE
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ELL2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPELL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)DELX,DELY,DELX2,DELY2
 9012 FORMAT('DELX,DELY,DELX2,DELY2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)XCENT,YCENT,A,B,THETA
 9013 FORMAT('XCENT,YCENT,A,B,THETA = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPELLI(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE ELLIPSES
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE 3 SUCCESSIVE POINTS
C           AROUND THE ELLIPSE--AT THE ENDS OF AXES.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 3
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*3 = 6.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN ELLIPSE WILL GO
C           FROM THE LAST CURSOR POSITION
C           (ASSUMED TO BE AT ONE END OF MAJOR AXIS)
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT ONE END OF MINOR AXIS),
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT THE OTHER END OF MAJOR AXIS),
C           AND THEN BACK TO THE OTHER END OF THE MINOR AXIS,
C           AND CONTINUING BACK THE START POINT TO CLOSE THE ELLIPSE.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN ELLIPSE WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS RESULTING FORM THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT ONE END OF MAJOR AXIS),
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT ONE END OF MINOR AXIS),
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS
C           (ASSUMED TO BE AT THE OTHER END OF MAJOR AXIS),
C           AND THEN BACK TO THE OTHER END OF THE MINOR AXIS,
C           AND CONTINUING BACK THE START POINT TO CLOSE THE ELLIPSE.
C     NOTE--AND SO FORTH FOR 10, 14, 18, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ELLI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPELLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='ELLI'
      NUMPT=3
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPELLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW AN ELLIPSE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE END OF MAJOR AXIS AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      ONE END OF THE MINOR AXIS AT THE POINT 30 10')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)
 1138 FORMAT('      AND WITH THE OTHER END OF THE MAJOR AXIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1139)
 1139 FORMAT('      AT THE POINT 40 20')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      ELLIPSE 20 20 30 10 40 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      ELLIPSE ABSOLUTE 20 20 30 10 40 20 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X3,X3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X3=X2+X3
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y3,Y3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y3=Y2+Y3
C
      CALL DPELL2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X3
      Y1=Y3
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X3
      PYEND=Y3
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ELLI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPELLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2,X3,Y3
 9013 FORMAT('X1,Y1,X2,Y2,X3,Y3 = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPENMU(IMPSW,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
     1IERASW,
     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--END (TERMINATE) THE MULTIPLOT PROCESS
C     INPUT  ARGUMENTS--
C                       IMPSW = MULTIPLOT SWITCH (OFF OR ON)
C                       IERASV
C                       PWXMIS
C                       PWXMAS
C                       PWYMIS
C                       PWYMAS
C                       IBUGP2
C     OUTPUT ARGUMENTS--
C                       IMPSW
C                       IERASW
C                       PWXMIN
C                       PWXMAX
C                       PWYMIN
C                       PWYMAX
C                       IFOUND ('YES' OR 'NO' )
C                       IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--MARCH     1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IMPSW
      CHARACTER*4 IERASV
      CHARACTER*4 IERASW
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
CCCCC CHARACTER*4 IHWUSE
CCCCC CHARACTER*4 MESSAG
CCCCC CHARACTER*4 IHWORD
CCCCC CHARACTER*4 IHWOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPEN'
      ISUBN2='MU  '
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 DPENMU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGP2,IFOUND,IERROR
   53 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)IMPSW
   81 FORMAT('IMPSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)IERASV
   82 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)PWXMIS,PWXMAS,PWYMIS,PWYMAS
   83 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IERASW
   84 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   85 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************************
C               **  TREAT THE    END OF MULTIPLOT    CASE  **
C               *********************************************
C
 1150 CONTINUE
      IMPSW='OFF'
      IERASW=IERASV
      PWXMIN=PWXMIS
      PWXMAX=PWXMAS
      PWYMIN=PWYMIS
      PWYMAX=PWYMAS
      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 MULTIPLOT SWITCH HAS JUST BEEN SET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('TO   OFF')
      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 DPENMU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGP2,IFOUND,IERROR
 9013 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)IMPSW
 9041 FORMAT('IMPSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IERASV
 9042 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)PWXMIS,PWXMAS,PWYMIS,PWYMAS
 9043 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)IERASW
 9044 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9045 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEPM2(Y,N,ICASPL,MAXNXT,MINMAX,IGEPDF,
     1ISEED,NSAMP,
     1P,GAMMSV,SCALSV,ALOCSV,TEMP1,
     1ALOC,SCALE,SHAPE,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--ESTIMATE THE PARAMETERS OF A DISTRIBUTION USING
C              THE ELEMENTAL PERCENTILE METHOD DESCRIBED BY
C              CASTILLO, ET. AL. (SEE REFERENCE).
C
C              SUPPORTED DISTRIBUTIONS ARE:
C
C              1) GENERALIZED PARETO
C              2) GENERALIZED EXTREME VALUE
C
C     REFERENCE--CASTILLO, HADI, BALAKRISHNAN, SARABIA, "EXTREME
C                VALUE AND RELATED MODELS WITH APPLICATIONS IN
C                ENGINEERING AND SCIENCE", WILEY, 2005.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/6
C     ORIGINAL VERSION--JUNE      2005.
C     UPDATED         --AUGUST    2005. DUNRAN WAS FIXED TO GO FROM
C                                       0 TO N.  THIS ROUTINE WAS
C                                       MODIFIED TO CALL A VERSION
C                                       THAT GOES FROM 1 TO N.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IGEPDF
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION Y(*)
      DIMENSION P(*)
      DIMENSION GAMMSV(*)
      DIMENSION SCALSV(*)
      DIMENSION ALOCSV(*)
      DIMENSION TEMP1(*)
      DIMENSION XRAN(3)
C
      DOUBLE PRECISION XIN
      DOUBLE PRECISION XJN
      DOUBLE PRECISION XRN
      DOUBLE PRECISION XNN
      DOUBLE PRECISION PIN
      DOUBLE PRECISION PJN
      DOUBLE PRECISION PRN
      DOUBLE PRECISION PNN
      DOUBLE PRECISION DIJR
      DOUBLE PRECISION AIJ
      DOUBLE PRECISION AJI
      DOUBLE PRECISION AIR
      DOUBLE PRECISION AJR
      DOUBLE PRECISION CI
      DOUBLE PRECISION CR
      DOUBLE PRECISION PJNSV
      DOUBLE PRECISION DELTA0
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION EPS
      DOUBLE PRECISION EPS2
      DOUBLE PRECISION SIG
      DOUBLE PRECISION XLOWER
      DOUBLE PRECISION XUPPER
      DOUBLE PRECISION XMID
      DOUBLE PRECISION FXLOW
      DOUBLE PRECISION FXUPP
      DOUBLE PRECISION FCS
      DOUBLE PRECISION XRML
C
      INTEGER R
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 IFEESV
      CHARACTER*4 IPRISV
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA EPS /0.00001D0/
      DATA SIG /1.0D-5/
      DATA MAXIT /300/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPEP'
      ISUBN2='M2  '
      IWRITE='OFF'
C
C               ****************************************************
C               **  STEP 1--                                      **
C               **  A. SORT THE DATA                              **
C               **  B. COMPUTE THE P(I,N) = I/(N+1)               **
C               ****************************************************
C
      CALL SORT(Y,N,Y)
      DO110I=1,N
        P(I)=REAL(I)/REAL(N+1)
  110 CONTINUE
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  GENERATE EPM ESTIMATES FOR GIVEN DISTRIBUTION **
C               ****************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EPM2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'GPAR' .AND. N.GT.45)GOTO1000
      IF(ICASPL.EQ.'GPAR' .AND. N.LE.45)GOTO1500
      IF(ICASPL.EQ.'GEV ')GOTO2000
      GOTO9000
C
C  GENERAL ALGORITHM FOR GENERALIZED PARETO GIVEN ON PAGES 274-275
C  OF CASTILLO, ET.AL.
C
C  FOR N <= 45, COMPUTE FOR ALL SUBSETS ((45 2) = 990).  IF N > 45,
C  COMPUTE NSAMP RANDOM SUBSETS (GENERATE AT LEAST 1,000).
C
 1000 CONTINUE
C
      XNN=DBLE(Y(N))
      PNN=DBLE(P(N))
      PJNSV=DBLE(P(1))
      NCNT=0
      EPS2=1.0D-12
      DO1100II=1,NSAMP
C
        NTEMP=2
        CALL DUNRA2(NTEMP,N,ISEED,XRAN)
        I=XRAN(1)
        J=XRAN(2)
        IF(I.GT.J)THEN
          ITEMP=I
          I=J
          J=ITEMP
        ENDIF
C
        XIN=DBLE(Y(I))
        XJN=DBLE(Y(J))
        IF(XIN.EQ.XJN)GOTO1100
        PIN=DBLE(P(I))
        PJN=DBLE(P(J))
CCCCC   IF(PJN.EQ.PJNSV)GOTO1100
CCCCC   PJNSV=PJN
        DELTA0=(XIN/XJN) - (DLOG(1.0D0-PIN)/DLOG(1.0D0-PJN))
        IF(DELTA0.GT.0.0D0)THEN
          XLOWER=EPS2
          XUPPER=DLOG(1.0D0-XIN/XNN)/DLOG(1.0D0-PIN)
        ELSE
          XLOWER=DLOG(XIN/XNN)/DLOG((1.0D0-PIN)/(1.0D0-PNN))
          XUPPER=-EPS2
        ENDIF
        ICNT=0
        FXLOW=XIN*(1.0D0 - (1.0D0 - PJN)**XLOWER) -
     1        XJN*(1.0D0 - (1.0D0 - PIN)**XLOWER)
        
        FXUPP=XIN*(1.0D0 - (1.0D0 - PJN)**XUPPER) -
     1        XJN*(1.0D0 - (1.0D0 - PIN)**XUPPER)
C
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EPM2')THEN
          WRITE(ICOUT,1003)
 1003     FORMAT('DPEPM2: GENERALIZED PARETO')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1005)I,J,XIN,XJN,XNN
 1005     FORMAT('I,J,XIN,XJN,XNN = ',2I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1007)PIN,PJN,PNN
 1007     FORMAT('PIN,PJN,PNN = ',3G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1009)FXLOW,FXUPP
 1009     FORMAT('FXLOW,FXUPP = ',2G15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
 1110   CONTINUE
        XMID=(XLOWER+XUPPER)*0.5D0
        FCS=XIN*(1.0D0 - (1.0D0 - PJN)**XMID) -
     1      XJN*(1.0D0 - (1.0D0 - PIN)**XMID)
        IF(FCS*FXLOW.GT.0.0D0)THEN
          XLOWER=XMID
          FXLOW=FCS
        ELSE
          XUPPER=XMID
          FXUPP=FCS
        ENDIF
        XRML=XUPPER - XLOWER
        IF(XRML.LE.SIG .OR. ABS(FCS).LE.EPS)THEN
          NCNT=NCNT+1
          GAMMSV(NCNT)=REAL(XMID)
CCCCC     SCALSV(NCNT)=REAL(XMID*XJN/(1.0D0 - (1.0D0 - PJN)**XMID))
          SCALSV(NCNT)=REAL(XJN/(1.0D0 - (1.0D0 - PJN)**XMID))
          GOTO1100
        ELSE
          ICNT = ICNT + 1
          IF(ICNT.LE.MAXIT)GOTO1110
CCCCC       WRITE(ICOUT,1130)J
C1130       FORMAT('***** ITERATION ',I8,' OF GENERALIZED PARERO')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,1133)
C1133       FORMAT('      ELEMENTAL PERCENTILE ESTIMATION DID NOT ',
CCCCC1             'DID NOT CONVERGE.')
CCCCC       CALL DPWRST('XXX','BUG ')
            GOTO1100
        ENDIF
C
 1100 CONTINUE
C
      CALL MEDIAN(GAMMSV,NCNT,IWRITE,TEMP1,MAXNXT,SHAPE,IBUGA3,IERROR)
      CALL MEDIAN(SCALSV,NCNT,IWRITE,TEMP1,MAXNXT,XMED,IBUGA3,IERROR)
      SCALE=SHAPE*XMED
      IF(IGEPDF.EQ.'SIMI')SHAPE=-SHAPE
      GOTO9000
C
 1500 CONTINUE
C
      XNN=DBLE(Y(N))
      PNN=DBLE(P(N))
      PJNSV=DBLE(P(1))
      NCNT=0
      EPS2=1.0D-12
      DO1600I=1,N-1
        DO1610J=I+1,N
C
          XIN=DBLE(Y(I))
          XJN=DBLE(Y(J))
          IF(XIN.EQ.XJN)GOTO1610
          PIN=DBLE(P(I))
          PJN=DBLE(P(J))
          IF(PJN.EQ.PJNSV)GOTO1610
          PJNSV=PJN
          DELTA0=(XIN/XJN) - (DLOG(1.0D0-PIN)/DLOG(1.0D0-PJN))
          IF(DELTA0.GT.0.0D0)THEN
            XLOWER=EPS2
            XUPPER=DLOG(1.0D0-XIN/XNN)/DLOG(1.0D0-PIN)
          ELSE
            XLOWER=DLOG(XIN/XNN)/DLOG((1.0D0-PIN)/(1.0D0-PNN))
            XUPPER=-EPS2
          ENDIF
          ICNT=0
          FXLOW=XIN*(1.0D0 - (1.0D0 - PJN)**XLOWER) -
     1          XJN*(1.0D0 - (1.0D0 - PIN)**XLOWER)
        
          FXUPP=XIN*(1.0D0 - (1.0D0 - PJN)**XUPPER) -
     1          XJN*(1.0D0 - (1.0D0 - PIN)**XUPPER)
C
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EPM2')THEN
            WRITE(ICOUT,1503)
 1503       FORMAT('DPEPM2: GENERALIZED PARETO')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1505)I,J,XIN,XJN,XNN
 1505       FORMAT('I,J,XIN,XJN,XNN = ',2I8,3G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1507)PIN,PJN,PNN
 1507       FORMAT('PIN,PJN,PNN = ',3G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1509)FXLOW,FXUPP
 1509       FORMAT('FXLOW,FXUPP = ',2G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
 1630     CONTINUE
          XMID=(XLOWER+XUPPER)*0.5D0
          FCS=XIN*(1.0D0 - (1.0D0 - PJN)**XMID) -
     1        XJN*(1.0D0 - (1.0D0 - PIN)**XMID)
          IF(FCS*FXLOW.GT.0.0D0)THEN
            XLOWER=XMID
            FXLOW=FCS
          ELSE
            XUPPER=XMID
            FXUPP=FCS
          ENDIF
          XRML=XUPPER - XLOWER
          IF(XRML.LE.SIG .OR. ABS(FCS).LE.EPS)THEN
            NCNT=NCNT+1
            GAMMSV(NCNT)=REAL(XMID)
            SCALSV(NCNT)=REAL(XJN/(1.0D0 - (1.0D0 - PJN)**XMID))
            GOTO1630
          ELSE
            ICNT = ICNT + 1
            IF(ICNT.LE.MAXIT)GOTO1630
CCCCC       WRITE(ICOUT,1640)J
C1640       FORMAT('***** ITERATION ',I8,' OF GENERALIZED PARERO')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,1643)
C1643       FORMAT('      ELEMENTAL PERCENTILE ESTIMATION DID NOT ',
CCCCC1             'DID NOT CONVERGE.')
CCCCC       CALL DPWRST('XXX','BUG ')
            GOTO1610
          ENDIF
C
 1610   CONTINUE
 1600 CONTINUE
C
      CALL MEDIAN(GAMMSV,NCNT,IWRITE,TEMP1,MAXNXT,SHAPE,IBUGA3,IERROR)
      CALL MEDIAN(SCALSV,NCNT,IWRITE,TEMP1,MAXNXT,XMED,IBUGA3,IERROR)
      SCALE=SHAPE*XMED
      IF(IGEPDF.EQ.'SIMI')SHAPE=-SHAPE
      GOTO9000
C
C  GENERAL ALGORITHM FOR GENERALIZED EXTREME VALUE GIVEN ON
C  PAGES 220-223  CASTILLO, ET.AL.
C
 2000 CONTINUE
C
      XNN=DBLE(Y(N))
      PNN=DBLE(P(N))
      NCNT=0
      EPS2=1.0D-12
      DO2100II=1,NSAMP
C
        NTEMP=3
CCCCC   CALL DUNRAN(NTEMP,N,ISEED,XRAN)
        CALL DUNRA2(NTEMP,N,ISEED,XRAN)
        CALL SORT(XRAN,NTEMP,XRAN)
        I=XRAN(1)
        J=XRAN(2)
        R=XRAN(3)
C
        XIN=DBLE(Y(I))
        XJN=DBLE(Y(J))
        XRN=DBLE(Y(R))
        XNN=DBLE(Y(N))
        IF(XIN.EQ.XJN)GOTO2100
        IF(XJN.EQ.XRN)GOTO2100
        PIN=DBLE(P(I))
        PJN=DBLE(P(J))
        PRN=DBLE(P(R))
        PNN=DBLE(P(N))
        AIR=DLOG(PIN)/DLOG(PRN)
        AJR=DLOG(PJN)/DLOG(PRN)
        AIJ=DLOG(PIN)/DLOG(PJN)
        AJI=DLOG(PJN)/DLOG(PIN)
        DIJR=(XJN-XRN)/(XIN-XRN)
        IF(DIJR.LT.DLOG(AJR)/DLOG(AIR))THEN
          XLOWER=EPS2
          XUPPER=DLOG(DIJR)/DLOG(AJI)
        ELSE
          XLOWER=DLOG(1.0D0-DIJR)/DLOG(AJR)
          XUPPER=-EPS2
        ENDIF
        ICNT=0
        FXLOW=(1.0D0 - AJR**XLOWER)/(1.0D0 - AIR**XLOWER) - DIJR
        FXUPP=(1.0D0 - AJR**XUPPER)/(1.0D0 - AIR**XUPPER) - DIJR
C
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'EPM2')THEN
          WRITE(ICOUT,2003)
 2003     FORMAT('DPEPM2: GENERALIZED EXTREME VALUE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2005)I,J,XIN,XJN,XRN
 2005     FORMAT('I,J,XIN,XJN,XRN = ',2I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2007)PIN,PJN,PRN
 2007     FORMAT('PIN,PJN,PRN = ',3G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2006)AIR,AJR,AIJ,AJI
 2006     FORMAT('AIR,AJR,AIJ,AJI = ',4G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2009)DIJR,FXLOW,FXUPP
 2009     FORMAT('DIJR,FXLOW,FXUPP = ',3G15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
 2110   CONTINUE
        XMID=(XLOWER+XUPPER)*0.5D0
        FCS=(1.0D0 - AJR**XMID)/(1.0D0 - AIR**XMID) - DIJR
        IF(FCS*FXLOW.GT.0.0D0)THEN
          XLOWER=XMID
          FXLOW=FCS
        ELSE
          XUPPER=XMID
          FXUPP=FCS
        ENDIF
        XRML=XUPPER - XLOWER
        IF(XRML.LE.SIG .OR. ABS(FCS).LE.EPS)THEN
          NCNT=NCNT+1
          GAMMSV(NCNT)=REAL(XMID)
          CR=-DLOG(PRN)
          CI=-DLOG(PIN)
          DSCALE=XMID*(XIN-XRN)/(CR**XMID - CI**XMID)
          SCALSV(NCNT)=REAL(XMID*(XIN-XRN)/(CR**XMID - CI**XMID))
          DLOC=XIN - DSCALE*DLOG(CI)
          ALOCSV(NCNT)=REAL(DLOC)
          GOTO2100
        ELSE
          ICNT = ICNT + 1
          IF(ICNT.LE.MAXIT)GOTO2110
CCCCC       WRITE(ICOUT,2130)J
C2130       FORMAT('***** ITERATION ',I8,' OF GENERALIZED EXTREME ',
CCCCC1             'VALUE')
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2133)
C2133       FORMAT('      ELEMENTAL PERCENTILE ESTIMATION DID NOT ',
CCCCC1             'CONVERGE.')
CCCCC       CALL DPWRST('XXX','BUG ')
            GOTO2100
        ENDIF
C
 2100 CONTINUE
C
      CALL MEDIAN(GAMMSV,NCNT,IWRITE,TEMP1,MAXNXT,SHAPE,IBUGA3,IERROR)
      CALL MEDIAN(SCALSV,NCNT,IWRITE,TEMP1,MAXNXT,SCALE,IBUGA3,IERROR)
      CALL MEDIAN(ALOCSV,NCNT,IWRITE,TEMP1,MAXNXT,ALOC,IBUGA3,IERROR)
      GOTO9000
C
 9000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPERAS(IHARG,IARGT,IARG,NUMARG,
     1IBACCO,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
     1ICAPSW,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT AN IMMEDIATE ERASE OF THE SCREEN
C              FOR DISPLAY TERMINALS
C              (OR SKIP TO A NEW PAGE FOR PAPER-OUTPUT TERMINALS
C              AND THE BATCH HIGH-SPEED PRINTER)
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO')
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MAY       1989.  IDNVOF/HOF ADDED TO INPUT ARGS (ALAN)
C                                        TO FIX POSTSCRIPT SCALING PROBLEM
C     UPDATED         --MARCH     1990.  PATCH FOR X11 (CHECK PICTURE POINTS)
C     UPDATED         --MAY       1992.  AUTO CLOSE/OPEN OF DEVICE 3 (JJF)
C     UPDATED         --MAY       1992.  DEBUG STATEMENTS
C     UPDATED         --MAY       1992.  IBUGXX, ISUBXX, IERRXX
C     UPDATED         --NOVEMBER  1996.  QWIN, BUG FIX
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --SEPTEMBER 2002.  ICAPSW
C
C-----NON-COMMON VARIABLES----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBACCO
C
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
C
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICOPSJ
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED MAY 1992 (JJF)
      CHARACTER*4 IBUGXX
      CHARACTER*4 ISUBXX
      CHARACTER*4 IERRXX
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
C
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED               MAY 1989
CCCCC TO FIX POSTSCRIPT TRANSLATION PROBLEM (ALAN)   MAY 1989
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
CCCCC THE FOLLOWING LINE WAS ADDED    MAY 1992 (JJF)
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPER'
      ISUBN2='SC  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IBUGG4=IBUGD2
      ISUBG4=ISUBRO
      IERRG4=IERROR
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 DPERAS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGD2,IBUGG4
   53 FORMAT('IBUGD2,IBUGG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IFOUND,IERROR
   54 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1992
      WRITE(ICOUT,55)IPL2CS
   55 FORMAT('IPL2CS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO61I=1,NUMARG
      WRITE(ICOUT,62)I,IHARG(I),IARGT(I),IARG(I)
   62 FORMAT('I,IHARG(I),IARGT(I),IARG(I) = ',
     1I8,2X,A4,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
      WRITE(ICOUT,70)NUMDEV
   70 FORMAT('NUMDEV = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO71I=1,NUMDEV
      WRITE(ICOUT,72)I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   72 FORMAT('I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)I,IDPOWE(I),IDCONT(I),IDCOLO(I)
   73 FORMAT('I,IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)I,IDNVPP(I),IDNHPP(I),IDUNIT(I)
   74 FORMAT('I,IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,2X,I8,2X,I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
   71 CONTINUE
      WRITE(ICOUT,82)IMANUF,IMODEL,IMODE2,IMODE3
   82 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IGCONT,IGCOLO
   83 FORMAT('IGCONT,IGCOLO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)NUMVPP,NUMHPP,ANUMVP,ANUMHP
   84 FORMAT('NUMVPP,NUMHPP,ANUMVP,ANUMHP = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  EXTRACT NEEDED INFORMATION FROM THE COMMAND LINE  **
C               ********************************************************
C
      IF(NUMARG.LE.0)GOTO1120
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DELA')GOTO9000
      GOTO1120
C
 1120 CONTINUE
      IFOUND='YES'
C
CCCCC THE FOLLOWING 7 LINES WERE ADDED           MAY 1992 (JJF)
CCCCC TO AUTOMATICALLY CLOSE/OPEN DEVICE 3    MAY 1992
CCCCC WHENEVER AN INITIALIZATION/ERASE IS DONE   MAY 1992
CCCCC (SEE ALSO DPERAS AND MAINOD)               MAY 1992
C
      IBUGXX=IBUGG4
      ISUBXX=ISUBG4
      IERRXX=IERRG4
      IF(IPL2CS.EQ.'OPEN')
     1CALL DPDEV(3,'CLOS','POST',ICAPSW,IBUGXX,ISUBXX,IERRXX)
      IF(IPL2CS.EQ.'CLOSED')
     1CALL DPDEV(3,'OPEN','POST',ICAPSW,IBUGXX,ISUBXX,IERRXX)
C
C               ********************************
C               **  STEP 2--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
      IGUNIT=IDUNIT(IDEVIC)
C
C               ******************************************************
C               **  STEP 2.1--                                      **
C               **  TREAT THE ERASE CASE FOR PRINTERS  **
C               **  AND DISCRETE TERMINALS                          **
C               **  (SKIP TO NEXT PAGE)            ZZ
C               ******************************************************
C
      ISTEPN='2.1'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IGCONT.EQ.'ON')GOTO1190
      WRITE(ICOUT,998)
  998 FORMAT(1H1)
      CALL DPWRST('XXX','BUG ')
      GOTO8000
 1190 CONTINUE
C
C               ****************************************
C               **  STEP 2.2--                        **
C               **  TREAT THE ERASE CASE              **
C               **  FOR CONTINUOUS TERMINALS.         **
C               ****************************************
C
      ISTEPN='2.2'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGD2.EQ.'ON')WRITE(ICOUT,1205)
 1205 FORMAT('*** FROM DPERAS--AN ERASE SHOULD TAKE PLACE NOW ***')
      IF(IBUGD2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      CALL DPERSC(IBACCO)
CCCCC FOLLOWING LINES ADDED FOR X11 (PICTURE POINTS MAY BE DYNAMICALLY
CCCCC CHANGED BY ERASE SCREEN ROUTINE, MAKE SURE HAVE UP-TO-DATE VALUES).
CCCCC FIX BUG IN FOLLOWING   NOVEMBER 1996.
      IF(IMANUF.EQ.'X11')THEN
        NUMVPP=ANUMVP+0.5
        NUMHPP=ANUMHP+0.5
CCCCC   IDNVPP(I)=NUMVPP
CCCCC   IDNHPP(I)=NUMHPP
        IDNVPP(IDEVIC)=NUMVPP
        IDNHPP(IDEVIC)=NUMHPP
      ENDIF
CCCCC END CHANGE
CCCCC FOLLOWING LINES ADDED FOR QWIN (PICTURE POINTS MAY BE DYNAMICALLY
CCCCC CHANGED BY ERASE SCREEN ROUTINE, MAKE SURE HAVE UP-TO-DATE
CCCCC VALUES).  NOVEMBER 1996.
      IF(IMANUF.EQ.'QWIN')THEN
        NUMVPP=ANUMVP+0.5
        NUMHPP=ANUMHP+0.5
        IDNVPP(IDEVIC)=NUMVPP
        IDNHPP(IDEVIC)=NUMHPP
      ENDIF
C
      IF(IBUGD2.EQ.'ON')WRITE(ICOUT,1206)
 1206 FORMAT('*** AN ERASE SHOULD HAVE JUST TAKEN PLACE ***')
      IF(IBUGD2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ************************************
C               **  STEP 2.2B--                   **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSJ='OFF'
      NUMCOJ=0
      CALL DPCLPL(ICOPSJ,NUMCOJ,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
      GOTO8000
C
 8000 CONTINUE
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 DPERAS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGD2,IBUGG4
 9013 FORMAT('IBUGD2,IBUGG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IFOUND,IERROR
 9014 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1992
      WRITE(ICOUT,9015)IPL2CS
 9015 FORMAT('IPL2CS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9021I=1,NUMARG
      WRITE(ICOUT,9022)I,IHARG(I),IARGT(I),IARG(I)
 9022 FORMAT('I,IHARG(I),IARGT(I),IARG(I) = ',
     1I8,2X,A4,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
      WRITE(ICOUT,9030)NUMDEV
 9030 FORMAT('NUMDEV = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9031I=1,NUMDEV
      WRITE(ICOUT,9032)I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
 9032 FORMAT('I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)I,IDPOWE(I),IDCONT(I),IDCOLO(I)
 9033 FORMAT('I,IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)I,IDNVPP(I),IDNHPP(I),IDUNIT(I)
 9034 FORMAT('I,IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,2X,I8,2X,I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
 9031 CONTINUE
      WRITE(ICOUT,9042)IMANUF,IMODEL,IMODE2,IMODE3
 9042 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IGCONT,IGCOLO
 9043 FORMAT('IGCONT,IGCOLO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)NUMVPP,NUMHPP,ANUMVP,ANUMHP
 9044 FORMAT('NUMVPP,NUMHPP,ANUMVP,ANUMHP = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPERBA(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,ICONT,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE AN ERROR BAR PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/11
C     ORIGINAL VERSION--OCTOBER   1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH1
      CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Z1(MAXOBV)
      DIMENSION Z2(MAXOBV)
      DIMENSION Z3(MAXOBV)
      DIMENSION Z4(MAXOBV)
      DIMENSION Z5(MAXOBV)
      DIMENSION Z6(MAXOBV)
CCCCC FOLLOWING LINES ADDED FEBRUARY, 1994
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),Z1(1))
      EQUIVALENCE (G2RBAG(IGAR12),Z2(1))
      EQUIVALENCE (G2RBAG(IGAR13),Z3(1))
      EQUIVALENCE (G2RBAG(IGAR14),Z4(1))
      EQUIVALENCE (G2RBAG(IGAR15),Z5(1))
      EQUIVALENCE (G2RBAG(IGAR16),Z6(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='DPER'
      ISUBN2='BA  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
C               *************************************
C               **  TREAT THE ERROR BAR PLOT CASE  **
C               *************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'ERBA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPERBA--')
      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 ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ERBA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='ERBA'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BAR'.AND.
     1IHARG(2).EQ.'PLOT')GOTO1120
      GOTO1180
C
 1110 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1180
C
 1120 CONTINUE
      ILASTC=2
      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.'ERBA')
     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 DPERBA')
      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.'ERBA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.GE.2.AND.NUMV2.LE.6)GOTO1490
C
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPERBA--')
      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 AN ERROR BAR PLOT COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      MUST BE AT LEAST 2 AND AT MOST 6;')
      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.'ERBA')
     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.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)
 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.'ERBA')
     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
      GOTO1690
C
 1610 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1611)
 1611 FORMAT('***** ERROR IN DPERBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1612)
 1612 FORMAT('      FOR AN ERROR BAR 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 ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1627)
 1627 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1628)(IANS(I),I=1,IWIDTH)
 1628 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.'ERBA')
     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)
      IF(ICOL3.EQ.MAXCP3)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)
      IF(ICOL4.EQ.MAXCP4)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)
      IF(ICOL5.EQ.MAXCP5)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)
      IF(ICOL6.EQ.MAXCP6)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
 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 VECTOR D(.) TO 1'S, 2'S, AND 3'S            **
C               **  FOR THE PLOTTED VALUE, THE LOWER CONFIDENCE LINE,      **
C               **  AND THE UPPER CONFIDENCE LINE.                         **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ERBA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPERB2(Z1,Z2,Z3,Z4,Z5,Z6,NLOCAL,NUMV2,ICASPL,ICONT,
     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.'ERBA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPERBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG2,IBUGG3,IBUGQ,ISUBRO
 9012 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,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 DPERB2(Z1,Z2,Z3,Z4,Z5,Z6,N,NUMV2,ICASPL,ICONT,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN ERROR BAR PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/12
C     ORIGINAL VERSION--DECEMBER  1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION Z1(*)
      DIMENSION Z2(*)
      DIMENSION Z3(*)
      DIMENSION Z4(*)
      DIMENSION Z5(*)
      DIMENSION Z6(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ERB2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPERB2--')
      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
   53 FORMAT('ICASPL,ICONT = ',A4,2X,A4)
      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)
   63 FORMAT('I,Z1(I),Z2(I),Z3(I),Z4(I),Z5(I),Z6(I) = ',I8,6E10.3)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   90 CONTINUE
C
      NUMCPL=11
      J=0
      JD=0
C
      DO1100I=1,N
C
      YMID=Z1(I)
C
      YMAX=YMID+Z2(I)
C
      IF(NUMV2.LE.3)YMIN=YMID-Z2(I)
      IF(NUMV2.GE.4)YMIN=YMID-Z3(I)
C
      IF(NUMV2.LE.2)XMID=I
      IF(NUMV2.EQ.3)XMID=Z3(I)
      IF(NUMV2.GE.4)XMID=Z4(I)
C
      IF(NUMV2.LE.4)XLEF=XMID
      IF(NUMV2.GE.5)XLEF=XMID-Z5(I)
C
      IF(NUMV2.LE.4)XRIG=XMID
      IF(NUMV2.EQ.5)XRIG=XMID+Z5(I)
      IF(NUMV2.EQ.6)XRIG=XMID+Z6(I)
C
      CALL DPCHLI(ICONT,NUMCPL,YMID,YMID,XMID,XMID,J,JD,Y2,X2,D2,IERROR)
      CALL DPCHLI(ICONT,NUMCPL,YMAX,YMAX,XMID,XMID,J,JD,Y2,X2,D2,IERROR)
      CALL DPCHLI(ICONT,NUMCPL,YMIN,YMIN,XMID,XMID,J,JD,Y2,X2,D2,IERROR)
      CALL DPCHLI(ICONT,NUMCPL,YMID,YMID,XLEF,XLEF,J,JD,Y2,X2,D2,IERROR)
      CALL DPCHLI(ICONT,NUMCPL,YMID,YMID,XRIG,XRIG,J,JD,Y2,X2,D2,IERROR)
      CALL DPCHLI(ICONT,NUMCPL,YMAX,YMIN,XMID,XMID,J,JD,Y2,X2,D2,IERROR)
      CALL DPCHLI(ICONT,NUMCPL,YMID,YMID,XLEF,XRIG,J,JD,Y2,X2,D2,IERROR)
C
 1100 CONTINUE
C
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ERB2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPERB2--')
      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
 9013 FORMAT('ICASPL,ICONT = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMV2
 9014 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)N2,NPLOTV
 9021 FORMAT('N2,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,N2
      WRITE(ICOUT,9023)I,Y2(I),X2(I),D2(I)
 9023 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,3E10.3)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPERDE(IHARG,IARGT,ARG,NUMARG,DEFERD,
     1ERASDE,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE ERASE DELAY FACTOR.
C              THE SPECIFIED ERASE DELAY FACTOR WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE ERASDE.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFERD (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--ERASDE (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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DELA')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'DELA')GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPERDE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR ERASE DELAY ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE THE ANALYST WISHES TO DOUBLE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE DELAY TIME WHILE SCREEN ERASURES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      ARE BEING CARRIED OUT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      ERASE DELAY 2 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFERD
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
CCCCC ERASDE=HOLD
      AIMAX=2**(NUMBPC*NUMCPW-2)
      IF(HOLD.LT.AIMAX)ERASDE=HOLD
      IF(HOLD.GE.AIMAX)ERASDE=AIMAX
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ERASDE
 1181 FORMAT('THE ERASE DELAY FACTOR HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPERSC(IBACCO)
C
C     PURPOSE--ERASE THE SCREEN
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY   1989.  SEND BKGD COLOR TO GRERSC
C                                        (FOR METAFILE) (ALAN)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IBACCO
C
      CHARACTER*4 ICASE
      CHARACTER*4 ICOL
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ICASE='9999'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ERSC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPERSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBACCO
   52 FORMAT('IBACCO = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMANUF,IMODEL
   53 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IGCOLO
   54 FORMAT('IGCOLO = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************************
C               **  STEP 1--                                **
C               **  BRANCH TO THE COLOR OR NON-COLOR CASES  **
C               **********************************************
C
      IF(IGCOLO.EQ.'OFF')GOTO1100
      GOTO1200
C
C               ********************************
C               **  STEP 1--                  **
C               **  TREAT THE NON-COLOR CASE  **
C               ********************************
C
 1100 CONTINUE
      JCOL=0
      CALL GRERSC(JCOL,IBACCO)
      GOTO9000
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  TREAT THE COLOR CASE                          **
C               **  STEP 2.1--                                    **
C               **        TRANSLATE THE CHARACTER REPRESENTATION  **
C               **        OF THE BACKGROUND COLOR                 **
C               **        INTO A NUMERIC REPRESENTATION           **
C               **        WHICH CAN BE UNDERSTOOD BY THE          **
C               **        GRAPHICS DEVICE.                        **
C               **  STEP 2.2--                                    **
C               **        SET THE BACKGROUND COLOR                **
C               **        ON THE GRAPHICS DEVICE.                 **
C               **  STEP 2.3--                                    **
C               **        ERASE THE SCREEN                        **
C               ****************************************************
C
 1200 CONTINUE
CCCCC ICASE='REGI'
      ICASE='BACK'
      ICOL=IBACCO
      CALL GRTRCO(ICASE,ICOL,JCOL)
      CALL GRSECO(ICASE,ICOL,JCOL)
      CALL GRERSC(JCOL,ICOL)
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ERSC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPERSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBACCO,ICOL,JCOL
 9012 FORMAT('IBACCO,ICOL,JCOL = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASE
 9013 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IBUGG4,ISUBG4,IERRG4
 9015 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXA2(Y,X,N,ITYPE,B1,K1,K2,IBUGA3,B2,IERROR)
C
C     PURPOSE--SOLVE FOR THE COEFFICIENTS FOR AN
C              EXACT FIT OF A FUNCTION OF THE FORM
C              Y = F(X) = POLYNOMIAL/POLYNOMIAL
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY       1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ITYPE
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION ITYPE(*)
      DIMENSION B1(*)
      DIMENSION B2(*)
C
      DIMENSION A(25,25)
      DIMENSION A2(25,25)
      DIMENSION A3(25,25)
      DIMENSION RIGHT(25)
      DIMENSION RIGHT2(25)
      DIMENSION B3(25)
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='DPEX'
      ISUBN2='A2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N,K1,K2
   53 FORMAT('N,K1,K2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      KTEMP=K1+K2
      DO55I=1,KTEMP
      WRITE(ICOUT,56)I,Y(I),X(I),ITYPE(I),B1(I)
   56 FORMAT('I,Y(.),X(.),ITYPE(.),B1(.) = ',I8,2E15.7,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  FORM THE MATIX FOR THE LINEAR SYSTEM  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K1P1=K1+1
      K1P5=K1+5
      K1P6=K1+6
      K1P10=K1+10
      K1P11=K1+11
      K1P15=K1+15
      K1P16=K1+16
      K1P20=K1+20
      K1P21=K1+21
      K1PK2=K1+K2
C
      DO100J=1,K1
      DO110I=1,N
      IF(J.EQ.1)A(I,J)=1.0
      IF(J.GT.1)A(I,J)=X(I)**(J-1)
  110 CONTINUE
  100 CONTINUE
C
      DO200J=1,K2
      K1PJ=K1+J
      DO210I=1,N
      IF(J.EQ.1)A(I,K1PJ)=1.0
      IF(J.GT.1)A(I,K1PJ)=X(I)**(J-1)
      A(I,K1PJ)=-Y(I)*A(I,K1PJ)
  210 CONTINUE
  200 CONTINUE
C
      K=K1+K2
      DO250I=1,N
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,255)(A(I,J),J=1,K)
  255 FORMAT('A(.,.) = ',10E12.6)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
  250 CONTINUE
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  FORM THE RIGHT SIDE FOR THE LINEAR SYSTEM  **
C               *************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO300I=1,N
      RIGHT(I)=0.0
  300 CONTINUE
C
      DO400J=1,K
      IF(ITYPE(J).EQ.'K')GOTO410
      GOTO400
  410 CONTINUE
      DO500I=1,N
      RIGHT(I)=RIGHT(I)-A(I,J)
  500 CONTINUE
  400 CONTINUE
C
C               ***********************************************
C               **  STEP 3--                                 **
C               **  ADJUST THE MATRIX FOR THE LINEAR SYSTEM  **
C               ***********************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J2=0
      DO600J=1,K
      IF(ITYPE(J).EQ.'K')GOTO600
      J2=J2+1
      DO700I=1,N
      A2(I,J2)=A(I,J)
  700 CONTINUE
  600 CONTINUE
C
C               *********************************
C               **  STEP 4--                   **
C               **  TRIANGULARIZE THE SYSTEM,  **
C               **  THEN BACKSOLVE.            **
C               *********************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO790
      WRITE(ICOUT,711)N
  711 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO720I=1,N
      WRITE(ICOUT,721)(A2(I,J),J=1,N),RIGHT(I)
  721 FORMAT('A2(I,.),RIGHT(I) = ',11E10.3)
      CALL DPWRST('XXX','BUG ')
  720 CONTINUE
  790 CONTINUE
C
      CALL TRIA25(A2,N,N,RIGHT,A3,RIGHT2,IBUGA3)
      CALL BACK25(A3,N,N,RIGHT2,B3,IBUGA3)
C
C               *****************************
C               **  STEP 5--               **
C               **  COPY THE COEFFICIENTS  **
C               *****************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IU=0
      DO800J=1,K
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,811)J,IU,ITYPE(J),B1(J),B2(J),B3(J)
  811 FORMAT('J,IU,ITYPE(J),B1(J),B2(J),B3(J) = ',2I6,2X,A4,3F10.4)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ITYPE(J).EQ.'K')GOTO850
      IU=IU+1
      B2(J)=B3(IU)
      GOTO800
  850 CONTINUE
      B2(J)=B1(J)
  800 CONTINUE
C
C               ****************************
C               **  STEP 6--              **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IDEG1=K1-1
      IDEG2=K2-1
C
      IF(IPRINT.EQ.'OFF')GOTO2990
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1001)
 1001 FORMAT('EXACT RATIONAL FUNCTION FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1002)N
 1002 FORMAT('      NUMBER OF POINTS IN FIRST SET    = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1003)IDEG1
 1003 FORMAT('      DEGREE OF NUMERATOR              = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1004)IDEG2
 1004 FORMAT('      DEGREE OF DENOMINATOR            = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(K1.EQ.1)GOTO1010
      IF(K1.EQ.2)GOTO1020
      IF(K1.EQ.3)GOTO1030
      IF(K1.EQ.4)GOTO1040
      IF(K1.EQ.5)GOTO1050
      IF(K1.EQ.6)GOTO1060
      IF(K1.EQ.7)GOTO1070
      IF(K1.EQ.8)GOTO1080
      IF(K1.EQ.9)GOTO1090
      IF(K1.EQ.10)GOTO1100
      IF(K1.EQ.11)GOTO1110
      IF(K1.EQ.12)GOTO1120
      IF(K1.EQ.13)GOTO1130
      IF(K1.EQ.14)GOTO1140
      IF(K1.EQ.15)GOTO1150
      IF(K1.EQ.16)GOTO1160
      IF(K1.EQ.17)GOTO1170
      IF(K1.EQ.18)GOTO1180
      IF(K1.EQ.19)GOTO1190
      IF(K1.EQ.20)GOTO1200
      IF(K1.EQ.21)GOTO1210
C
 1010 CONTINUE
      WRITE(ICOUT,1011)(B2(I),I=1,K1)
 1011 FORMAT('NUMERATOR  --A0                  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO1990
 1020 CONTINUE
      WRITE(ICOUT,1021)(B2(I),I=1,K1)
 1021 FORMAT('NUMERATOR  --A0  A1              =',5E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO1990
 1030 CONTINUE
      WRITE(ICOUT,1031)(B2(I),I=1,K1)
 1031 FORMAT('NUMERATOR  --A0  A1  A2          =',5E16.3)
      CALL DPWRST('XXX','BUG ')
      GOTO1990
 1040 CONTINUE
      WRITE(ICOUT,1041)(B2(I),I=1,K1)
 1041 FORMAT('NUMERATOR  --A0  A1  A2  A3      =',5E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO1990
 1050 CONTINUE
      WRITE(ICOUT,1051)(B2(I),I=1,K1)
 1051 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO1990
 1060 CONTINUE
      WRITE(ICOUT,1061)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1062)(B2(I),I=6,K1)
 1061 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1062 FORMAT('           --A5                  =',5E15.7)
      GOTO1990
 1070 CONTINUE
      WRITE(ICOUT,1071)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1072)(B2(I),I=6,K1)
 1071 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1072 FORMAT('           --A5  A6              =',5E15.7)
      GOTO1990
 1080 CONTINUE
      WRITE(ICOUT,1081)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1082)(B2(I),I=6,K1)
 1081 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1082 FORMAT('           --A5  A6  A7          =',5E15.7)
      GOTO1990
 1090 CONTINUE
      WRITE(ICOUT,1091)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1092)(B2(I),I=6,K1)
 1091 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1092 FORMAT('           --A5  A6  A7  A8      =',5E15.7)
      GOTO1990
 1100 CONTINUE
      WRITE(ICOUT,1101)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)(B2(I),I=6,K1)
 1101 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1102 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
      GOTO1990
 1110 CONTINUE
      WRITE(ICOUT,1111)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)(B2(I),I=11,K1)
 1111 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1112 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1113 FORMAT('           --A10                 =',5E15.7)
      GOTO1990
 1120 CONTINUE
      WRITE(ICOUT,1121)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)(B2(I),I=11,K1)
 1121 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1122 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1123 FORMAT('           --A10 A11             =',5E15.7)
      GOTO1990
 1130 CONTINUE
      WRITE(ICOUT,1131)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)(B2(I),I=11,K1)
 1131 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1132 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1133 FORMAT('           --A10 A11 A12         =',5E15.7)
      GOTO1990
 1140 CONTINUE
      WRITE(ICOUT,1141)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)(B2(I),I=11,K1)
 1141 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1142 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1143 FORMAT('           --A10 A11 A12 A13     =',5E15.7)
      GOTO1990
 1150 CONTINUE
      WRITE(ICOUT,1151)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)(B2(I),I=11,K1)
 1151 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1152 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1153 FORMAT('           --A10 A11 A12 A13 A14 =',5E15.7)
      GOTO1990
 1160 CONTINUE
      WRITE(ICOUT,1161)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1162)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1163)(B2(I),I=11,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1164)(B2(I),I=16,K1)
 1161 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1162 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1163 FORMAT('           --A10 A11 A12 A13 A14 =',5E15.7)
 1164 FORMAT('           --A15                 =',5E15.7)
      GOTO1990
 1170 CONTINUE
      WRITE(ICOUT,1171)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)(B2(I),I=11,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)(B2(I),I=16,K1)
 1171 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1172 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1173 FORMAT('           --A10 A11 A12 A13 A14 =',5E15.7)
 1174 FORMAT('           --A15 A16             =',5E15.7)
      GOTO1990
 1180 CONTINUE
      WRITE(ICOUT,1181)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)(B2(I),I=11,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)(B2(I),I=16,K1)
 1181 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1182 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1183 FORMAT('           --A10 A11 A12 A13 A14 =',5E15.7)
 1184 FORMAT('           --A15 A16 A17         =',5E15.7)
      GOTO1990
 1190 CONTINUE
      WRITE(ICOUT,1191)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1192)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1193)(B2(I),I=11,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)(B2(I),I=16,K1)
 1191 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1192 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1193 FORMAT('           --A10 A11 A12 A13 A14 =',5E15.7)
 1194 FORMAT('           --A15 A16 A17 A18     =',5E15.7)
      GOTO1990
 1200 CONTINUE
      WRITE(ICOUT,1201)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1202)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1203)(B2(I),I=11,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1204)(B2(I),I=16,K1)
 1201 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1202 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1203 FORMAT('           --A10 A11 A12 A13 A14 =',5E15.7)
 1204 FORMAT('           --A15 A16 A17 A18 A19 =',5E15.7)
      GOTO1990
 1210 CONTINUE
      WRITE(ICOUT,1211)(B2(I),I=1,5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)(B2(I),I=6,10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)(B2(I),I=11,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)(B2(I),I=16,20)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)(B2(I),I=21,K1)
 1211 FORMAT('NUMERATOR  --A0  A1  A2  A3  A4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 1212 FORMAT('           --A5  A6  A7  A8  A9  =',5E15.7)
 1213 FORMAT('           --A10 A11 A12 A13 A14 =',5E15.7)
 1214 FORMAT('           --A15 A16 A17 A18 A19 =',5E15.7)
 1215 FORMAT('           --A20                 =',5E15.7)
      GOTO1990
 1990 CONTINUE
C
      IF(K2.EQ.1)GOTO2010
      IF(K2.EQ.2)GOTO2020
      IF(K2.EQ.3)GOTO2030
      IF(K2.EQ.4)GOTO2040
      IF(K2.EQ.5)GOTO2050
      IF(K2.EQ.6)GOTO2060
      IF(K2.EQ.7)GOTO2070
      IF(K2.EQ.8)GOTO2080
      IF(K2.EQ.9)GOTO2090
      IF(K2.EQ.10)GOTO2100
      IF(K2.EQ.11)GOTO2110
      IF(K2.EQ.12)GOTO2120
      IF(K2.EQ.13)GOTO2130
      IF(K2.EQ.14)GOTO2140
      IF(K2.EQ.15)GOTO2150
      IF(K2.EQ.16)GOTO2160
      IF(K2.EQ.17)GOTO2170
      IF(K2.EQ.18)GOTO2180
      IF(K2.EQ.19)GOTO2190
      IF(K2.EQ.20)GOTO2200
      IF(K2.EQ.21)GOTO2210
C
 2010 CONTINUE
      WRITE(ICOUT,2011)(B2(I),I=K1P1,K1PK2)
 2011 FORMAT('DENOMINATOR--B0                  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO2990
 2020 CONTINUE
      WRITE(ICOUT,2021)(B2(I),I=K1P1,K1PK2)
 2021 FORMAT('DENOMINATOR--B0  B1              =',5E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO2990
 2030 CONTINUE
      WRITE(ICOUT,2031)(B2(I),I=K1P1,K1PK2)
 2031 FORMAT('DENOMINATOR--B0  B1  B2          =',5E16.3)
      CALL DPWRST('XXX','BUG ')
      GOTO2990
 2040 CONTINUE
      WRITE(ICOUT,2041)(B2(I),I=K1P1,K1PK2)
 2041 FORMAT('DENOMINATOR--B0  B1  B2  B3      =',5E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO2990
 2050 CONTINUE
      WRITE(ICOUT,2051)(B2(I),I=K1P1,K1PK2)
 2051 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO2990
 2060 CONTINUE
      WRITE(ICOUT,2061)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2062)(B2(I),I=K1P6,K1PK2)
 2061 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2062 FORMAT('           --B5                  =',5E15.7)
      GOTO2990
 2070 CONTINUE
      WRITE(ICOUT,2071)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2072)(B2(I),I=K1P6,K1PK2)
 2071 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2072 FORMAT('           --B5  B6              =',5E15.7)
      GOTO2990
 2080 CONTINUE
      WRITE(ICOUT,2081)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2082)(B2(I),I=K1P6,K1PK2)
 2081 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2082 FORMAT('           --B5  B6  B7          =',5E15.7)
      GOTO2990
 2090 CONTINUE
      WRITE(ICOUT,2091)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2092)(B2(I),I=K1P6,K1PK2)
 2091 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2092 FORMAT('           --B5  B6  B7  B8      =',5E15.7)
      GOTO2990
 2100 CONTINUE
      WRITE(ICOUT,2101)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2102)(B2(I),I=K1P6,K1PK2)
 2101 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2102 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
      GOTO2990
 2110 CONTINUE
      WRITE(ICOUT,2111)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)(B2(I),I=K1P11,K1PK2)
 2111 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2112 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2113 FORMAT('           --B10                 =',5E15.7)
      GOTO2990
 2120 CONTINUE
      WRITE(ICOUT,2121)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2122)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2123)(B2(I),I=K1P11,K1PK2)
 2121 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2122 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2123 FORMAT('           --B10 B11             =',5E15.7)
      GOTO2990
 2130 CONTINUE
      WRITE(ICOUT,2131)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2132)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2133)(B2(I),I=K1P11,K1PK2)
 2131 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2132 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2133 FORMAT('           --B10 B11 B12         =',5E15.7)
      GOTO2990
 2140 CONTINUE
      WRITE(ICOUT,2141)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2142)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2143)(B2(I),I=K1P11,K1PK2)
 2141 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2142 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2143 FORMAT('           --B10 B11 B12 B13     =',5E15.7)
      GOTO2990
 2150 CONTINUE
      WRITE(ICOUT,2151)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2152)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2153)(B2(I),I=K1P11,K1PK2)
 2151 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2152 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2153 FORMAT('           --B10 B11 B12 B13 B14 =',5E15.7)
      GOTO2990
 2160 CONTINUE
      WRITE(ICOUT,2161)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2162)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2163)(B2(I),I=K1P11,K1P15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2164)(B2(I),I=K1P16,K1PK2)
 2161 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2162 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2163 FORMAT('           --B10 B11 B12 B13 B14 =',5E15.7)
 2164 FORMAT('           --B15                 =',5E15.7)
      GOTO2990
 2170 CONTINUE
      WRITE(ICOUT,2171)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2172)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2173)(B2(I),I=K1P11,K1P15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2174)(B2(I),I=K1P16,K1PK2)
 2171 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2172 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2173 FORMAT('           --B10 B11 B12 B13 B14 =',5E15.7)
 2174 FORMAT('           --B15 B16             =',5E15.7)
      GOTO2990
 2180 CONTINUE
      WRITE(ICOUT,2181)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2182)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2183)(B2(I),I=K1P11,K1P15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2184)(B2(I),I=K1P16,K1PK2)
 2181 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2182 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2183 FORMAT('           --B10 B11 B12 B13 B14 =',5E15.7)
 2184 FORMAT('           --B15 B16 B17         =',5E15.7)
      GOTO2990
 2190 CONTINUE
      WRITE(ICOUT,2191)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2192)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2193)(B2(I),I=K1P11,K1P15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2194)(B2(I),I=K1P16,K1PK2)
 2191 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2192 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2193 FORMAT('           --B10 B11 B12 B13 B14 =',5E15.7)
 2194 FORMAT('           --B15 B16 B17 B18     =',5E15.7)
      GOTO2990
 2200 CONTINUE
      WRITE(ICOUT,2201)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2202)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2203)(B2(I),I=K1P11,K1P15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2204)(B2(I),I=K1P16,K1PK2)
 2201 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2202 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2203 FORMAT('           --B10 B11 B12 B13 B14 =',5E15.7)
 2204 FORMAT('           --B15 B16 B17 B18 B19 =',5E15.7)
      GOTO2990
 2210 CONTINUE
      WRITE(ICOUT,2211)(B2(I),I=K1P1,K1P5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)(B2(I),I=K1P6,K1P10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)(B2(I),I=K1P11,K1P15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)(B2(I),I=K1P16,K1P20)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)(B2(I),I=K1P21,K1PK2)
 2211 FORMAT('DENOMINATOR--B0  B1  B2  B3  B4  =',5E15.7)
      CALL DPWRST('XXX','BUG ')
 2212 FORMAT('           --B5  B6  B7  B8  B9  =',5E15.7)
 2213 FORMAT('           --B10 B11 B12 B13 B14 =',5E15.7)
 2214 FORMAT('           --B15 B16 B17 B18 B19 =',5E15.7)
 2215 FORMAT('           --B20                 =',5E15.7)
      GOTO2990
 2990 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,IERROR
 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,K1,K2
 9013 FORMAT('N,K1,K2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXAC(IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT AN EXACT RATIONAL FUNCTION FIT.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988.      ADD LOFCDF
C     UPDATED         --JUNE      1990.      TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --NOVEMBER  1993.      ALLOW SPACES AROUND /
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 ICASEQ
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ITYPE
      CHARACTER*4 IREPU
      CHARACTER*4 IRESU
      CHARACTER*4 IH2
      CHARACTER*4 IH
      CHARACTER*4 ICH
      CHARACTER*4 ICH1A
      CHARACTER*4 ICH2A
      CHARACTER*4 ICH1B
      CHARACTER*4 ICH2B
      CHARACTER*4 IHFACT
      CHARACTER*4 IHFAC2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION F1(MAXOBV)
      DIMENSION F2(MAXOBV)
      DIMENSION F3(MAXOBV)
      DIMENSION F4(MAXOBV)
C
      DIMENSION PRED2(MAXOBV)
      DIMENSION RES2(MAXOBV)
C
CCCCC DIMENSION W(MAXOBV)
C
      DIMENSION ITYPE(100)
      DIMENSION B1(100)
      DIMENSION B2(100)
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),F1(1))
      EQUIVALENCE (GARBAG(IGARB2),F2(1))
      EQUIVALENCE (GARBAG(IGARB3),F3(1))
      EQUIVALENCE (GARBAG(IGARB4),F4(1))
      EQUIVALENCE (GARBAG(IGARB5),PRED2(1))
      EQUIVALENCE (GARBAG(IGARB6),RES2(1))
      EQUIVALENCE (GARBAG(IGARB7),B1(1))
      EQUIVALENCE (GARBAG(IGARB7+100),B2(1))
CCCCC END CHANGE
      DIMENSION ICOLIV(10)
      DIMENSION NIV(10)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPEX'
      ISUBN2='AC  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      MINN2=2
      MAXFAC=4
C
C               **************************************************
C               **  TREAT THE EXACT RATIONAL FUNCTION FIT 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 DPEXAC--')
      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 ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.ICOM.EQ.'EXAC'.AND.
     1IHARG(2).EQ.'FIT ')GOTO112
C
      IF(NUMARG.GE.3.AND.ICOM.EQ.'EXAC'.AND.
     1IHARG(3).EQ.'FIT ')GOTO113
C
      IF(NUMARG.GE.4.AND.ICOM.EQ.'EXAC'.AND.
     1IHARG(4).EQ.'FIT ')GOTO114
C
      IF(NUMARG.GE.5.AND.ICOM.EQ.'EXAC'.AND.
     1IHARG(5).EQ.'FIT ')GOTO115
C
      IF(NUMARG.GE.6.AND.ICOM.EQ.'EXAC'.AND.
     1IHARG(6).EQ.'FIT ')GOTO116
C
      IFOUND='NO'
      GOTO9000
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  114 CONTINUE
      ILASTC=4
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  115 CONTINUE
      ILASTC=5
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  116 CONTINUE
      ILASTC=6
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(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 3--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO290
      DO200J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO210
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO210
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO220
  200 CONTINUE
      GOTO290
  210 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO290
  220 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO290
  290 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO295
      WRITE(ICOUT,291)NUMARG,ILOCQ
  291 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  295 CONTINUE
C
C               **************************************************************
C               **  STEP 5--                                                **
C               **  CHECK THE VALIDITY OF THE VARIABLES.                    **
C               **  CHECK THAT THERE ARE EXACTLY 2 OR EXACTLY 4 VARIABLES.  **
C               **  CHECK THE VALIDITY OF EACH OF THE VARIABLES.            **
C               **  DOES THE VARIABLE NAME EXIST IN THE TABLE?              **
C               **  IS THE NUMBER OF ELEMENTS FOR EACH VARIABLE POSITIVE?   **
C               **  DOES THE NUMBER OF ELEMENTS IN VARIABLE 2               **
C               **  AGREE WITH THE NUMBER OF ELEMENTS IN VARIABLE 1?        **
C               **  IF VARIABLES 3 AND 4 EXIST,                             **
C               **  DOES THE NUMBER OF ELEMENTS IN VARIABLE 4               **
C               **  AGREE WITH THE NUMBER OF ELEMENTS IN VARIABLE 3?        **
C               **************************************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMFAC=ILOCQ-1
      IF(1.LE.NUMFAC.AND.NUMFAC.LE.MAXFAC)GOTO509
      WRITE(ICOUT,501)
  501 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,502)
  502 FORMAT('      FOR AN EXACT RATIONAL FUNCTION FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,503)
  503 FORMAT('      THE NUMBER OF VARIABLES MUST BE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,504)
  504 FORMAT('      EXACTLY 2 OR EXACTLY 4;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,505)
  505 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,506)NUMFAC
  506 FORMAT('      THE SPECIFIED NUMBER OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,507)
  507 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,508)(IANS(I),I=1,IWIDTH)
  508 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  509 CONTINUE
C
      DO510IFAC=1,NUMFAC
      IHFACT=IHARG(IFAC)
      IHFAC2=IHARG2(IFAC)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHFACT,IHFAC2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLIV(IFAC)=IVALUE(ILOCV)
      NIV(IFAC)=IN(ILOCV)
      IF(IBUGA2.EQ.'ON')WRITE(ICOUT,665)IFAC,IHFACT,IHFAC2,ILOCV,
     1IVALUE(ILOCV)
  665 FORMAT('IFAC,IHFACT,IHFAC2,ILOCV,IVALUE(ILOCV) = ',
     1I8,2X,A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IBUGA2.EQ.'ON')WRITE(ICOUT,666)IFAC,IHFACT,IHFAC2,ICOLIV(IFAC),
     1NIV(IFAC)
  666 FORMAT('IFAC,IHFACT,IHFAC2,ICOLIV(IFAC),NIV(IFAC) = ',
     1I8,2X,A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      DO515IFAC=1,NUMFAC
      IF(NIV(IFAC).GE.1)GOTO515
      GOTO520
  515 CONTINUE
      NEXACT=NIV(1)
      GOTO529
C
  520 CONTINUE
      WRITE(ICOUT,521)
  521 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,522)
  522 FORMAT('      FOR AN EXACT RATIONAL FUNCTION FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,523)
  523 FORMAT('      ALL VARIABLES MUST HAVE AT LEAST 1 ELEMENT;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,524)
  524 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO525J=1,NUMFAC
      WRITE(ICOUT,526)IHARG(J),IHARG2(J),NIV(J)
  526 FORMAT('      VARIABLE ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
  525 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,527)
  527 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,528)(IANS(I),I=1,IWIDTH)
  528 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  529 CONTINUE
C
      IF(NUMFAC.LE.2.AND.NIV(2).EQ.NIV(1))GOTO549
      IF(NUMFAC.GE.3.AND.NIV(2).EQ.NIV(1).AND.NIV(4).EQ.NIV(3))GOTO549
      WRITE(ICOUT,531)
  531 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,532)
  532 FORMAT('      FOR AN EXACT RATIONAL FUNCTION FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,533)
  533 FORMAT('      THE NUMBER OF ELEMENTS IN VARIABLE 2 MUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,534)
  534 FORMAT('      EQUAL THE NUMBER OF ELEMENTS IN VARIABLE 1;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.GE.3)WRITE(ICOUT,536)
  536 FORMAT('      AND THE NUMBER OF ELEMENTS IN VARIABLE 4 MUST')
      IF(NUMFAC.GE.3)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.GE.3)WRITE(ICOUT,537)
  537 FORMAT('      EQUAL THE NUMBER OF ELEMENTS IN VARIABLE 3;')
      IF(NUMFAC.GE.3)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,538)
  538 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO545J=1,NUMFAC
      WRITE(ICOUT,546)IHARG(J),IHARG2(J),NIV(J)
  546 FORMAT('      VARIABLE ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
  545 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,547)
  547 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,548)(IANS(I),I=1,IWIDTH)
  548 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  549 CONTINUE
C
  590 CONTINUE
C
C               ***************************************
C               **  STEP 6--                         **
C               **  EXTRACT THE EXACT-FIT VARIABLES  **
C               ***************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      DO560I=1,NEXACT
      J=J+1
C
      IFAC=1
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F1(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F1(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F1(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F1(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F1(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F1(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F1(J)=TAGPLO(I)
C
      IFAC=2
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F2(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F2(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F2(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F2(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F2(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F2(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F2(J)=TAGPLO(I)
C
  560 CONTINUE
C
C               *********************************************
C               **  STEP 7--                               **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;     **
C               **  THEN FORM THE RESPONSE VARIABLE        **
C               **  AND THE FACTORS.                       **
C               *********************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMFAC.GE.3)N34=NIV(3)
C
      IF(NUMFAC.LE.2)NLEFT=NEXACT
      IF(NUMFAC.GE.3)NLEFT=N34
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
C
      IF(NUMFAC.LE.2)GOTO699
      J=0
      DO670I=1,NLEFT
      J=J+1
C
      IFAC=3
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F3(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F3(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F3(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F3(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F3(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F3(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F3(J)=TAGPLO(I)
C
      IFAC=4
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F4(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F4(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F4(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F4(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F4(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F4(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F4(J)=TAGPLO(I)
C
  670 CONTINUE
C
  699 CONTINUE
C
C               ****************************************
C               **  STEP 8--                          **
C               **  DETERMINE THE DEGREES             **
C               **  OF THE NUMERATOR AND DENOMINATOR  **
C               ****************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO700J=1,IWIDTH
      J2=J
      IF(IANS(J).EQ.'/')GOTO710
  700 CONTINUE
C
      WRITE(ICOUT,701)
  701 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,702)
  702 FORMAT('      NO    /    FOUND ON ENTERED COMMAND LINE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,703)
  703 FORMAT('      THEREFORE, DEGREE OF NUMERATOR UNKNOWN, AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,704)
  704 FORMAT('      DEGREE OF DENOMINATOR UNKNOWN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,705)
  705 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,706)(IANS(I),I=1,IWIDTH)
  706 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  710 CONTINUE
      J2M1=J2-1
      J2M2=J2-2
      IF(J2M1.GE.1)GOTO720
C
      WRITE(ICOUT,711)
  711 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,712)
  712 FORMAT('      THE LOCATED    /    WAS FOUND AS THE FIRST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,713)
  713 FORMAT('      CHARACTER OF THE ENTERED COMMAND LINE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,714)
  714 FORMAT('      THEREFORE, DEGREE OF NUMERATOR UNKNOWN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,715)
  715 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,716)(IANS(I),I=1,IWIDTH)
  716 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  720 CONTINUE
      ICH1B=IANS(J2M1)
      IF(J2M1.GE.2)ICH2B=IANS(J2M2)
      IF(J2M1.EQ.1)ICH2B=' '
C
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'0')GOTO750
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'1')GOTO751
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'2')GOTO752
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'3')GOTO753
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'4')GOTO754
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'5')GOTO755
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'6')GOTO756
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'7')GOTO757
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'8')GOTO758
      IF(ICH2B.EQ.' '.AND.ICH1B.EQ.'9')GOTO759
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'0')GOTO760
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'1')GOTO761
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'2')GOTO762
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'3')GOTO763
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'4')GOTO764
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'5')GOTO765
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'6')GOTO766
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'7')GOTO767
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'8')GOTO768
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.'9')GOTO769
      IF(ICH2B.EQ.'2'.AND.ICH1B.EQ.'0')GOTO770
CCCCC THE FOLLOWING 10 LINES WERE ADDED    NOVEMBER 1993
      IF(ICH2B.EQ.'0'.AND.ICH1B.EQ.' ')GOTO750
      IF(ICH2B.EQ.'1'.AND.ICH1B.EQ.' ')GOTO751
      IF(ICH2B.EQ.'2'.AND.ICH1B.EQ.' ')GOTO752
      IF(ICH2B.EQ.'3'.AND.ICH1B.EQ.' ')GOTO753
      IF(ICH2B.EQ.'4'.AND.ICH1B.EQ.' ')GOTO754
      IF(ICH2B.EQ.'5'.AND.ICH1B.EQ.' ')GOTO755
      IF(ICH2B.EQ.'6'.AND.ICH1B.EQ.' ')GOTO756
      IF(ICH2B.EQ.'7'.AND.ICH1B.EQ.' ')GOTO757
      IF(ICH2B.EQ.'8'.AND.ICH1B.EQ.' ')GOTO758
      IF(ICH2B.EQ.'9'.AND.ICH1B.EQ.' ')GOTO759
C
      WRITE(ICOUT,721)
  721 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,722)
  722 FORMAT('      FOR AN EXACT RATIONAL FUNCTION FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,723)
  723 FORMAT('      THE DEGREE FOR THE NUMERATOR MUST BE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,724)
  724 FORMAT('      BETWEEN 0 AND 20 (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE CHANGED     NOVEMBER 1993
      WRITE(ICOUT,725)ICH1B,ICH2B
  725 FORMAT('      SUCH WAS NOT THE CASE HERE.',A1,',',A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,726)
  726 FORMAT('      (REMINDER--THERE SHOULD BE NO BLANK')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,727)
  727 FORMAT('      BETWEEN THE DEGREE NUMBER AND THE /).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,728)
  728 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,729)(IANS(I),I=1,IWIDTH)
  729 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  750 IDEGN=0
      GOTO799
  751 IDEGN=1
      GOTO799
  752 IDEGN=2
      GOTO799
  753 IDEGN=3
      GOTO799
  754 IDEGN=4
      GOTO799
  755 IDEGN=5
      GOTO799
  756 IDEGN=6
      GOTO799
  757 IDEGN=7
      GOTO799
  758 IDEGN=8
      GOTO799
  759 IDEGN=9
      GOTO799
  760 IDEGN=10
      GOTO799
  761 IDEGN=11
      GOTO799
  762 IDEGN=12
      GOTO799
  763 IDEGN=13
      GOTO799
  764 IDEGN=14
      GOTO799
  765 IDEGN=15
      GOTO799
  766 IDEGN=16
      GOTO799
  767 IDEGN=17
      GOTO799
  768 IDEGN=18
      GOTO799
  769 IDEGN=19
      GOTO799
  770 IDEGN=20
      GOTO799
  799 CONTINUE
C
      J2P1=J2+1
      J2P2=J2+2
      IF(J2P1.LE.IWIDTH)GOTO820
C
      WRITE(ICOUT,811)
  811 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,812)
  812 FORMAT('      THE LOCATED    /    WAS FOUND AS THE LAST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,813)
  813 FORMAT('      CHARACTER OF THE ENTERED COMMAND LINE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,814)
  814 FORMAT('      THEREFORE, DEGREE OF DENOMINATOR UNKNOWN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,815)
  815 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,816)(IANS(I),I=1,IWIDTH)
  816 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  820 CONTINUE
      ICH1A=IANS(J2P1)
      IF(J2P1.GE.2)ICH2A=IANS(J2P2)
      IF(J2P1.EQ.1)ICH2A=' '
C
      IF(ICH1A.EQ.'0'.AND.ICH2A.EQ.' ')GOTO850
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.' ')GOTO851
      IF(ICH1A.EQ.'2'.AND.ICH2A.EQ.' ')GOTO852
      IF(ICH1A.EQ.'3'.AND.ICH2A.EQ.' ')GOTO853
      IF(ICH1A.EQ.'4'.AND.ICH2A.EQ.' ')GOTO854
      IF(ICH1A.EQ.'5'.AND.ICH2A.EQ.' ')GOTO855
      IF(ICH1A.EQ.'6'.AND.ICH2A.EQ.' ')GOTO856
      IF(ICH1A.EQ.'7'.AND.ICH2A.EQ.' ')GOTO857
      IF(ICH1A.EQ.'8'.AND.ICH2A.EQ.' ')GOTO858
      IF(ICH1A.EQ.'9'.AND.ICH2A.EQ.' ')GOTO859
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'0')GOTO860
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'1')GOTO861
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'2')GOTO862
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'3')GOTO863
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'4')GOTO864
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'5')GOTO865
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'6')GOTO866
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'7')GOTO867
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'8')GOTO868
      IF(ICH1A.EQ.'1'.AND.ICH2A.EQ.'9')GOTO869
      IF(ICH1A.EQ.'2'.AND.ICH2A.EQ.'0')GOTO870
CCCCC THE FOLLOWING 10 LINES WERE ADDED   NOVEMBER 1993
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'0')GOTO850
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'1')GOTO851
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'2')GOTO852
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'3')GOTO853
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'4')GOTO854
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'5')GOTO855
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'6')GOTO856
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'7')GOTO857
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'8')GOTO858
      IF(ICH1A.EQ.' '.AND.ICH2A.EQ.'9')GOTO859
C
      WRITE(ICOUT,821)
  821 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,822)
  822 FORMAT('      FOR AN EXACT RATIONAL FUNCTION FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,823)
  823 FORMAT('      THE DEGREE FOR THE DENOMINATOR MUST BE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,824)
  824 FORMAT('      BETWEEN 0 AND 20 (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE CHANGED     NOVEMBER 1993
      WRITE(ICOUT,825)ICH1A,ICH2A
  825 FORMAT('      SUCH WAS NOT THE CASE HERE.',A1,',',A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,826)
  826 FORMAT('      (REMINDER--THERE SHOULD BE NO BLANK')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,827)
  827 FORMAT('      BETWEEN THE DEGREE NUMBER AND THE /).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,828)
  828 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,829)(IANS(I),I=1,IWIDTH)
  829 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  850 IDEGD=0
      GOTO899
  851 IDEGD=1
      GOTO899
  852 IDEGD=2
      GOTO899
  853 IDEGD=3
      GOTO899
  854 IDEGD=4
      GOTO899
  855 IDEGD=5
      GOTO899
  856 IDEGD=6
      GOTO899
  857 IDEGD=7
      GOTO899
  858 IDEGD=8
      GOTO899
  859 IDEGD=9
      GOTO899
  860 IDEGD=10
      GOTO899
  861 IDEGD=11
      GOTO899
  862 IDEGD=12
      GOTO899
  863 IDEGD=13
      GOTO899
  864 IDEGD=14
      GOTO899
  865 IDEGD=15
      GOTO899
  866 IDEGD=16
      GOTO899
  867 IDEGD=17
      GOTO899
  868 IDEGD=18
      GOTO899
  869 IDEGD=19
      GOTO899
  870 IDEGD=20
      GOTO899
  899 CONTINUE
C
      K1=IDEGN+1
      K2=IDEGD+1
      K=K1+K2
      KM1=K-1
C
      IF(NEXACT.EQ.KM1)GOTO920
      WRITE(ICOUT,901)
  901 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,902)
  902 FORMAT('      FOR AN EXACT RATIONAL FUNCTION FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,903)
  903 FORMAT('      THE NUMBER OF ELEMENTS IN THE FIRST VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,904)
  904 FORMAT('      (THAT IS, THE NUMBER OF POINTS TO BE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,905)
  905 FORMAT('      EXACTLY FITTED) MUST =')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,906)
  906 FORMAT('      THE NUMBER OF COEFFICIENTS TO BE ESTIMATED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,907)
  907 FORMAT('      (THAT IS, MUST = (DEGREE OF NUMERATOR + 1) +')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,908)
  908 FORMAT('      (DEGREE OF DENOMINATOR + 1) - 1   );')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,909)
  909 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,910)NEXACT
  910 FORMAT('      NUMBER OF FIT POINTS FROM FIRST VARIABLE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,911)KM1
  911 FORMAT('      NUMBER OF ESTIMATED COEFFICIENTS         = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,912)IDEGN
  912 FORMAT('      DEGREE OF NUMERATOR                      = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,913)IDEGD
  913 FORMAT('      DEGREE OF DENOMINATOR                    = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,914)
  914 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,915)(IANS(I),I=1,IWIDTH)
  915 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  920 CONTINUE
      DO930I=1,K
      ITYPE(I)='U'
      B1(I)=999.0
  930 CONTINUE
      K1P1=K1+1
      ITYPE(K1P1)='K'
      B1(K1P1)=1.0
C
C               ************************************
C               **  STEP 9--                      **
C               **  CARRY OUT THE EXACT RATIONAL  **
C               **  FUNCTION FIT.                 **
C               ************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,681)
  681 FORMAT('***** FROM DPEXAC, AS WE ARE ABOUT TO CALL DPEXA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,682)NEXACT,MAXN,K1,K2,NUMFAC,N34,NLEFT
  682 FORMAT('NEXACT,MAXN,K1,K2,NUMFAC,N34,NLEFT = ',7I8)
      CALL DPWRST('XXX','BUG ')
      DO685I=1,NEXACT
      WRITE(ICOUT,686)I,F1(I),F2(I)
  686 FORMAT('I,F1(I),F2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
  685 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,687)IBUGA3
  687 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
  689 CONTINUE
C
      CALL DPEXA2(F1,F2,NEXACT,ITYPE,B1,K1,K2,IBUGA3,B2,IERROR)
C
C               ***************************************************
C               **  STEP 10--                                    **
C               **  IF A SECOND SET OF POINTS EXISTS             **
C               **  (THAT IS, IF VARIABLES 3 AND 4               **
C               **  HAVE BEEN SPECIFIED),                        **
C               **  THEN COMPUTE PREDICTED VALUES AND RESIDUALS  **
C               **  FOR THIS SECOND SET OF POINTS                **
C               **  BASED ON THE EXACT-FIT COEFFICIENTS          **
C               **  DERIVED FROM  THE FIRST SET OF POINTS        **
C               **  (THAT IS, FROM VARIABLES 1 AND 2).           **
C               ***************************************************
C
      ISTEPN='10'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC DO980I=1,NLEFT
CCCCC W(I)=1.0
CC980 CONTINUE
C
      DO1000I=1,NLEFT
C
      J=1
      ANUM=B2(J)
      IF(K1.LE.1)GOTO1150
      IF(NUMFAC.EQ.2)GOTO1120
      IF(NUMFAC.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      DO1125J=2,K1
      ANUM=ANUM+B2(J)*F2(I)**(J-1)
 1125 CONTINUE
      GOTO1150
C
 1140 CONTINUE
      DO1145J=2,K1
      ANUM=ANUM+B2(J)*F4(I)**(J-1)
 1145 CONTINUE
      GOTO1150
C
 1150 CONTINUE
C
      J=1
      K1PJ=K1+J
      ADEN=B2(K1PJ)
      IF(K2.LE.1)GOTO1250
      IF(NUMFAC.EQ.2)GOTO1220
      IF(NUMFAC.EQ.4)GOTO1240
      GOTO1250
C
 1220 CONTINUE
      DO1225J=2,K2
      K1PJ=K1+J
      ADEN=ADEN+B2(K1PJ)*F2(I)**(J-1)
 1225 CONTINUE
      GOTO1250
C
 1240 CONTINUE
      DO1245J=2,K2
      K1PJ=K1+J
      ADEN=ADEN+B2(K1PJ)*F4(I)**(J-1)
 1245 CONTINUE
      GOTO1250
C
 1250 CONTINUE
C
      PRED2(I)=ANUM/ADEN
      IF(NUMFAC.EQ.2)RES2(I)=F1(I)-PRED2(I)
      IF(NUMFAC.EQ.4)RES2(I)=F3(I)-PRED2(I)
 1000 CONTINUE
C
      IF(IBUGA2.EQ.'OFF')GOTO1390
      DO1380I=1,NLEFT
      WRITE(ICOUT,1381)I,F1(I),F2(I),F3(I),F4(I),PRED2(I),RES2(I)
 1381 FORMAT('I,F1(I),F2(I),F3(I),F4(I),PRED2(I),RES2(I) = ',
     1I8,6E10.3)
      CALL DPWRST('XXX','BUG ')
 1380 CONTINUE
 1390 CONTINUE
C
      SUM=0.0
      DO1500I=1,NLEFT
      SUM=SUM+RES2(I)**2
 1500 CONTINUE
      RESSS=SUM
      RESSD=0.0
      IRESDF=NLEFT-KM1
      RESDF=IRESDF
      IF(IRESDF.LE.0)GOTO1510
      RESV=RESSS/RESDF
      IF(RESV.GT.0.0)RESSD=SQRT(RESV)
      IF(RESV.LE.0.0)RESSD=0.0
 1510 CONTINUE
C
      ANLEFT=NLEFT
      SUM=0.0
      DO1600I=1,NLEFT
      SUM=SUM+ABS(RES2(I))
 1600 CONTINUE
      RESMA=SUM/ANLEFT
C
      AMAXR=RES2(1)
      AMINR=RES2(1)
      DO1700I=1,NLEFT
      IF(RES2(I).GT.AMAXR)AMAXR=RES2(I)
      IF(RES2(I).LT.AMINR)AMINR=RES2(I)
 1700 CONTINUE
      ABSMAX=ABS(AMAXR)
      ABSMIN=ABS(AMINR)
      ABSMM=ABSMAX
      IF(ABSMIN.GT.ABSMAX)ABSMM=ABSMIN
C
      IF(NUMFAC.EQ.2)GOTO1999
      IF(IPRINT.EQ.'OFF')GOTO1999
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1901)
 1901 FORMAT('      APPLICATION OF EXACT-FIT COEFFICIENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1902)
 1902 FORMAT('      TO SECOND PAIR OF VARIABLES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1903)NLEFT
 1903 FORMAT('      NUMBER OF POINTS IN SECOND SET           = ',
     1I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1904)KM1
 1904 FORMAT('      NUMBER OF ESTIMATED COEFFICIENTS         = ',
     1I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1905)IRESDF
 1905 FORMAT('      RESIDUAL DEGREES OF FREEDOM              = ',
     1I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1911)RESSS
 1911 FORMAT('      RESIDUAL SUM OF SQUARES                  = ',
     1E15.8)
      CALL DPWRST('XXX','BUG ')
      IF(IRESDF.GE.1)WRITE(ICOUT,1912)RESSD
 1912 FORMAT('      RESIDUAL STANDARD DEVIATION (DENOM=N-P)  = ',
     1E15.8)
      IF(IRESDF.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IRESDF.LE.0)WRITE(ICOUT,1913)RESSD
 1913 FORMAT('      RESIDUAL STANDARD DEVIATION              = ',
     1'UNDEFINED (SINCE NON-POSITIVE DEGREES OF FREEDOM)')
      IF(IRESDF.LE.0)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1914)RESMA
 1914 FORMAT('      AVERAGE ABSOLUTE RESIDUAL   (DENOM=N)    = ',
     1E15.8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1915)AMAXR
 1915 FORMAT('      LARGEST (IN MAGNITUDE) POSITIVE RESIDUAL = ',
     1E15.8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1916)AMINR
 1916 FORMAT('      LARGEST (IN MAGNITUDE) NEGATIVE RESIDUAL = ',
     1E15.8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1917)ABSMM
 1917 FORMAT('      LARGEST (IN MAGNITUDE) ABSOLUTE RESIDUAL = ',
     1E15.8)
      CALL DPWRST('XXX','BUG ')
 1999 CONTINUE
C
C               ***************************************
C               **  STEP 11--                        **
C               **  UPDATE DATAPLOT INTERNAL TABLES  **
C               ***************************************
C
 7000 CONTINUE
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLEFT=NLEFT
C
      ICOLPR=MAXCP1
      ICOLRE=MAXCP2
C
CCCCC IREPU='ON'  MARCH 1988
CCCCC IRESU='ON'  MARCH 1988
C     THE FOLLOWING CORRECTION WAS BASED ON
C     COMMENTS FROM DAVE EVANS     MARCH 1988
CCCCC IREPU='ON'
      IREPU='OFF'
      REPSD=(-999.99)
      REPDF=(-999.99)
      ALFCDF=(-999.99)
C
      IRESU='ON'
C
      CALL UPDAPR(ICOLPR,ICOLRE,PRED2,RES2,PRED,RES,ISUB,NLEFT,
     1IREPU,REPSD,REPDF,IRESU,RESSD,RESDF,ALFCDF,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,ILOCN,IBUGA3,IERROR)
C
      L=0
      DO7600J=1,K1
      L=L+1
      IH2='    '
      IF(J.EQ.1)IH='A0'
      IF(J.EQ.2)IH='A1'
      IF(J.EQ.3)IH='A2'
      IF(J.EQ.4)IH='A3'
      IF(J.EQ.5)IH='A4'
      IF(J.LE.5)GOTO7640
      IF(J.EQ.6)IH='A5'
      IF(J.EQ.7)IH='A6'
      IF(J.EQ.8)IH='A7'
      IF(J.EQ.9)IH='A8'
      IF(J.EQ.10)IH='A9'
      IF(J.LE.10)GOTO7640
      IF(J.EQ.11)IH='A10'
      IF(J.EQ.12)IH='A11'
      IF(J.EQ.13)IH='A12'
      IF(J.EQ.14)IH='A13'
      IF(J.EQ.15)IH='A14'
      IF(J.LE.15)GOTO7640
      IF(J.EQ.16)IH='A15'
      IF(J.EQ.17)IH='A16'
      IF(J.EQ.18)IH='A17'
      IF(J.EQ.19)IH='A18'
      IF(J.EQ.20)IH='A19'
      IF(J.LE.20)GOTO7640
      IF(J.EQ.21)IH='A20'
C
 7640 CONTINUE
      DO7650I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO7680
 7650 CONTINUE
      IF(NUMNAM.LT.MAXNAM)GOTO7670
      WRITE(ICOUT,7651)
 7651 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7652)
 7652 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7653)MAXNAM
 7653 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7654)
 7654 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7655)
 7655 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7656)
 7656 FORMAT('      WAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7657)
 7657 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7658)
 7658 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7659)
 7659 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7660)
 7660 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7661)
 7661 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7662)
 7662 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7663)(IANS(I),I=1,IWIDTH)
 7663 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 7670 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      VALUE(ILOC)=B2(L)
      GOTO7600
C
 7680 CONTINUE
      VALUE(I2)=B2(L)
      GOTO7600
C
 7600 CONTINUE
C
      DO7700J=1,K2
      L=L+1
      IH2='    '
      IF(J.EQ.1)IH='B0'
      IF(J.EQ.2)IH='B1'
      IF(J.EQ.3)IH='B2'
      IF(J.EQ.4)IH='B3'
      IF(J.EQ.5)IH='B4'
      IF(J.LE.5)GOTO7740
      IF(J.EQ.6)IH='B5'
      IF(J.EQ.7)IH='B6'
      IF(J.EQ.8)IH='B7'
      IF(J.EQ.9)IH='B8'
      IF(J.EQ.10)IH='B9'
      IF(J.LE.10)GOTO7740
      IF(J.EQ.11)IH='B10'
      IF(J.EQ.12)IH='B11'
      IF(J.EQ.13)IH='B12'
      IF(J.EQ.14)IH='B13'
      IF(J.EQ.15)IH='B14'
      IF(J.LE.15)GOTO7740
      IF(J.EQ.16)IH='B15'
      IF(J.EQ.17)IH='B16'
      IF(J.EQ.18)IH='B17'
      IF(J.EQ.19)IH='B18'
      IF(J.EQ.20)IH='B19'
      IF(J.LE.20)GOTO7740
      IF(J.EQ.21)IH='B20'
C
 7740 CONTINUE
      DO7750I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO7780
 7750 CONTINUE
      IF(NUMNAM.LT.MAXNAM)GOTO7770
      WRITE(ICOUT,7751)
 7751 FORMAT('***** ERROR IN DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7752)
 7752 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7753)MAXNAM
 7753 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7754)
 7754 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7755)
 7755 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7756)
 7756 FORMAT('      WAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7757)
 7757 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7758)
 7758 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7759)
 7759 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7760)
 7760 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7761)
 7761 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7762)
 7762 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7763)(IANS(I),I=1,IWIDTH)
 7763 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 7770 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      VALUE(ILOC)=B2(L)
      GOTO7700
C
 7780 CONTINUE
      VALUE(I2)=B2(L)
      GOTO7700
C
 7700 CONTINUE
C
C               ***************************************
C               **  STEP 12--                        **
C               **  ENTER THE FORTRAN EXPRESSION     **
C               **  FOR THE RATIONAL FUNCTION MODEL  **
C               **  INTO MODEL(.)                    **
C               **  FOR FURTHER USE                  **
C               **  VIA THE    FIT    COMMAND.       **
C               ***************************************
C
 8000 CONTINUE
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      I=0
      I=I+1
      MODEL(I)='Y'
      I=I+1
      MODEL(I)='='
      I=I+1
      MODEL(I)='('
C
      DO8100J=1,K1
      IF(J.EQ.1)GOTO8110
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='+'
 8110 CONTINUE
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='A'
      IF(J.EQ.1)ICH='0'
      IF(J.EQ.2)ICH='1'
      IF(J.EQ.3)ICH='2'
      IF(J.EQ.4)ICH='3'
      IF(J.EQ.5)ICH='4'
      IF(J.LE.5)GOTO8120
      IF(J.EQ.6)ICH='5'
      IF(J.EQ.7)ICH='6'
      IF(J.EQ.8)ICH='7'
      IF(J.EQ.9)ICH='8'
      IF(J.EQ.10)ICH='9'
      IF(J.LE.10)GOTO8120
      IF(J.EQ.11)ICH='0'
      IF(J.EQ.12)ICH='1'
      IF(J.EQ.13)ICH='2'
      IF(J.EQ.14)ICH='3'
      IF(J.EQ.15)ICH='4'
      IF(J.LE.15)GOTO8120
      IF(J.EQ.16)ICH='5'
      IF(J.EQ.17)ICH='6'
      IF(J.EQ.18)ICH='7'
      IF(J.EQ.19)ICH='8'
      IF(J.EQ.20)ICH='9'
      IF(J.LE.20)GOTO8120
      IF(J.EQ.21)ICH='0'
C
 8120 CONTINUE
      IF(J.LE.20)GOTO8130
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='2'
 8130 CONTINUE
      IF(J.LE.10)GOTO8140
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='1'
 8140 CONTINUE
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)=ICH
      IF(J.LE.1)GOTO8100
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='*'
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='X'
      IF(J.LE.2)GOTO8100
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='*'
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='*'
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='ICH'
 8100 CONTINUE
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)=')'
C
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='/'
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='('
C
      DO8200J=1,K2
      IF(J.EQ.1)GOTO8210
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='+'
 8210 CONTINUE
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='B'
      IF(J.EQ.1)ICH='0'
      IF(J.EQ.2)ICH='1'
      IF(J.EQ.3)ICH='2'
      IF(J.EQ.4)ICH='3'
      IF(J.EQ.5)ICH='4'
      IF(J.LE.5)GOTO8220
      IF(J.EQ.6)ICH='5'
      IF(J.EQ.7)ICH='6'
      IF(J.EQ.8)ICH='7'
      IF(J.EQ.9)ICH='8'
      IF(J.EQ.10)ICH='9'
      IF(J.LE.10)GOTO8220
      IF(J.EQ.11)ICH='0'
      IF(J.EQ.12)ICH='1'
      IF(J.EQ.13)ICH='2'
      IF(J.EQ.14)ICH='3'
      IF(J.EQ.15)ICH='4'
      IF(J.LE.15)GOTO8220
      IF(J.EQ.16)ICH='5'
      IF(J.EQ.17)ICH='6'
      IF(J.EQ.18)ICH='7'
      IF(J.EQ.19)ICH='8'
      IF(J.EQ.20)ICH='9'
      IF(J.LE.20)GOTO8220
      IF(J.EQ.21)ICH='0'
C
 8220 CONTINUE
      IF(J.LE.20)GOTO8230
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='2'
 8230 CONTINUE
      IF(J.LE.10)GOTO8240
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='1'
 8240 CONTINUE
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)=ICH
      IF(J.LE.1)GOTO8200
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='*'
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='X'
      IF(J.LE.2)GOTO8200
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='*'
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='*'
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)='ICH'
 8200 CONTINUE
      I=I+1
      IF(I.GT.80)GOTO8150
      MODEL(I)=')'
      NUMCHA=I
      GOTO8290
C
 8150 CONTINUE
      WRITE(ICOUT,8251)
 8251 FORMAT('***** NOTE FROM DPEXAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8252)
 8252 FORMAT('      THE FORTRAN EXPRESSION FOR THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8253)
 8253 FORMAT('      RATIONAL FUNCTION THAT WAS BEING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8254)
 8254 FORMAT('      AUTOMATICALLY ENTERED INTO AN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8255)
 8255 FORMAT('      INTERNAL DATAPLOT ARRAY NAMED MODEL(.)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8256)
 8256 FORMAT('      WAS NOT COMPLETED DUE TO THE FACT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8257)
 8257 FORMAT('      THAT THE FORTRAN EXPRESSION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8258)
 8258 FORMAT('      FOR THIS RATIONAL FUNCTION IS IN EXCESS OF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8259)
 8259 FORMAT('      THE ARRAY LIMIT OF 80 CHARACTERS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8260)
 8260 FORMAT('      (NOTE--THIS DOES NOT AFFECT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8261)
 8261 FORMAT('      THE VALIDITY OF THE PRECEEDING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8262)
 8262 FORMAT('      EXACT RATIONAL FUNCTION FIT.)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8263)
 8263 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,8264)(IANS(I),I=1,IWIDTH)
 8264 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
C
 8290 CONTINUE
C
      GOTO9000
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 DPEXAC--')
      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)NEXACT,N34,K1,K2,NLEFT
 9014 FORMAT('NEXACT,N34,K1,K2,NLEFT = ',5I8)
      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 DPEXIN(IHARG,IARGT,IARG,NUMARG,ISTART,ISTOP,
     1MININT,MAXINT,
     1ITAB,NTAB,MAXTAB,
     1IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--SCAN THE ARGUMENTS IN IHARG(.)
C              AND EXTRACT THE INTEGER SEQUENCES
C              ALLOWING FOR THE USE OF THE   TO   CONNECTOR
C              TO IMPLY ALL  INTERMEDIATE INTEGERS.
C     EXAMPLE--12 9 4 2 (IN THE INPUT VECTOR IHARG(.))
C              WOULD BECOME
C              12 9 4 2 (IN THE OUTPUT VECTOR ITAB(.))
C     EXAMPLE--12 TO 9 6 4 TO 2 (IN THE INPUT VECTOR IHARG(.))
C              WOULD BECOME
C              12 11 10 9 6 4 3 2 (IN THE OUTPUT VECTOR ITAB(.))
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--APRIL     1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ITAB(*)
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ITOSW
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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='DPEX'
      ISUBN2='IN  '
C
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXIN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO59
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),IARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),IARG(I) = ',I8,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   59 CONTINUE
      WRITE(ICOUT,61)ISTART,ISTOP
   61 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)MININT,MAXINT
   62 FORMAT('MININT,MAXINT = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)MAXTAB
   63 FORMAT('MAXTAB = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************
C               **  STEP 11--                       **
C               **  INITIALIZE THE OUTPUT VARIABLES **
C               **************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXIN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NTAB=0
      DO1100I=1,MAXTAB
      ITAB(I)=(-999)
 1100 CONTINUE
C
      IF(NUMARG.LE.0)GOTO9000
C
C               *******************************************
C               **  STEP 12--                            **
C               **  CHECK THE INPUT ARGUMENTS            **
C               *******************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXIN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTART.GE.1.AND.ISTOP.GE.1.AND.
     1   ISTART.LE.NUMARG.AND.ISTOP.LE.NUMARG)GOTO1219
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      ISTART OR ISTOP IS < 1 OR > NUMARG   .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)ISTART
 1213 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)ISTOP
 1214 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)NUMARG
 1215 FORMAT('      NUMARG  = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1219 CONTINUE
C
      IF(ISTART.LE.ISTOP)GOTO1229
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** ERROR IN DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)
 1222 FORMAT('      ISTART IS GREATER THAN ISTOP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)ISTART
 1223 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1224)ISTOP
 1224 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1229 CONTINUE
C
      IF(MININT.GE.1.AND.MAXINT.GE.1.AND.
     1   MININT.LE.MAXTAB.AND.MAXINT.LE.MAXTAB)GOTO1239
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1231)
 1231 FORMAT('***** ERROR IN DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1232)
 1232 FORMAT('      MININT OR MAXINT IS < 1 OR > MAXTAB   .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1233)MININT
 1233 FORMAT('      MININT  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1234)MAXINT
 1234 FORMAT('      MAXINT   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1235)MAXTAB
 1235 FORMAT('      MAXTAB  = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1239 CONTINUE
C
      IF(MININT.LE.MAXINT)GOTO1249
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1241)
 1241 FORMAT('***** ERROR IN DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1242)
 1242 FORMAT('      MININT IS GREATER THAN MAXINT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1243)MININT
 1243 FORMAT('      MININT  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1244)MAXINT
 1244 FORMAT('      MAXINT   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1249 CONTINUE
C
      DO1250I=ISTART,ISTOP
      I2=I
      IF(IARGT(I).EQ.'NUMB')GOTO1250
      IF(IHARG(I).EQ.'TO  ')GOTO1250
      GOTO1260
 1250 CONTINUE
      GOTO1269
C
 1260 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1261)
 1261 FORMAT('***** ERROR IN DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1262)
 1262 FORMAT('      AN ERROR OCCURRED IN PARSING A SEQUENCE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1263)
 1263 FORMAT('      IN SUCH A SEQUENCE, EVERY WORD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1264)
 1264 FORMAT('      MUST BE A PRE-EXISTING PARAMETER, OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1265)
 1265 FORMAT('      MUST BE THE WORD   TO    .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1266)
 1266 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1267)IHARG(I2)
 1267 FORMAT('      THE OFFENDING WORD WAS ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1268)I2,IARGT(I2),IARG(I2)
 1268 FORMAT('      I2,IARGT(I2),IARG(I2) = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1269 CONTINUE
C
      DO1270I=ISTART,ISTOP
      I2=I
      IF(IHARG(I).EQ.'TO  ')GOTO1270
      IX=IARG(I2)
      IF(MININT.LE.IX.AND.IX.LE.MAXINT)GOTO1270
      GOTO1280
 1270 CONTINUE
      GOTO1299
C
 1280 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('***** ERROR IN DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)
 1282 FORMAT('      AN ERROR OCCURRED IN PARSING A SEQUENCE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1283)
 1283 FORMAT('      IN SUCH A SEQUENCE, EVERY PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1284)MININT
 1284 FORMAT('      MUST BE BETWEEN ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1285)MAXINT
 1285 FORMAT('      AND ',I8,' (INCLUSIVE).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1286)
 1286 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1287)I2
 1287 FORMAT('      ARGUMENT ',I8,' WAS OUT-OF-BOUNDS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1288)IHARG(I2)
 1288 FORMAT('      THE ARGUMENT       = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1289)IX
 1289 FORMAT('      ITS VALUE          = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1290)MININT
 1290 FORMAT('      ALLOWABLE MINIMUM  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1291)MAXINT
 1291 FORMAT('      ALLOWABLE MAXIMUM  = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1299 CONTINUE
C
      I=ISTART
      I2=I
      IF(IHARG(I).EQ.'TO  ')GOTO1310
      GOTO1319
 1310 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      AN ERROR OCCURRED IN PARSING A SEQUENCE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      THE FIRST WORD IN THE SEQUENCE WAS   TO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1314)I2,ISTART
 1314 FORMAT('I2,ISTART = ',2I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1319 CONTINUE
C
      I=ISTOP
      I2=I
      IF(IHARG(I).EQ.'TO  ')GOTO1320
      GOTO1329
 1320 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('***** ERROR IN DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1322)
 1322 FORMAT('      AN ERROR OCCURRED IN PARSING A SEQUENCE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1323)
 1323 FORMAT('      THE LAST WORD IN THE SEQUENCE WAS   TO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1324)I2,ISTART
 1324 FORMAT('I2,ISTART = ',2I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1329 CONTINUE
C
C               ************************************
C               **  STEP 21--                     **
C               **  GENERATE THE SEQUENCE         **
C               ************************************
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXIN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ITOSW='OFF'
      K=0
      NTAB=0
      DO2100I=ISTART,ISTOP
      IF(IHARG(I).EQ.'TO  ')GOTO2110
      IF(ITOSW.EQ.'ON')GOTO2120
      GOTO2130
C
 2110 CONTINUE
      ITOSW='ON'
      GOTO2100
C
 2120 CONTINUE
      IV2=IARG(I)
      IF(IV1.LT.IV2)GOTO2121
      GOTO2126
 2121 CONTINUE
      DO2122J=IV1,IV2
      IF(J.EQ.IV1)GOTO2122
      K=K+1
      IF(K.GT.MAXTAB)GOTO2180
      ITAB(K)=J
 2122 CONTINUE
      GOTO2129
 2126 CONTINUE
      DO2127J=IV2,IV1
      IF(J.EQ.IV2)GOTO2127
      JREV=IV1-J+IV2
      K=K+1
      IF(K.GT.MAXTAB)GOTO2180
      ITAB(K)=JREV
 2127 CONTINUE
      GOTO2129
 2129 CONTINUE
      ITOSW='OFF'
      GOTO2100
C
 2130 CONTINUE
      K=K+1
      IF(K.GT.MAXTAB)GOTO2180
      IV1=IARG(I)
      ITAB(K)=IV1
      GOTO2100
C
 2100 CONTINUE
      NTAB=K
      GOTO9000
C
 2180 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2181)
 2181 FORMAT('***** ERROR IN DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2182)
 2182 FORMAT('      AN ERROR OCCURRED IN FORMING A SEQUENCE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2183)
 2183 FORMAT('      THE NUMBER OF ELEMENTS RESULTING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2184)
 2184 FORMAT('      FROM FORMING SUCH A SEQUENCE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2185)MAXTAB
 2185 FORMAT('      MUST NOT EXCEED ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2186)
 2186 FORMAT('      BUT JUST HAS.')
      CALL DPWRST('XXX','BUG ')
      KM1=K-1
      WRITE(ICOUT,2187)KM1,ITAB(KM1)
 2187 FORMAT('      KM1,ITAB(KM1) = ',2I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 2189 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXIN')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,ISUBRO,IERROR
 9013 FORMAT('IBUGS2,ISUBRO,IERROR = ',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)GOTO9019
      DO9015I=1,NUMARG
      WRITE(ICOUT,9016)I,IHARG(I),IARGT(I),IARG(I)
 9016 FORMAT('I,IHARG(I),IARGT(I),IARG(I) = ',I8,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)ISTART,ISTOP
 9021 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)MININT,MAXINT
 9022 FORMAT('MININT,MAXINT = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NTAB,MAXTAB
 9031 FORMAT('NTAB,MAXTAB = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NTAB.LE.0)GOTO9039
      DO9032I=1,NTAB
      WRITE(ICOUT,9033)I,ITAB(I)
 9033 FORMAT('I,ITAB(I) = ',2I8)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9039 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXIT(IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--EXIT FROM DATAPLOT.
C     NOTE--IN THE PROCESS OF EXITING, CERTAIN FILE OPERATIONS
C           MUST BE DONE TO KEEP FILES TIDY.
C           IN PARTICULAR, CLOSE NO FILES PER SE,
C           BUT DO PUT END OF FILE MARKS ON SOME FILES.
C           FOR MOST FILES, NOTHING AT ALL NEED BE DONE.
C     NOTE--FOR ANY FILES THAT ARE ALREADY CLOSED
C           (E.G., THE DATAPLOT PERMANENT FILES
C           SUCH AS MESSAGE, NEWS, HELP, ETC.,
C           PLUS OTHER FILES SUCH AS SAVE, LIST, ETC.)--
C           DO NOTHING.
C     NOTE--FOR ANY FILES THAT ARE OPEN
C           AND MAY HAVE HAD WRITING GO INTO THE FILE,
C           (E.G., THE WRITE FILE, THE PLOT1-FILE,
C           THE PLOT-2 FILE, ETC.)--
C           PUT AN END OF FILE, BUT DO NOT CLOSE IT.
C     NOTE--ON SOME COMPUTER SYSTEMS, CLOSING A FILE--
C           ESPECIALLY A 'TEMPORARY' FILE--HAS THE
C           EFFECT OF DELETING THE FILE FROM THE SYSTEM
C           WHICH MEANS THE USER HAS NO ACCESS TO IT
C           AFTER EXITING OUT OF DATAPLOT.  THIS IS
C           COUNTER-PRODUCTIVE FOR SOME OF THE
C           DATAPLOT-CREATED FILES SUCH AS THE PLOT-1
C           FILE, THE PLOT-2 FILE, AND THE CONCLUSIONS FILE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --APRIL     1979.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1986.
C     UPDATED         --FEBRUARY  1989.  CALL GREXIT  (ALAN HECKERT))
C     UPDATED         --AUGUST    1986.  CLOSE & EXIT WINDOW SYSTEM
C     UPDATED         --AUGUST    1986.  WINDOW SYSTEM COMMON
C     UPDATED         --JULY      1991.  COMMENT OUT WINDOW SYS.
C     UPDATED         --APRIL     1992.  FIX PC DEVICE 2 CLOSE EXIT BOMB
C     UPDATED         --MAY       1992.  ADD ----- TO OUTPUT
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --FEBRUARY  2006.  ONLY CALL GREXIT IF DEVICE
C                                        POWER IS ON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
CCCCC CHARACTER*4 IENDFI
CCCCC CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IPOWER
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOGR.INC'
CCCCC THE FOLLOWING WINDOW SYSTEM COMMON WAS ADDED AUGUST 1990
      INCLUDE 'DPCOWI.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='DPEX'
      ISUBN2='IT  '
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXIT')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO
   52 FORMAT('IBUGS2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IHOST1,IHOST2,ISITE
   53 FORMAT('IHOST1,IHOST2,ISITE = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IWRINU,IWRIST,IWRICS
   61 FORMAT('IWRINU,IWRIST,IWRICS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IWRINA
   62 FORMAT('IWRINA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ICRENU,ICREST,ICRECS
   63 FORMAT('ICRENU,ICREST,ICRECS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ICRENA
   64 FORMAT('ICRENA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IPL1NU,IPL1ST,IPL1CS
   71 FORMAT('IPL1NU,IPL1ST,IPL1CS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IPL1NA
   72 FORMAT('IPL1NA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IPL2NU,IPL2ST,IPL2CS
   73 FORMAT('IPL2NU,IPL2ST,IPL2CS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IPL2NA
   74 FORMAT('IPL2NA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)ICONNU,ICONST,ICONCS
   75 FORMAT('ICONNU,ICONST,ICONCS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)ICONNA
   76 FORMAT('ICONNA = ',A80)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
CCCCC THE FOLLOWING ENTIRE SECTION (DECTION 20) WAS INSERTED (FEBRUARY 1989)
CCCCC BY ALAN BECAUSE SOME DEVICES, NAMELY LASER PRINTERS,   (FEBRUARY 1989)
CCCCC MAY NEED A "TERMINATE" ROUTINE                         (FEBRUARY 1989)
C
C               ********************************************
C               **  STEP 20--                             **
C               **  CALL GREXIT FOR EACH DEVICE           **
C               ********************************************
C
      ISTEPN='20'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1000IDEV=1,NUMDEV
CCCCC THE FOLLOWING 2 LINES WERE ADDED    APRIL 1992 (ALAN)
CCCCC TO PREVENT PC EXIT BOMB             APRIL 1992 (ALAN)
CCCCC AFTER     DEVICE 2 CLOSE            APRIL 1992 (ALAN)
      IF(IDEV.EQ.2.AND.IPL1CS.EQ.'CLOSED')GOTO1000
      IF(IDEV.EQ.3.AND.IPL2CS.EQ.'CLOSED')GOTO1000
      IPOWER=IDPOWE(IDEV)
      IMANUF=IDMANU(IDEV)
      IMODEL=IDMODE(IDEV)
      IMODE2=IDMOD2(IDEV)
      IMODE3=IDMOD3(IDEV)
      IGCODE=IDCODE(IDEV)
      IGUNIT=IDUNIT(IDEV)
      NUMHPP=IDNHPP(IDEV)
      ANUMHP=NUMHPP
      NUMVPP=IDNVPP(IDEV)
      ANUMVP=NUMVPP
      IGCOLO=IDCOLO(IDEV)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEV)
      IGBAUD=IDBAUD(IDEV)
      ISOFT=IDSOFT(IDEV)
      ISOFT2=IDSOF2(IDEV)
      ISOFT3=IDSOF3(IDEV)
      IF(IPOWER.EQ.'ON')CALL GREXIT
 1000 CONTINUE
C
C               ********************************************
C               **  STEP 21--                             **
C               **  IF THE WRITE FILE IS STILL OPEN,      **
C               **  PUT AN    END OF FILE    ON IT.       **
C               ********************************************
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=IWRINU
      IFILE=IWRINA
      ISTAT=IWRIST
      IFORM=IWRIFO
      IACCES=IWRIAC
      IPROT=IWRIPR
      ICURST=IWRICS
      ISUBN0='EXIT'
      IERRFI='NO'
C
      IF(ISTAT.EQ.'NONE')GOTO2190
      IF(ICURST.EQ.'CLOSED')GOTO2190
      ENDFILE IOUNIT
 2190 CONTINUE
C
C               ********************************************
C               **  STEP 22--                             **
C               **  IF THE MACRO FILE IS STILL OPEN,      **
C               **  PUT AN    END OF FILE    ON IT.       **
C               ********************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ICRENU
      IFILE=ICRENA
      ISTAT=ICREST
      IFORM=ICREFO
      IACCES=ICREAC
      IPROT=ICREPR
      ICURST=ICRECS
      ISUBN0='EXIT'
      IERRFI='NO'
C
      IF(ISTAT.EQ.'NONE')GOTO2290
      IF(ICURST.EQ.'CLOSED')GOTO2290
      ENDFILE IOUNIT
 2290 CONTINUE
C
C               ********************************************
C               **  STEP 23--                             **
C               **  IF THE PLOT-1 FILE IS STILL OPEN,     **
C               **  PUT AN    END OF FILE    ON IT.       **
C               ********************************************
C
      ISTEPN='23'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=IPL1NU
      IFILE=IPL1NA
      ISTAT=IPL1ST
      IFORM=IPL1FO
      IACCES=IPL1AC
      IPROT=IPL1PR
      ICURST=IPL1CS
      ISUBN0='EXIT'
      IERRFI='NO'
C
      IF(ISTAT.EQ.'NONE')GOTO2390
      IF(ICURST.EQ.'CLOSED')GOTO2390
      ENDFILE IOUNIT
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED MAY 1992 (JJF)
      WRITE(ICOUT,2310)
 2310 FORMAT('-----------------------------------------------')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('NOTE--DEVICE 2 (A FILE CONTAINING PLOT IMAGES) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      HAS JUST BEEN CLOSED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2313)IOUNIT
 2313 FORMAT('      FILE NUMBER = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)IFILE
 2314 FORMAT('      FILE NAME   = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('NOTE--TO EXAMINE THE FILE, USE ANY EDITOR,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2317)
 2317 FORMAT('      AND SIMPLY PRINT THE FILE CONTENTS.')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1992 (JJF)
      WRITE(ICOUT,2310)
      CALL DPWRST('XXX','BUG ')
C
      IF(ISITE.EQ.'NBS'.AND.IHOST1.EQ.'VAX')GOTO2320
      GOTO2339
 2320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2321)
 2321 FORMAT('NOTE--IF THIS FILE CONTAINS TEKTRONIX 4014 IMAGES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2322)
 2322 FORMAT('      THEN  TO SEND THIS FILE TO THE LASER PRINTER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2323)
 2323 FORMAT('      ENTER     LPLOT DPPL1F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 2339 CONTINUE
C
 2390 CONTINUE
C
C               ********************************************
C               **  STEP 24--                             **
C               **  IF THE PLOT-2 FILE IS STILL OPEN,     **
C               **  PUT AN    END OF FILE    ON IT.       **
C               ********************************************
C
      ISTEPN='24'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=IPL2NU
      IFILE=IPL2NA
      ISTAT=IPL2ST
      IFORM=IPL2FO
      IACCES=IPL2AC
      IPROT=IPL2PR
      ICURST=IPL2CS
      ISUBN0='EXIT'
      IERRFI='NO'
C
      IF(ISTAT.EQ.'NONE')GOTO2490
      IF(ICURST.EQ.'CLOSED')GOTO2490
      ENDFILE IOUNIT
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED MAY 1992 (JJF)
      WRITE(ICOUT,2410)
 2410 FORMAT('-----------------------------------------------')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2411)
 2411 FORMAT('NOTE--DEVICE 3 (A FILE CONTAINING PLOT IMAGES) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2412)
 2412 FORMAT('      HAS JUST BEEN CLOSED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2413)IOUNIT
 2413 FORMAT('      FILE NUMBER = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2414)IFILE
 2414 FORMAT('      FILE NAME   = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2416)
 2416 FORMAT('NOTE--TO EXAMINE THE FILE, USE ANY EDITOR,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2417)
 2417 FORMAT('      AND SIMPLY PRINT THE FILE CONTENTS.')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1992 (JJF)
      WRITE(ICOUT,2410)
      CALL DPWRST('XXX','BUG ')
C
      IF(ISITE.EQ.'NBS'.AND.IHOST1.EQ.'VAX')GOTO2420
      GOTO2439
 2420 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2421)
 2421 FORMAT('NOTE--IF THIS FILE CONTAINS TEKTRONIX 4014 IMAGES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2422)
 2422 FORMAT('      THEN  TO SEND THIS FILE TO THE LASER PRINTER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2423)
 2423 FORMAT('      ENTER     LPLOT DPPL2F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 2439 CONTINUE
C
 2490 CONTINUE
C
C               ********************************************
C               **  STEP 25--                             **
C               **  IF THE CONCLUSIONS FILE IS STILL OPEN,**
C               **  PUT AN    END OF FILE    ON IT.       **
C               ********************************************
C
      ISTEPN='25'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXIT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ICONNU
      IFILE=ICONNA
      ISTAT=ICONST
      IFORM=ICONFO
      IACCES=ICONAC
      IPROT=ICONPR
      ICURST=ICONCS
      ISUBN0='EXIT'
      IERRFI='NO'
C
      IF(ISTAT.EQ.'NONE')GOTO2590
      IF(ICURST.EQ.'CLOSED')GOTO2590
      ENDFILE IOUNIT
 2590 CONTINUE
C
C               ***************************
C               **  STEP 80--            **
C               **  WRITE OUT A MESSAGE  **
C               ***************************
C
 8000 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('THIS IS AN EXIT FROM DATAPLOT.')
      CALL DPWRST('XXX','BUG ')
C
CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1990
C               ***********************************
C               **  IF IN A WINDOW SYSTEM,       **
C               **  CLOSE THE WINDOW, AND        **
C               **  EXIT FROM THE WINDOW SYSTEM  **
C               ***********************************
C
CCCCC THE FOLLOWING WAS COMMENTED OUT IN JULY 1991   JJF
C
CCCCC IF(IWINSY.EQ.'NONE')GOTO8190
CCCCC CALL WISEWI(1)
CCCCC CALL WICLWI('OFF ','OFF ')
CCCCC CALL WIEXWS('OFF ')
C8190 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXIT')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO
 9012 FORMAT('IBUGS2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IHOST1,IHOST2,ISITE
 9013 FORMAT('IHOST1,IHOST2,ISITE = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IWRINU,IWRIST,IWRICS
 9021 FORMAT('IWRINU,IWRIST,IWRICS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IWRINA
 9022 FORMAT('IWRINA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ICRENU,ICREST,ICRECS
 9023 FORMAT('ICRENU,ICREST,ICRECS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ICRENA
 9024 FORMAT('ICRENA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IPL1NU,IPL1ST,IPL1CS
 9031 FORMAT('IPL1NU,IPL1ST,IPL1CS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IPL1NA
 9032 FORMAT('IPL1NA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)IPL2NU,IPL2ST,IPL2CS
 9033 FORMAT('IPL2NU,IPL2ST,IPL2CS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IPL2NA
 9034 FORMAT('IPL2NA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)ICONNU,ICONST,ICONCS
 9035 FORMAT('ICONNU,ICONST,ICONCS = ',I8,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)ICONNA
 9036 FORMAT('ICONNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)IFOUND,IERROR
 9041 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      STOP
      END
      SUBROUTINE DPEXEC(IANSEX,IWIDEX,IBUGMA,IFOUND,IERROR)
C
C     PURPOSE--TRANSFORM THE STRING (WITH ALL SUBSTITUTIONS MADE)
C              FOR THE    EXECUTE STRING   COMMAND
C     INPUT  --A COMMAND LINE STARTING WITH    EXECUTE STRING
C              (THIS COMMAND LINE IS IN IANS(.)--IN COMMON)
C     OUTPUT --A TRANSFORMED COMMAND LINE IN WHICH THE 2 LEAD WORDS
C              EXECUTE STRING   HAVE BEEN DELETED,
C              AND THE TRAILING WORDS BECOME THE NEW COMMAND LINE.
C              NOTE ALSO THAT IF ANY OF THE TRAILING WORDS ARE FUNCTION
C              (= STRING) NAMES, THEN THE WORDS THEMSELVES WILL HAVE BEEN
C              REPLACED BY THE STRINGS.
C              (THE OUTPUT STRING IS IN IANSEX(.))
C     EXAMPLE--LET FUNCTION F = CALIBRATION ANALYSIS
C              EXECUTE STRING TITLE F
C                 WILL RESULT IN THE FOLLOWING COMMAND LINE--
C              TITLE CALIBRATION ANALYSIS
C                 BEING EXECUTED.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--85/7
C     ORIGINAL VERSION--JULY      1985.
C     UPDATED         --FEBRUARY  1994. CHECK FOR X CHART, X CONTROL CHART
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*1 IANSEX
C
      CHARACTER*4 IBUGMA
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASE
      CHARACTER*4 IF4
C
      CHARACTER*4 IWD1
      CHARACTER*4 IWD2
      CHARACTER*4 IWD12
      CHARACTER*4 IWD22
      CHARACTER*4 IFOUN1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IANSEX(*)
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='DPEX'
      ISUBN2='EC  '
C
      IFOUND='NO'
      IERROR='NO'
      ICASE='NONE'
      IFOUN1='NO'
C
C               ******************************************
C               **  TREAT THE    EXECUTE STRING   CASE  **
C               ******************************************
C
      IF(IBUGMA.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXEC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGMA,IFOUND,IERROR
   52 FORMAT('IBUGMA,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMNAM
   53 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMNAM
      WRITE(ICOUT,56)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
   56 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1I8,2X,A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)NUMCHF,MAXCHF
   57 FORMAT('NUMCHF,MAXCHF = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)(IFUNC(I),I=1,MAXCHF)
   60 FORMAT('IFUNC(.)  = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IWIDTH,MAXWID
   61 FORMAT('IWIDTH,MAXWID = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)(IANS(I),I=1,IWIDTH)
   62 FORMAT('(IANS(.) = ',110A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 11--                   **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='11'
      IF(IBUGMA.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWIDEX=(-999)
      MAXN2=MAXCHF
      MAXN3=MAXCHF
C
      DO1100I=1,1000
      IANSEX(I)=' '
 1100 CONTINUE
C
C               ***********************************************************
C               **  STEP 12--                                            **
C               **  CHECK TO SEE IF HAVE THE   EXECUTE STRING   COMMAND  **
C               ***********************************************************
C
      ISTEPN='12'
      IF(IBUGMA.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IWIDTH.EQ.1.AND.
     1IANS(1).EQ.'X')GOTO1210
C
      IF(IWIDTH.GE.2.AND.
     1IANS(1).EQ.'X'.AND.IANS(2).EQ.' ')GOTO1210
C
      IF(IWIDTH.GE.14.AND.
     1IANS(1).EQ.'E'.AND.IANS(2).EQ.'X'.AND.
     1IANS(3).EQ.'E'.AND.IANS(4).EQ.'C'.AND.
     1IANS(5).EQ.'U'.AND.IANS(6).EQ.'T'.AND.
     1IANS(7).EQ.'E'.AND.IANS(8).EQ.' '.AND.
     1IANS(9).EQ.'S'.AND.IANS(10).EQ.'T'.AND.
     1IANS(11).EQ.'R'.AND.IANS(12).EQ.'I'.AND.
     1IANS(13).EQ.'N'.AND.IANS(14).EQ.'G')GOTO1220
C
      GOTO1230
C
 1210 CONTINUE
CCCCC CHECK FOR X CHART OR X CONTROL CHART.  FEBRUARY 1994.
      IF(IWIDTH.GE.7.AND.
     1IANS(1).EQ.'X'.AND.IANS(2).EQ.' '.AND.
     1IANS(3).EQ.'C'.AND.IANS(4).EQ.'H'.AND.
     1IANS(5).EQ.'A'.AND.IANS(6).EQ.'R'.AND.
     1IANS(7).EQ.'T')GOTO1230
      IF(IWIDTH.GE.15.AND.
     1IANS(1).EQ.'X'.AND.IANS(2).EQ.' '.AND.
     1IANS(3).EQ.'C'.AND.IANS(4).EQ.'O'.AND.
     1IANS(5).EQ.'N'.AND.IANS(6).EQ.'T'.AND.
     1IANS(7).EQ.'R'.AND.IANS(8).EQ.'O'.AND.
     1IANS(9).EQ.'L'.AND.IANS(10).EQ.' '.AND.
     1IANS(11).EQ.'C'.AND.IANS(12).EQ.'H'.AND.
     1IANS(13).EQ.'A'.AND.IANS(14).EQ.'R'.AND.
     1IANS(15).EQ.'T')GOTO1230
      IF(IWIDTH.GE.6.AND.
     1IANS(1).EQ.'X'.AND.IANS(2).EQ.' '.AND.
     1IANS(3).EQ.'C'.AND.IANS(4).EQ.'O'.AND.
     1IANS(5).EQ.'N'.AND.IANS(6).EQ.'T')GOTO1230
      IFOUND='YES'
      ICASE='X   '
      GOTO1290
C
 1220 CONTINUE
      IFOUND='YES'
      ICASE='EXEC'
      GOTO1290
C
 1230 CONTINUE
      IFOUND='NO'
      ICASE='NONE'
      GOTO9000
C
 1290 CONTINUE
C
C               ***************************************************************
C               **  STEP 13--                                                **
C               **  EXTRACT THE RIGHT-SIDE                                   **
C               **  EXPRESSION FROM THE INPUT COMMAND LINE                   **
C               **  (STARTING WITH THE FIRST NON-BLANK LOCATION AFTER THE    **
C               **  WORD   STRING   OF    EXECUTE STRING                     **
C               **  AND ENDING WITH THE END OF THE LINE                      **
C               ***************************************************************
C
      ISTEPN='13'
      IF(IBUGMA.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWD1='X   '
      IWD12='    '
      IF(ICASE.EQ.'EXEC')IWD1='STRI'
      IF(ICASE.EQ.'EXEC')IWD12='NG  '
      IWD2='    '
      IWD22='    '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGMA,IFOUN1,IERROR)
      IF(IFOUN1.EQ.'NO')GOTO1310
      IF(IERROR.EQ.'YES')GOTO1310
      GOTO1390
C
 1310 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPEXEC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      INTERNAL ERROR--AT 3101 AFTER CALL TO DPEXST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      ERROR IN EXTRACTING TRAILING STRING.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1316)(IANS(I),I=1,IWIDTH)
 1316 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)IFOUN1,IERROR
 1317 FORMAT('IFOUN1,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1390 CONTINUE
C
C               ***********************************************************
C               **  STEP 14--                                            **
C               **  DETERMINE IF THE EXPRESSION HAS ANY STRING   NAMES   **
C               **  INBEDDED.  IF SO, REPLACE THE STRING   NAMES         **
C               **  BY EACH STRING  'S DEFINITION.  DO SO REPEATEDLY     **
C               **  UNTIL ALL STRING   REFERENCES HAVE BEEN ANNIHILATED  **
C               **  AND THE EXPRESSION IS LEFT ONLY WITH                 **
C               **  CONSTANTS, PARAMETERS, AND VARIABLES--NO STRING  S.  **
C               **  PLACE THE RESULTING FUNCTIONAL EXPRESSION INTO IFUNC3(.) **
C               ***********************************************************
C
      ISTEPN='14'
      IF(IBUGMA.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGMA,IERROR)
      IF(IERROR.EQ.'YES')GOTO1410
      GOTO1490
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPEXEC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      INTERNAL ERROR--AT 1401 AFTER CALL TO DPEXFU.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      ERROR IN TRANSFORMING TRAILING STRING.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1416)(IANS(I),I=1,IWIDTH)
 1416 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1417)IERROR
 1417 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               *******************************************
C               **  STEP 15--                            **
C               **  FORM THE TRANSFORMED COMMAND STRING  **
C               *******************************************
C
      ISTEPN='15'
      IF(IBUGMA.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
 
      IWIDEX=N3
      IF(N3.LT.0)IWIDEX=0
      IF(N3.GT.MAXWID)IWIDEX=MAXWID
      IF(IWIDEX.LE.0)GOTO1590
      DO1500I=1,IWIDEX
      IF4=IFUNC3(I)
      IANSEX(I)=IF4(1:1)
 1500 CONTINUE
 1590 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGMA.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXEC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGMA,IFOUND,IERROR,ICASE
 9012 FORMAT('IBUGMA,IFOUND,IERROR,ICASE = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUN1
 9013 FORMAT('IFOUN1 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMNAM
 9014 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMNAM
      WRITE(ICOUT,9016)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
 9016 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1I8,2X,A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)N2,N3,NUMCHF,MAXN2,MAXN3,MAXCHF
 9017 FORMAT('N2,N3,NUMCHF,MAXN2,MAXN3,MAXCHF = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)(IFUNC2(I),I=1,N2)
 9018 FORMAT('IFUNC2(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)(IFUNC3(I),I=1,N3)
 9019 FORMAT('IFUNC3(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)(IFUNC(I),I=1,MAXCHF)
 9020 FORMAT('IFUNC(.)  = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IWIDEX
 9021 FORMAT('IWIDEX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)(IANSEX(I),I=1,IWIDEX)
 9022 FORMAT('(IANSEX(.) = ',110A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
C
C     PURPOSE--SCAN A STRING FOR FUNCTION NAMES;
C              REPLACE FUNCTION NAMES BY FUNCTION EXPRESSIONS;
C              DO SO RECURSIVELY UNTIL ALL FUNCTION NAMES
C              HAVE BEEN ANNIHILATED AND THERE REMAINS ONLY
C              AN EXPRESSION IN CONSTANTS, PARAMETERS,
C              VARIABLES--NO FUNCTIONS.
C     NOTE--THE INPUT STRING IS IN IFUNC2(.).
C           THE OUTPUT EXPRESSION WILL BE IN IFUNC3(.).
C     NOTE--IF SO DESIRED, THE OUTPUT VECTOR IFUNC3(.)
C           MAY BE IDENTICAL TO THE INPUT VECTOR IFUNC2(.).
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1978.
C     UPDATED         --JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     2005. SINCE FUNCTIONS NO LONGER
C                                       STORED IN UPPER CASE,
C                                       NEED TO CONVERT EXTRACTED
C                                       FUNCTION TO UPPER CASE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IFUNC2
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
      CHARACTER*4 IFUNC
      CHARACTER*4 IFUNC3
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IFOUNN
      CHARACTER*4 ICH
      CHARACTER*4 IX1
      CHARACTER*4 IX2
      CHARACTER*4 IHOUT
      CHARACTER*4 IWD1
      CHARACTER*4 IWD12
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IFUNC2(*)
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IANS(*)
      DIMENSION IFUNC(*)
      DIMENSION IFUNC3(*)
C
      DIMENSION ICH(8)
C
      DIMENSION IHOUT(10)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPEX'
      ISUBN2='FU  '
C
      NUMASC=4
      NUMAS2=2*NUMASC
C
      IFOUNN='NO'
      IEND=0
      ISTART=0
      ISTOP=0
      J2=0
      ILENEX=0
      ILENFN=0
      IDEL=0
      N3PDEL=0
C
C               ***************************
C               **  EXTRACT A FUNCTION.  **
C               ***************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPEXFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)N2
   72 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)(IFUNC2(I),I=1,MIN(N2,115))
   73 FORMAT('IFUNC2(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)NUMCHF
   74 FORMAT('NUMCHF = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)(IFUNC(I),I=1,MIN(NUMCHF,115))
   75 FORMAT('IFUNC(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)NUMNAM
   77 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)
   78 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I) = ')
      CALL DPWRST('XXX','BUG ')
      IF(NUMNAM.LE.0)GOTO90
      DO80I=1,NUMNAM
      WRITE(ICOUT,81)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
   81 FORMAT(I8,2X,A4,A4,2X,A4,2X,I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
   80 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
      IERROR='NO'
      NUMPAS=100
C
C               **********************************************
C               **  STEP 2--                                **
C               **  COPY THE INITIAL CONTENTS OF IFUNC2(.)  **
C               **  INTO IFUNC3(.).                         **
C               **  SET N3 INITIALLY = N2.                  **
C               **********************************************
C
      DO120I=1,N2
      IFUNC3(I)=IFUNC2(I)
  120 CONTINUE
      N3=N2
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  MAKE A MAXIMUM OF 100 INDEPENDENT MULTI-NAME             **
C               **  PASSES AT THE CONTINUOUSLY-UPDATED STRING IN IFUNC3(.).  **
C               **  EACH INDEPENDENT MULTI-NAME PASS CONSISTS OF             **
C               **  GOING THROUGH ALL THE FUNCTION NAMES IN THE INTERNAL     **
C               **  DATAPLOT TABLE, SEEING IF EACH ONE OCCURS IN IFUNC3(.),  **
C               **  AND THEN REPLACING THE FUNCTION NAME IN IFUNC3(.)        **
C               **  BY THE DEFINED FUNCTION EXPRESSION.                      **
C               **  WHEN IFUNC3(.) NO LONGER CONTAINS ANY FUNCTION NAMES,    **
C               **  THEN TERMINATE THE PASSES.                               **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1100IPASS=1,NUMPAS
C
C               *****************************************************
C               **  STEP 3.1--                                     **
C               **  FOR A GIVEN INDEPENDENT MULTI-NAME PASS,       **
C               **  EXAMINE (SWEEP THROUGH) ALL THE FUNCTION       **
C               **  NAMES IN THE INTERNAL DATAPLOT TABLE.          **
C               **  FOR A GIVEN FUNCTION NAME, EXAMINE THE         **
C               **  CURRENT STRING IN IFUNC3(.) TO DETERMINE       **
C               **  IF THIS PARTICULAR FUNCTION NAME OCCURS        **
C               **  ANYWHERE IN THE STRING.                        **
C               *****************************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUNN='NO'
      DO2100INAME=1,NUMNAM
      IF(IUSE(INAME).EQ.'F')GOTO2190
      GOTO2100
 2190 CONTINUE
C
C               **************************************************
C               **  STEP 3.2--                                  **
C               **  FOR A GIVEN NAME IN THE TABLE,              **
C               **  DECOMPOSE THE NAME INTO 1-CHARACTER WORDS.  **
C               **************************************************
C
      ISTEPN='3.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWD1=IHNAME(INAME)
      IWD12=IHNAM2(INAME)
      IF(IWD1.EQ.' ')GOTO3080
      GOTO3090
 3080 CONTINUE
      WRITE(ICOUT,3081)
 3081 FORMAT('***** ERROR IN DPEXFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3082)
 3082 FORMAT('      A FUNCTION NAME ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3083)
 3083 FORMAT('      IN THE INTERNAL DATAPLOT TABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3084)
 3084 FORMAT('      CONSISTED OF ALL BLANKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3085)INAME
 3085 FORMAT('      IT WAS NAME NUMBER ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3086)
 3086 FORMAT('      IN THE PARAMETER/VARIABLE/FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3087)
 3087 FORMAT('      TABLE.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3090 CONTINUE
C
CCCCC CALL DPXH1H(IWD1,ICH,IEND,IBUGA3)
      DO3195I=1,NUMAS2
      ICH(I)=' '
 3195 CONTINUE
C
      J=0
      IF(IWD1.EQ.' ')IEND=0
      IF(IWD1.EQ.' ')GOTO3390
      IX1=IWD1
      ISTR2=0
      ILEN1=NUMBPC
      ILEN2=ILEN1
      DO3200I=1,NUMASC
      J=J+1
      IX2=' '
      ISTR1=(I-1)*NUMBPC
      CALL DPCHEX(ISTR1,ILEN1,IX1,ISTR2,ILEN2,IX2)
      ICH(J)=IX2
 3200 CONTINUE
C
      IF(IWD12.EQ.' ')GOTO3290
      IX1=IWD12
      ISTR2=0
      ILEN1=NUMBPC
      ILEN2=ILEN1
      DO3250I=1,NUMASC
      J=J+1
      IX2=' '
      ISTR1=(I-1)*NUMBPC
      CALL DPCHEX(ISTR1,ILEN1,IX1,ISTR2,ILEN2,IX2)
      ICH(J)=IX2
 3250 CONTINUE
 3290 CONTINUE
C
      K=0
      DO3300I=1,J
      K=K+1
      IF(ICH(I).EQ.' ')GOTO3350
 3300 CONTINUE
      IEND=K
      GOTO3390
 3350 CONTINUE
      IEND=K-1
 3390 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO3399
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3391)
 3391 FORMAT('***** FROM THE MIDDLE OF DPEXFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3392)IPASS,INAME,IWD1,IWD12,IEND
 3392 FORMAT('IPASS,INAME,IWD1,IWD12,IEND = ',I8,I8,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3393)(ICH(I),I=1,8)
 3393 FORMAT('ICH(.)--',120A1)
      CALL DPWRST('XXX','BUG ')
 3399 CONTINUE
C
C               *************************************************
C               **  STEP 3.3--                                 **
C               **  SEARCH THE CURRENT STRING TO SEE IF THIS   **
C               **  PARTICULAR FUNCTION NAME IS ANYWHERE       **
C               **  IN THE STRING.                             **
C               **  ALSO CHECK TO SEE IF A FOUND STRING        **
C               **  IS VALID UNTO ITSELF BY CHECKING IF IT     **
C               **  IS PRECEDED AND SUCCEEDED BY THE           **
C               **  USUAL TYPE OF SEPARATORS AS FOUND          **
C               **  IN MATHEMATICAL EXPRESSIONS                **
C               **  (+, -, *, /, PARENTHESIS, OR SPACE.        **
C               *************************************************
C
      ISTEPN='3.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTART=-99
      ISTOP=-99
      NUMTNF=0
 4000 CONTINUE
      DO4100I=1,N3
      I2=I
      IF(IFUNC3(I).EQ.ICH(1))GOTO4190
      GOTO4100
 4190 CONTINUE
C
      DO4200J=1,IEND
      J2=I2+J-1
C     ***** THE FOLLOWING CORRECTIVE LINE INSERTED IN AUGUST 1983 *****
      IF(J2.GT.N3)GOTO4100
      IF(IFUNC3(J2).EQ.ICH(J))GOTO4200
      GOTO4100
 4200 CONTINUE
C
      ISTART=I2
      ISTOP=J2
C
      ISTAM1=ISTART-1
      IF(ISTAM1.LT.1.OR.ISTAM1.GT.N3)GOTO4390
      IF(IFUNC3(ISTAM1).EQ.' ')GOTO4390
      IF(IFUNC3(ISTAM1).EQ.'(')GOTO4390
      IF(IFUNC3(ISTAM1).EQ.'+')GOTO4390
      IF(IFUNC3(ISTAM1).EQ.'-')GOTO4390
      IF(IFUNC3(ISTAM1).EQ.'*')GOTO4390
      IF(IFUNC3(ISTAM1).EQ.'/')GOTO4390
      IF(IFUNC3(ISTAM1).EQ.'**')GOTO4390
      GOTO4100
 4390 CONTINUE
C
      ISTOP1=ISTOP+1
      IF(ISTOP1.LT.1.OR.ISTOP1.GT.N3)GOTO4490
      IF(IFUNC3(ISTOP1).EQ.' ')GOTO4490
      IF(IFUNC3(ISTOP1).EQ.')')GOTO4490
      IF(IFUNC3(ISTOP1).EQ.'+')GOTO4490
      IF(IFUNC3(ISTOP1).EQ.'-')GOTO4490
      IF(IFUNC3(ISTOP1).EQ.'*')GOTO4490
      IF(IFUNC3(ISTOP1).EQ.'/')GOTO4490
      IF(IFUNC3(ISTOP1).EQ.'**')GOTO4490
      GOTO4100
 4490 CONTINUE
C
      IFOUNN='YES'
C
C               ***********************************************************
C               **  STEP 3.4--                                           **
C               **  HAVING FOUND AN OCCURRANCE OF A GIVEN FUNCTION NAME  **
C               **  SOMEWHERE IN THE CURRENT STRING IFUNC3(.),           **
C               **  1) DETERMINE THE LENGTH OF THE FUNCTION EXPRESSION   **
C               **     ABOUT TO BE SUBSTITUTED (INTO IFUNC3(.))          **
C               **     IN PLACE OF THE FUNCTION NAME.                    **
C               **  2) MOVE THE SEGMENT OF THE STRING IN IFUNC3(.)       **
C               **     WHICH IS BEYOND THE FOUND FUNCTION NAME OVER      **
C               **     AN APPROPRIATE NUMBER OF SPACES.                  **
C               **  3) ACTUALLY INSERT THE FUNCTION EXPRESSION           **
C               **     INTO IFUNC3(.) IN PLACE OF THE FUNCTION NAME      **
C               **     (PRECEDED AND SUCCEEDED BY PARENTHESES).          **
C               **  4) UPDATE THE CURRENT LENGTH N3 OF IFUNC3(.).        **
C               **  5) LOOP BACK AND COMPLETELY REEXAMINE IFUNC3(.) FOR  **
C               **     ADDITIONAL OCCURRANCES OF THIS FUNCTION NAME.     **
C               ***********************************************************
C
C
      ISTEPN='3.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTAR2=IVSTAR(INAME)
      ISTOP2=IVSTOP(INAME)
      ILENEX=ISTOP2-ISTAR2+1
      ILENFN=IEND
      IDEL=ILENEX-ILENFN
      IDEL=IDEL+2
C
      N3PDEL=N3+IDEL
      IF(N3PDEL.LE.MAXN3)GOTO5090
      WRITE(ICOUT,5001)
 5001 FORMAT('***** ERROR IN DPEXFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5002)
 5002 FORMAT('      ERROR CAUSED IN FORMATION OF FUNCTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5005)
 5005 FORMAT('      THE TOTAL NUMBER OF CHARACTERS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5006)MAXCHF
 5006 FORMAT('      FOR THE FUNCTION MAY NOT EXCEED ',
     1I8,'.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5007)
 5007 FORMAT('      SUCH AN OVERFLOW CONDITION HAS JUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5008)
 5008 FORMAT('      BEEN ENCOUNTERED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5018)
 5018 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5019)(IANS(K),K=1,MIN(IWIDTH,100))
 5019 FORMAT('      ',100A1)
      CALL DPWRST('XXX','BUG ')
C
      IERROR='YES'
      GOTO9000
 5090 CONTINUE
C
      IPOINT=ISTOP
      IHOUT(1)=')'
      NOUT=1
      CALL DPSIAS(IPOINT,IFUNC3,N3,IHOUT,NOUT,IBUGA3,IERROR)
C
      IPOINT=ISTART-1
      IHOUT(1)='('
      NOUT=1
      CALL DPSIAS(IPOINT,IFUNC3,N3,IHOUT,NOUT,IBUGA3,IERROR)
C
      IPOIN1=ISTART+1
      IPOIN2=ISTOP+1
      CALL DPSIRS(IFUNC3,N3,IPOIN1,IPOIN2,IFUNC,NUMCHF,ISTAR2,ISTOP2,
     1IBUGA3,IERROR)
C
CCCCC APRIL 2005.  CONVERT NEW FUNCTION TO UPPER CASE.
C
      DO5201II=1,N3
        IJUNK=ICHAR(IFUNC3(II)(1:1))
        IF(IJUNK.GE.97 .AND. IJUNK.LE.122)THEN
          IJUNK=IJUNK-32
          IFUNC3(II)(1:1)=CHAR(IJUNK)
        ENDIF
 5201 CONTINUE
C
      NUMTNF=NUMTNF+1
      IF(NUMTNF.LE.MAXN3)GOTO4100
C
C     WRITE(ICOUT,5301)
 5301 FORMAT('***** ERROR IN DPEXFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5302)
 5302 FORMAT('      FOR A GIVEN MULTI-NAME PASS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5303)(ICH(K),K=1,IEND)
 5303 FORMAT('      FOR A PARTICULAR FUNCTION NAME (= ',10A1,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5304)MAXN3
 5304 FORMAT('      THE NAME OCCURRED MORE THAN ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5305)
 5305 FORMAT('      TIMES ON THE LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5307)
 5307 FORMAT('      POSSIBLE CAUSE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5308)
 5308 FORMAT('      AN IMPROPER INFINITELY-RECURSIVE ORIGINAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5309)
 5309 FORMAT('      FUNCTION DEFINITION THAT HAD BEEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5310)(ICH(K),K=1,IEND)
 5310 FORMAT('      PREVIOUSLY MADE FOR ',10A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5311)
 5311 FORMAT('      EXAMPLE--LET FUNCTION F1=F1*F1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5312)
 5312 FORMAT('      SOLUTION--CORRECT THE ORIGINAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5313)(ICH(K),K=1,IEND)
 5313 FORMAT('      DEFINITION FOR THE FUNCTION ',10A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5314)
 5314 FORMAT('      SO THAT IT IS AN EXPRESSION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5315)
 5315 FORMAT('      IN TERMS OF CONSTANTS, PARAMETERS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5316)
 5316 FORMAT('      AND VARIABLES--NOT UNENDINGLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5317)
 5317 FORMAT('      RECURSIVE IN ITS OWN FUNCTION NAME.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4100 CONTINUE
C
 2100 CONTINUE
      IF(IFOUNN.EQ.'NO')GOTO9000
C
 1100 CONTINUE
C
      WRITE(ICOUT,5901)
 5901 FORMAT('***** ERROR IN DPEXFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5902)
 5902 FORMAT('      THE NUMBER OF INDEPENDENT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5903)
 5903 FORMAT('      MULTI-NAME PASSES TO DETERMINE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5904)
 5904 FORMAT('      THE EXPLICIT UNDERLYING FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5905)
 5905 FORMAT('      HAS JUST EXCEEDED THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5906)
 5906 FORMAT('      MAXIMUM ALLOWABLE NUMBER OF ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5907)
 5907 FORMAT('      POSSIBLE CAUSE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5908)
 5908 FORMAT('      AN IMPROPER INFINITELY-RECURSIVE ORIGINAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5909)
 5909 FORMAT('      FUNCTION DEFINITION THAT HAD BEEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5910)
 5910 FORMAT('      PREVIOUSLY MADE FOR ONE OR MORE FUNCTIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5911)
 5911 FORMAT('      EXAMPLE--LET FUNCTION F1=F1*F2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5912)
 5912 FORMAT('      SOLUTION--CORRECT THE ORIGINAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5913)
 5913 FORMAT('      DEFINITION FOR SOME FUNCTION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5914)
 5914 FORMAT('      SO THAT IT IS AN EXPRESSION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5915)
 5915 FORMAT('      IN TERMS OF CONSTANTS, PARAMETERS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5916)
 5916 FORMAT('      AND VARIABLES--NOT UNENDINGLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5917)
 5917 FORMAT('      RECURSIVE IN ITS OWN FUNCTION NAME.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ****************
C               **  STEP 4--  **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXFU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ISTAR2,ISTOP2,ILENEX,ILENFN,IDEL,N3PDEL
 9012 FORMAT('ISTAR2,ISTOP2,ILENEX,ILENFN,IDEL,N3PDEL = ',6I4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ISTART,ISTOP,IFOUNN
 9013 FORMAT('ISTART,ISTOP,IFOUNN = ',2I8,3X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IPOINT,IPOIN1,IPOIN2
 9014 FORMAT('IPOINT,IPOIN1,IPOIN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IEND
 9015 FORMAT('IEND = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(ICH(I),I=1,8)
 9016 FORMAT('ICH(.) = ',10A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)N3
 9017 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)(IFUNC3(I),I=1,MIN(N3,115))
 9018 FORMAT('IFUNC3(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXP1(ICOM,ICOM2,ICOMT,ICOMI,
     1IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IEXPSW,
     1IEX1CO,IEX1AL,
     1IEX2CO,IEX2AL,
     1IEX3CO,IEX3AL,
     1IEX4CO,IEX4AL,
     1IEX5CO,IEX5AL,
     1IEXPCO,IEXPAL,
     1IANS,IWIDTH,IBUGEX,IBUGE2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DETERMINE IF DATAPLOT'S EXPERT SYSTEM
C              COMMAND IS BEING INVOKED AND/OR
C              DETERMINE IF A USER'S MENU DESIGNATION IS VALID.
C              THIS SUBROUTINE IN TURN CALLS DPEXP2
C              WHICH READS THE DESIGNATED MENU
C              FROM (ONE OF) DATAPLOT'S EXPERT SUB-SYSTEM FILE(S),
C              AND WRITES THE MENU OUT TO SCREEN.
C     INPUT  ARGUMENTS--ICOM ETC.
C     OUTPUT ARGUMENTS--IEXPSW, IEXPCO, AND IEXPAL
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--FEBRUARY  1985.
C     UPDATED         --JANUARY   1986.
C     UPDATED         --FEBRUARY  1989. FORMATS DUE TO 2X NOS LOWER CASE CHAR
C     UPDATED         --SEPTEMBER 1993. CHECK:'EXPE' ==> 'EXPERT  '
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 ICOM2
      CHARACTER*4 ICOMT
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
C
      CHARACTER*4 IEXPSW
C
      CHARACTER*12 IEX1CO
      CHARACTER*4 IEX1AL
C
      CHARACTER*12 IEX2CO
      CHARACTER*4 IEX2AL
C
      CHARACTER*12 IEX3CO
      CHARACTER*4 IEX3AL
C
      CHARACTER*12 IEX4CO
      CHARACTER*4 IEX4AL
C
      CHARACTER*12 IEX5CO
      CHARACTER*4 IEX5AL
C
      CHARACTER*12 IEXPCO
      CHARACTER*4 IEXPAL
C
      CHARACTER*4 IANS
      CHARACTER*4 IBUGEX
      CHARACTER*4 IBUGE2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IANS(*)
C
C-----COMMON----------------------------------------------------------
C
CCCCC INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCONP.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPEX'
      ISUBN2='P1  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IEXPAL='OFF'
C
      MAXCPS=12
C
      I2=(-999)
C
      IF(IBUGEX.EQ.'OFF'.AND.ISUBRO.NE.'EXP1')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXP1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IEXPSW
   52 FORMAT('IEXPSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IEX1CO,IEX1AL
   71 FORMAT('IEX1CO,IEX1AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IEX2CO,IEX2AL
   72 FORMAT('IEX2CO,IEX2AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IEX3CO,IEX3AL
   73 FORMAT('IEX3CO,IEX3AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IEX4CO,IEX4AL
   74 FORMAT('IEX4CO,IEX4AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)IEX5CO,IEX5AL
   75 FORMAT('IEX5CO,IEX5AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IEXPCO,IEXPAL
   76 FORMAT('IEXPCO,IEXPAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)IWIDTH
   81 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)(IANS(I),I=1,80)
   82 FORMAT('(IANS(I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IBUGEX,IBUGE2,IERROR
   83 FORMAT('IBUGEX,IBUGE2,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************************
C               **  STEP 11--                                               **
C               **  DETERMINE IF HAVE AN EXPERT COMMAND, OR                 **
C               **            IF HAVE A MENU RESPONSE NUMBER TO A MENU, OR  **
C               **            IF HAVE NEITHER.                              **
C               **************************************************************
C
 1100 CONTINUE
      ISTEPN='11'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING LINE WAS CHANGED                SEPTEMBER 1993
CCCCC TO AVOID CONFLICT WITH   EXPECTED LOSS PLOT   SEPTEMBER 1993
CCCCC IF(ICOM.EQ.'EXPE')GOTO1200
      IF(ICOM.EQ.'EXPE'.AND.ICOM2.EQ.'RT  ')GOTO1200
      IF(ICOM.EQ.'.')GOTO9000
      IF(ICOM.EQ.' ')GOTO9000
CCCCC IF(NUMARG.LE.0.AND.ICOM.EQ.' ')GOTO2100
      IF(NUMARG.LE.0.AND.ICOMT.EQ.'NUMB'.AND.ICOMI.EQ.0)GOTO2300
      IF(NUMARG.LE.0.AND.ICOMT.EQ.'NUMB'.AND.ICOMI.GT.0)GOTO1500
      IF(NUMARG.LE.0.AND.ICOMT.EQ.'NUMB'.AND.ICOMI.LT.0)GOTO1600
      GOTO9000
C
C               ***************************************
C               **  STEP 12--                        **
C               **  TREAT THE CASE WHEN HAVE         **
C               **  AN EXPLICIT    EXPERT   COMMAND  **
C               ***************************************
C
 1200 CONTINUE
      ISTEPN='12'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO2100
      IF(IHARG(1).EQ.'LAST')GOTO2100
      IF(IHARG(1).EQ.'?')GOTO2100
      IF(IHARG(1).EQ.'ALL')IEXPAL='ON'
      IF(IHARG(1).EQ.'ALL')GOTO2100
C
      IF(IHARG(1).EQ.'UP')GOTO1300
      IF(IHARG(1).EQ.'PRIO')GOTO1300
      IF(IHARG(1).EQ.'PREV')GOTO1300
      IF(IHARG(1).EQ.'BEFO')GOTO1300
C
      GOTO1400
C
C               ****************************************
C               **  STEP 13  --                       **
C               **  TREAT THE    EXPERT UP #    CASE  **
C               ****************************************
C
 1300 CONTINUE
      ISTEPN='13'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IEXPCO.EQ.'0           ')IEXPSW='TOP'
      IF(IEXPCO.EQ.'0           ')GOTO2100
      IF(IEXPCO.EQ.'            ')IEXPSW='TOP'
      IF(IEXPCO.EQ.'            ')GOTO2100
C
      NLOOP=1
      IF(NUMARG.GE.2.AND.IARGT(2).EQ.'NUMB')NLOOP=IARG(2)
      IF(NLOOP.LE.1)NLOOP=1
C
      DO1310ILOOP=1,NLOOP
C
      DO1320I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IEXPCO(IREV:IREV).EQ.'.')GOTO1325
      IEXPCO(IREV:IREV)=' '
 1320 CONTINUE
      GOTO1310
 1325 CONTINUE
      IEXPCO(IREV:IREV)=' '
      GOTO1310
C
 1310 CONTINUE
      GOTO2100
C
C               *************************************
C               **  STEP 14--                      **
C               **  TREAT THE    EXPERT #    CASE  **
C               *************************************
C
 1400 CONTINUE
      ISTEPN='14'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DATA'.AND.
     1IHARG(2).EQ.'ANAL')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'MATH')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'GRAP')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DATA'.AND.
     1IHARG2(1).EQ.'PLOT')GOTO1490
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IEXPCO(1:4)=IH11(1:4)
      IEXPCO(5:8)=IH12(1:4)
      IEXPCO(9:12)='    '
C
 1490 CONTINUE
      GOTO2100
C
C               *****************************************
C               **  STEP 15--                          **
C               **  TREAT THE    #    CASE             **
C               **  (AS IN RESPONDING TO A MENU        **
C               **  BY SPECIFYING A MENU ITEM CHOICE)  **
C               *****************************************
C
 1500 CONTINUE
      ISTEPN='15'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IEXPSW.EQ.'TOP')IEXPCO='0           '
      IF(IEXPSW.EQ.'TOP')GOTO2100
C
      IF(IEXPCO(1:1).EQ.'0')GOTO1510
      GOTO1520
C
 1510 CONTINUE
      I2=0
      GOTO1530
C
 1520 CONTINUE
      DO1525I=1,MAXCPS
      I2=I
      IF(IEXPCO(I2:I2).EQ.' ')GOTO1526
 1525 CONTINUE
      GOTO1539
 1526 CONTINUE
      IEXPCO(I2:I2)='.'
      GOTO1530
C
 1530 CONTINUE
      DO1535J=1,4
      I2=I2+1
      IF(I2.GT.MAXCPS)GOTO1539
      IEXPCO(I2:I2)=ICOM(J:J)
 1535 CONTINUE
 1539 CONTINUE
      GOTO2100
C
C               *****************************************
C               **  STEP 16--                          **
C               **  TREAT THE   -#    CASE             **
C               **  (AS IN CALLING FOR PRIOR MENUS     **
C               *****************************************
C
 1600 CONTINUE
      ISTEPN='16'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IEXPCO.EQ.'0           ')IEXPSW='TOP'
      IF(IEXPCO.EQ.'0           ')GOTO2100
      IF(IEXPCO.EQ.'            ')IEXPSW='TOP'
      IF(IEXPCO.EQ.'            ')GOTO2100
C
      NLOOP=1
      IF(ICOMT.EQ.'NUMB')NLOOP=(-ICOMI)
C
      IF(NLOOP.LE.0)GOTO1619
      DO1610ILOOP=1,NLOOP
C
      DO1620I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IEXPCO(IREV:IREV).EQ.'.')GOTO1621
      IEXPCO(IREV:IREV)=' '
 1620 CONTINUE
      GOTO1610
 1621 CONTINUE
      IEXPCO(IREV:IREV)=' '
      GOTO1610
C
 1610 CONTINUE
C
 1619 CONTINUE
      GOTO2100
C
C               *************************************************
C               **  STEP 17--                                  **
C               **  STRIP OFF TRAILING PERIOD (IF ONE EXISTS)  **
C               *************************************************
C
 1700 CONTINUE
      ISTEPN='17'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1710I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IEXPCO(IREV:IREV).NE.' ')GOTO1711
 1710 CONTINUE
      GOTO1790
 1711 CONTINUE
      IF(IEXPCO(IREV:IREV).EQ.'.')IEXPCO(IREV:IREV)=' '
      GOTO1790
 1790 CONTINUE
C
C               *********************************************
C               **  STEP 21--                              **
C               **  BRANCH BETWEEN THE OVERALL MENU        **
C               **  OR THE GENERAL MENU WITHIN EACH AREA.  **
C               *********************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUND='YES'
      IF(IEXPCO.EQ.'            ')IEXPCO='0           '
      IF(ICOM.EQ.'EXPE'.AND.NUMARG.LE.0)GOTO2200
      IF(IEXPSW.EQ.'TOP'.AND.NUMARG.LE.0.AND.
     1ICOM.EQ.' ')GOTO2200
      IF(IEXPSW.EQ.'TOP'.AND.NUMARG.LE.0.AND.
     1ICOMT.EQ.'NUMB'.AND.ICOMI.LE.0)GOTO2200
      GOTO2300
C
C               **********************************************
C               **  STEP 22--                               **
C               **  WRITE (TO THE SCREEN) THE OVERALL MENU  **
C               **********************************************
C
 2200 CONTINUE
      ISTEPN='22'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IEXPSW='TOP'
C
      WRITE(ICOUT,2211)IESCC,IFFC
 2211 FORMAT(2A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)IESCC
 2212 FORMAT(A1,'8')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,2221)
 2221 FORMAT(
     *  'Enter     HELP EXPERT     ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2222)
 2222 FORMAT(
     *'for a brief description of DATAPLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2223)
 2223 FORMAT(
     *'Expert Subsystem scope ',
     * 'and conventions')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2230)
 2230 FORMAT('     GENERAL TOPIC AREAS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2231)
 2231 FORMAT('     ',
     *' 1. Data Analysis ',
     *'(partially implemented)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2232)
 2232 FORMAT('     ',
     *' 2. Mathematics   ',
     *'(not yet implemented)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2233)
 2233 FORMAT('     ',
     *' 3. Graphics      (not yet implemented)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2234)
 2234 FORMAT('     ',
     *  ' 4. DATAPLOT      (not yet implemented)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2241)
 2241 FORMAT(
     *'To select a menu item, ',
     *'enter 1 through 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               ****************************************
C               **  STEP 23--                         **
C               **  READ THE EXPERT FILE              **
C               **  AND WRITE (TO THE SCREEN) A MENU  **
C               ****************************************
C
 2300 CONTINUE
      ISTEPN='23'
      IF(IBUGEX.EQ.'ON'.OR.ISUBRO.EQ.'EXP1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DATA'.AND.
     1IHARG(2).EQ.'ANAL')GOTO2331
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'MATH')GOTO2332
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'GRAP')GOTO2333
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DATA'.AND.
     1IHARG2(1).EQ.'PLOT')GOTO2334
C
      IF(IEXPSW.EQ.'TOP'.AND.NUMARG.GE.1.AND.
     1IARGT(1).EQ.'NUMB')GOTO2310
C
      IF(IEXPSW.EQ.'TOP'.AND.NUMARG.EQ.0.AND.
     1ICOMT.EQ.'NUMB')GOTO2320
C
      GOTO2390
C
 2310 CONTINUE
      IF(IARG(1).EQ.1)GOTO2331
      IF(IARG(1).EQ.2)GOTO2332
      IF(IARG(1).EQ.3)GOTO2333
      IF(IARG(1).EQ.4)GOTO2334
      GOTO2390
C
 2320 CONTINUE
      IF(ICOMI.EQ.1)GOTO2331
      IF(ICOMI.EQ.2)GOTO2332
      IF(ICOMI.EQ.3)GOTO2333
      IF(ICOMI.EQ.4)GOTO2334
      GOTO2390
C
 2331 CONTINUE
      IEXPSW='DATA'
CCCCC IEXPCO='0           '
      GOTO2390
C
 2332 CONTINUE
      IEXPSW='MATH'
CCCCC IEXPCO='0           '
      GOTO2390
C
 2333 CONTINUE
      IEXPSW='GRAP'
CCCCC IEXPCO='0           '
      GOTO2390
C
 2334 CONTINUE
      IEXPSW='DATP'
CCCCC IEXPCO='0           '
      GOTO2390
C
 2390 CONTINUE
      CALL DPEXP2(IEXPSW,
     1IEXPCO,IEXPAL,
     1IANS,IWIDTH,IBUGE2,ISUBRO,IFOUND,IERROR)
C
      IF(IEXPSW.EQ.'DATA')IEX1CO=IEXPCO
      IF(IEXPSW.EQ.'MATH')IEX2CO=IEXPCO
      IF(IEXPSW.EQ.'GRAP')IEX3CO=IEXPCO
      IF(IEXPSW.EQ.'DATP')IEX4CO=IEXPCO
C
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGEX.EQ.'OFF'.AND.ISUBRO.NE.'EXP1')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXP1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IEXPSW
 9012 FORMAT('IEXPSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IEX1CO,IEX1AL
 9031 FORMAT('IEX1CO,IEX1AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IEX2CO,IEX2AL
 9032 FORMAT('IEX2CO,IEX2AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)IEX3CO,IEX3AL
 9033 FORMAT('IEX3CO,IEX3AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IEX4CO,IEX4AL
 9034 FORMAT('IEX4CO,IEX4AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IEX5CO,IEX5AL
 9035 FORMAT('IEX5CO,IEX5AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IEXPCO,IEXPAL
 9036 FORMAT('IEXPCO,IEXPAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9049)IBUGEX,IBUGE2,IFOUND,IERROR
 9049 FORMAT('IBUGEX,IBUGE2,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXP2(IEXPSW,
     1IEXPCO,IEXPAL,
     1IANS,IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--READ THE DESIGNATED MENU
C              FROM (ONE OF) DATAPLOT'S EXPERT SUB-SYSTEM FILE(S),
C              AND WRITE THE MENU OUT TO SCREEN.
C     INPUT  ARGUMENTS--IEXPSW (A HOLLARITH VARIABLE
C                       IDENTIFYING WHICH SUB-SYSTEM.
C                     --IEXPCO (A HOLLARITH VARIABLE
C                       CONTAINING A MENU IDENTIFICATION STRING.
C                     --IEXPAL (A HOLLARITH VARIABLE (ON/OFF)
C                       CONTAINING A SWITCH SETTING AS TO WHETHER
C                       ALL OF THE TOPIC MENU SHOULD BE PRINTED OUT.
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--FEBRAURY  1985.
C     UPDATED         --JANUARY   1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IEXPSW
      CHARACTER*12 IEXPCO
      CHARACTER*4 IEXPAL
C
      CHARACTER*4 IANS
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
C
      CHARACTER*12 ITABID
C
      CHARACTER*80 ICTEXT
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION ITABID(500)
      DIMENSION ITABLN(500)
C
      DIMENSION IANS(*)
C
C-----COMMON----------------------------------------------------------
C
CCCCC INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCONP.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      NUMSEC=(-999)
      JSEC=(-999)
      ISKIP=(-999)
      ISTART=(-999)
      I2=(-999)
C
      IFOUND='YES'
      IERROR='NO'
C
      ISUBN1='DPEX'
      ISUBN2='P2  '
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXP2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IEXPSW
   52 FORMAT('IEXPSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IEXPCO,IEXPAL
   53 FORMAT('IEXPCO,IEXPAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGS2,ISUBRO,IERROR
   55 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IEXPSW.EQ.'DATA')GOTO1110
      IF(IEXPSW.EQ.'MATH')GOTO1120
      IF(IEXPSW.EQ.'GRAP')GOTO1130
      IF(IEXPSW.EQ.'DATP')GOTO1140
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1101)
 1101 FORMAT('***** INTERNAL ERROR IN DPEXP2 ',
     1'AT BRANCH POINT 1101--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)
 1102 FORMAT('      IEXPSW SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)
 1103 FORMAT('      DATA, MATH, GRAP, OR DATP, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1104)
 1104 FORMAT('      BUT IS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1105)IEXPSW
 1105 FORMAT('      IEXPSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1110 CONTINUE
      IOUNIT=IEX1NU
      IFILE=IEX1NA
      ISTAT=IEX1ST
      IFORM=IEX1FO
      IACCES=IEX1AC
      IPROT=IEX1PR
      ICURST=IEX1CS
      ISUBN0='EXP2'
      IERRFI='NO'
      GOTO1190
C
 1120 CONTINUE
      IOUNIT=IEX2NU
      IFILE=IEX2NA
      ISTAT=IEX2ST
      IFORM=IEX2FO
      IACCES=IEX2AC
      IPROT=IEX2PR
      ICURST=IEX2CS
      ISUBN0='EXP2'
      IERRFI='NO'
      GOTO1190
C
 1130 CONTINUE
      IOUNIT=IEX3NU
      IFILE=IEX3NA
      ISTAT=IEX3ST
      IFORM=IEX3FO
      IACCES=IEX3AC
      IPROT=IEX3PR
      ICURST=IEX3CS
      ISUBN0='EXP2'
      IERRFI='NO'
      GOTO1190
C
 1140 CONTINUE
      IOUNIT=IEX4NU
      IFILE=IEX4NA
      ISTAT=IEX4ST
      IFORM=IEX4FO
      IACCES=IEX4AC
      IPROT=IEX4PR
      ICURST=IEX4CS
      ISUBN0='EXP2'
      IERRFI='NO'
      GOTO1190
C
 1190 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXP2')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)IBUGS2,ISUBRO,ISUBN0,IERRFI
 1196 FORMAT('IBUGS2,ISUBRO,ISUBN0,IERRFI = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  CHECK TO SEE IF THIS EXPERT FILE EXISTS  **
C               ***********************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPEXP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE EXPERT SUB-SYSTEM')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE ENTERED FOR THIS TOPIC BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES EXPERT MENUS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT YET AVAILABLE FOR THIS TOPIC.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,IEXPSW
 1217 FORMAT('ISTAT,IEXPSW = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               *********************
C               **  STEP 20--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='20'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ************************************************************
C               **  STEP 41--                                             **
C               **  READ IN FILE INFORMATION                              **
C               **  FROM THE BEGINNING LINES OF THE FILE.                 **
C               **  THESE LEAD LINES CONTAIN                              **
C               **  THE STARTING LINE NUMBER OF EACH SECTION              **
C               **  IN THE FILE (ATABLN)   (F10.0 FORMAT), AND            **
C               **  THE IDENTIFIER          FOR EACH SECTION              **
C               **  IN THE FILE (ITABID(.) (A12 FORMAT).                  **
C               ************************************************************
C
      NUMSEC=0
      DO4120I=1,100000
      READ(IOUNIT,4121,END=4180)ATABLN,ITABID(I)
 4121 FORMAT(F10.0,A12)
      IF(ITABID(I).EQ.'            ')GOTO4129
      NUMSEC=NUMSEC+1
      ITABLN(I)=ATABLN+0.5
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXP2')
     1WRITE(ICOUT,4122)I,ATABLN,ITABLN(I),ITABID(I)
 4122 FORMAT('I,ATABLN,ITABLN(I),ITABID(I) = ',I8,E15.7,I8,2X,A12)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXP2')
     1CALL DPWRST('XXX','BUG ')
 4120 CONTINUE
 4129 CONTINUE
      ANUMSE=NUMSEC
      GOTO4190
C
 4180 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4181)
 4181 FORMAT('***** INTERNAL ERROR IN DPEXP2 ',
     1'AT BRANCH POINT 4181--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4182)
 4182 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4183)
 4183 FORMAT('      WHILE READING THE LOOK-UP TABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4184)
 4184 FORMAT('      WITHIN A DATAPLOT EXPERT SUB-SYSTEM FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4185)IFILE
 4185 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4190 CONTINUE
C
C               *******************************************************
C               **  STEP 42--                                        **
C               **  BASED ON THE CODE STRING IN IEXPCO               **
C               **  DO A TABLE LOOK-UP WHICH WILL SPECIFY            **
C               **  THE ABSOLUTE LINE NUMBER IN THE FILE             **
C               **  WHERE THE SECTION WITH THAT CODE WORD STARTS     **
C               *******************************************************
C
      ISTEPN='42'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO4200I=1,NUMSEC
      I2=I
      IF(IEXPCO.EQ.ITABID(I))GOTO4210
 4200 CONTINUE
      JSEC=1
 4210 CONTINUE
      JSEC=I2
C
      ISTART=ITABLN(JSEC)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXP2')GOTO4290
      WRITE(ICOUT,4211)
 4211 FORMAT('***** FROM 4211 IN MIDDLE OF DPEXP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4213)JSEC,ISTART
 4213 FORMAT('JSEC,ISTART = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4290 CONTINUE
C
C               *************************************************
C               **  STEP 43--                                  **
C               **  READ DOWN IN THE FILE TO                   **
C               **  THE LINE BEFORE WHERE THE SECTION STARTS   **
C               *************************************************
C
      ISTEPN='43'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      REWIND(IOUNIT)
C
      ISKIP=ISTART-1
      IF(ISKIP.LE.0)GOTO4319
      DO4310I=1,ISKIP
      READ(IOUNIT,4315,END=4380)
 4315 FORMAT()
 4310 CONTINUE
 4319 CONTINUE
      GOTO4390
C
 4380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4381)
 4381 FORMAT('***** INTERNAL ERROR IN DPEXP2 ',
     1'AT BRANCH POINT 4381--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4382)
 4382 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4383)
 4383 FORMAT('      WHILE CARRYING OUT SKIPS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4384)
 4384 FORMAT('      WITHIN A DATAPLOT EXPERT SUB-SYSTEM FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4385)IFILE
 4385 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4390 CONTINUE
C
C               ***************************************************
C               **  STEP 45--                                    **
C               **  FOR THIS TARGET SECTION--                    **
C               **     1) SKIP OVER 2 HEADER LINES               **
C               **     2) READ IN (AND WRITE OUT) THE TEXT       **
C               **        FOR THE SECTION--                      **
C               **        (THIS IS WHAT THE ANALYST WILL SEE     **
C               **        ON THE SCREEN).                        **
C               **        THE LAST LINE OF THE TEXT IS           **
C               **        A LINE OF HYPHENS (THIS LINE IS        **
C               **        NOT PRINTED OUT).                      **
C               **     3) READ IN (AND STORE) THE NUMBER OF      **
C               **        MENU ITEMS THAT WERE OFFERED           **
C               **     4) READ IN (AND STORE) THE CODE WORD      **
C               **        (= SUBSEQUENT BRANCH POINT)            **
C               **        FOR EACH MENU ITEM                     **
C               ***************************************************
C
      ISTEPN='45'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      READ(IOUNIT,4505,END=4580)
 4505 FORMAT()
      READ(IOUNIT,4505,END=4580)
C
      WRITE(ICOUT,4511)IESCC,IFFC
 4511 FORMAT(2A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4512)IESCC
 4512 FORMAT(A1,'8')
      CALL DPWRST('XXX','BUG ')
C
CCCCC WRITE(ICOUT,4513)IEXPCO
C4513 FORMAT(58X,A12)
CCCCC CALL DPWRST('XXX','BUG ')
C
      DO4520I=1,100000
C
      READ(IOUNIT,4521,END=4580)ICTEXT
 4521 FORMAT(A80)
CCCCC IF(ICTEXT(1:5).EQ.'SSSSS')GOTO4590   DECEMBER 1986
CCCCC IF(ICTEXT(1:5).EQ.'EEEEE')GOTO4590   DECEMBER 1986
      IF(ICTEXT(1:5).EQ.'-----')GOTO4590
C
      DO4530J=1,80
      JREV=80-J+1
      IF(ICTEXT(JREV:JREV).NE.' ')GOTO4535
 4530 CONTINUE
      JREV=1
 4535 CONTINUE
      IF(JREV.LE.0)WRITE(ICOUT,999)
      IF(JREV.LE.0)CALL DPWRST('XXX','BUG ')
      IF(JREV.GE.1)WRITE(ICOUT,4536)(ICTEXT(K:K),K=1,JREV)
 4536 FORMAT(80A1)
      IF(JREV.GE.1)CALL DPWRST('XXX','BUG ')
C
 4520 CONTINUE
C
 4580 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4581)
 4581 FORMAT('***** INTERNAL ERROR IN DPEXP2 ',
     1'AT BRANCH POINT 4581--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4582)
 4582 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4583)
 4583 FORMAT('      WHILE READING WITHIN THE TARGET SECTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4584)
 4584 FORMAT('      WITHIN A DATAPLOT EXPERT SUB-SYSTEM FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4585)IFILE
 4585 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4586)JSEC,ISTART
 4586 FORMAT('JSEC,ISTART = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO5000
 4589 CONTINUE
C
 4590 CONTINUE
C
C               **************************************
C               **  STEP 50--                       **
C               **  CLOSE        THIS EXPERT FILE.  **
C               **************************************
C
 5000 CONTINUE
C
      ISTEPN='50'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXP2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IENDFI
 9028 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)ISKIP,ISTART,I2
 9051 FORMAT('ISKIP,ISTART,I2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IEXPSW
 9052 FORMAT('IEXPSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9054)IEXPCO,IEXPAL
 9054 FORMAT('IEXPCO,IEXPAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)NUMSEC
 9061 FORMAT('NUMSEC = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)JSEC,ITABLN(JSEC),ITABID(JSEC)
 9062 FORMAT('JSEC,ITABLN(JSEC),ITABID(JSEC) = ',2I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILLOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
C
C     PURPOSE--SCAN THE ARGUMENTS OF THE COMMAND LINE
C              FOR A KEY WORD AND EXTRACT INFORMATION
C              ABOUT A SELECTED ARGUMENT AFTER THE KEY WORD.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --JULY      1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IKEY
      CHARACTER*4 IKEY2
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 INCLUN
      CHARACTER*4 IANS
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IFOUN1
      CHARACTER*4 IFOUN2
      CHARACTER*4 IHOUT
      CHARACTER*4 IHOUT2
      CHARACTER*4 IUOUT
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IVALID
      CHARACTER*4 IANS2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IANS(*)
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
C
      DIMENSION IANS2(50)
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='DPEX'
      ISUBN2='QU  '
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 DPEXQU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IKEY,IKEY2,ISHIFT,ILOCA,ILOCB
   52 FORMAT('IKEY,IKEY2,ISHIFT,ILOCA,ILOCB = ',A4,A4,I8,2X,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IANS(I),I=1,IWIDTH)
   54 FORMAT('IANS(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMARG
   55 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO57I=1,NUMARG
      WRITE(ICOUT,58)I,IHARG(I),IHARG2(I)
   58 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
   57 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
      IFOUN1='NO'
      IFOUN2='NO'
      IHOUT='JUNK'
      IHOUT2='JUNK'
      ILLOUT=-99
      IVOUT=-99
      VOUT=-99
      IUOUT='U'
      INOUT=-99
      IERROR='NO'
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH THE COMMAND LINE ARGUMENTS  **
C               **  FOR THE WORD CONTAINED IN IKEY.    **
C               **  STORE THE LOCATION IN ILOC1.       **
C               *****************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO200I=ILOCA,ILOCB
      I2=I
      IF(IHARG(I).EQ.IKEY.AND.IHARG2(I).EQ.IKEY2)GOTO210
  200 CONTINUE
      IFOUN1='NO'
      IFOUN2='NO'
      GOTO9000
  210 CONTINUE
      IFOUN1='YES'
      ILOC1=I2
C
C               ***************************************************
C               **  STEP 3--                                     **
C               **  SEARCH FOR THE COMMAND LINE ARGUMENT         **
C               **  SHIFTED    ISHIFT    ARGUMENTS TO THE RIGHT  **
C               **  OF THE KEY WORD.                             **
C               **  STORE THE LOCATION IN ILOC2.                 **
C               **  STORE THE FOUND WORD IN IHOUT.               **
C               ***************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      I2=I2+ISHIFT
      IF(ILOCA.LE.I2.AND.I2.LE.ILOCB)GOTO310
      IFOUN2='NO'
      GOTO9000
  310 CONTINUE
      IFOUN2='YES'
      ILOC2=I2
      IHOUT=IHARG(ILOC2)
      IHOUT2=IHARG2(ILOC2)
C
C               **************************************************************
C               **  STEP 4--                                                **
C               **  DETERMINE THE CHARACTERISTICS OF                        **
C               **  THIS SECOND ARGUMENT--                                  **
C               **       ILLOUT = LINE NUMBER IN IHNAME(.)LIST;              **
C               **       IVOUT = INTEGER VALUE ASSOCIATED WITH IT           **
C               **               (E.G., COLUMN NUMBER FOR A VARIABLE);      **
C               **       VOUT  = FLOATING POINT VALUE ASSOCIATED WITH IT    **
C               **               (E.G., VALUE OF A PARAMETER OR CONSTANT);  **
C               **       IUOUT = TYPE OF ARGUMENT                           **
C               **               (V = VARIABLE, P = PARAMETER,              **
C               **               C = CONSTANT, U = UNKNOWN);                **
C               **       INOUT = INTEGER VALUE DENOTING                     **
C               **               THE NUMBER OF OBSERVATIONS IN THE COLUMN   **
C               **               FOR A VARIABLE.                            **
C               **************************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *****************************************
C               **  STEP 4.1--                         **
C               **  SEARCH FOR VARIABLE OR PARAMETER.  **
C               *****************************************
C
      IF(NUMNAM.LE.0)GOTO408
      DO400I=1,NUMNAM
      I2=I
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'1   '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'2   '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'3   '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'4   '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'5   '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'6   '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'7   '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'8   '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'9   '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
CCCCC IF(INCLUN.EQ.'NO'.AND.IHNAME(I).EQ.'10  '.AND.
CCCCC1IHNAM2(I).EQ.'    '.AND.IUSE(I).EQ.'V')GOTO400
      IF(IHOUT.EQ.IHNAME(I).AND.IHOUT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO409
      IF(IHOUT.EQ.IHNAME(I).AND.IHOUT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO409
  400 CONTINUE
  408 CONTINUE
      GOTO419
  409 CONTINUE
C
      ILLOUT=I2
      IVOUT=IVALUE(I2)
      VOUT=VALUE(I2)
      IUOUT=IUSE(I2)
      INOUT=IN(I2)
      GOTO9000
  419 CONTINUE
C
C               **************************************************************
C               **  STEP 4.2--                                              **
C               **  EXTRACT THE 1H HOLLERITH REPRESENTATION                 **
C               **  OF IHOUT.                                               **
C               **  COPY ALSO THE 1H CONTINUATION OF THE WORD IF EXISTENT.  **
C               **************************************************************
C
      ISTEPN='4.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPWDST(IKEY,IKEY2,ISHIFT,IHOUT,IHOUT2,IANS,IWIDTH,
     1IANS2,N2,IBUGA3,IERROR)
C
C               ********************************
C               **  STEP 4.3--                **
C               **  TREAT THE CONSTANT CASE.  **
C               ********************************
C
      ISTEPN='4.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPHOCO(IANS2,N2,IVALID,VALCON,IBUGA3,IERROR)
      IF(IVALID.EQ.'YES')GOTO460
      GOTO469
  460 CONTINUE
      IVOUT=VALCON
      VOUT=VALCON
      IUOUT='N'
      INOUT=0
      GOTO9000
  469 CONTINUE
C
C               *********************************************
C               **  STEP 4.4--                             **
C               **  TREAT THE ELEMENT OF A VARIABLE CASE.  **
C               *********************************************
C
      ISTEPN='4.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC CALL DPHOEV(IANS2,N2,IV,IHNAME,IHNAM2,IUSE,IVALUE,VALUE,
CCCCC1IUSE,NUMNAM,IFOUND,VALEV,IBUGA3,IERROR)
CCCCC IF(IFOUND.EQ.'YES')GOTO475
CCCCC GOTO479
CC475 CONTINUE
CCCCC IVOUT=VALEV
CCCCC VOUT=VALEV
CCCCC IVOUT='EV'
CCCCC INOUT=0
CCCCC GOTO9000
CC479 CONTINUE
CCCCCC
CCCCC IUOUT='U'
CC489 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXQU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOC1,ILOC2,IFOUN1,IFOUN2
 9012 FORMAT('ILOC1,ILOC2,IFOUN1,IFOUN2 = ',I8,I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IHOUT,IHOUT2,ILLOUT,IVOUT,VOUT,IUOUT,INOUT
 9013 FORMAT('IHOUT,IHOUT2,ILLOUT,IVOUT,VOUT,IUOUT,INOUT = ',
     1A4,A4,I8,I8,E15.7,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IERROR
 9014 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXS1(ISTRIN,ISTART,ISTOP,K,MESSAG,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--SCAN THE CHARACTER*130 STRING ISTRIN
C              BETWEEN COLUMNS ISTART TO ISTOP
C              AND EXTRACT THE K-TH STRING.
C              DEBLANK THIS STRING, PLACE IT INTO
C              THE CHARACTER*130 STRING ISTRI2,
C              AND PLACE THE LENGTH OF
C              THE STRING INTO NCSTR2.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--JANUARY   1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*130 ISTRIN
      CHARACTER*130 ISTRI2
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 MESSAG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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='DPEX'
      ISUBN2='S1  '
C
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXS1')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXS1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MESSAG,IBUGS2,ISUBRO,IERROR
   53 FORMAT('MESSAG,IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(ISTRIN(J:J),J=1,100)
   54 FORMAT('(ISTRIN(J:J),J=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ISTART,ISTOP
   55 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)K
   56 FORMAT('K      = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************
C               **  STEP 11--                       **
C               **  INITIALIZE THE OUTPUT VARIABLES **
C               **************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXS1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1100I=1,130
      ISTRI2(I:I)=' '
 1100 CONTINUE
      NCSTR2=0
C
C               *******************************************
C               **  STEP 12--                            **
C               **  CHECK THE INPUT ARGUMENTS            **
C               *******************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXS1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTART.GE.1.AND.ISTOP.GE.1.AND.
     1   ISTART.LE.130.AND.ISTOP.LE.130)GOTO1219
      IF(MESSAG.EQ.'OFF')GOTO1218
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPEXS1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      ISTART OR ISTOP IS < 1 OR > 130. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)ISTART
 1213 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)ISTOP
 1214 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)(ISTRIN(I:I),I=1,100)
 1216 FORMAT('      (ISTRIN(I:I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
 1218 CONTINUE
      IERROR='YES'
      GOTO9000
 1219 CONTINUE
C
      IF(ISTART.LE.ISTOP)GOTO1229
      IF(MESSAG.EQ.'OFF')GOTO1228
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** ERROR IN DPEXS1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)
 1222 FORMAT('      ISTART EXCEEDS ISTOP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)ISTART
 1223 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1224)ISTOP
 1224 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)(ISTRIN(I:I),I=1,100)
 1226 FORMAT('      (ISTRIN(I:I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
 1228 CONTINUE
      IERROR='YES'
      GOTO9000
 1229 CONTINUE
C
      IF(K.GE.1)GOTO1239
      IF(MESSAG.EQ.'OFF')GOTO1238
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1231)
 1231 FORMAT('***** ERROR IN DPEXS1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1232)
 1232 FORMAT('      K      IS LESS THAN 1 .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1233)K
 1233 FORMAT('      K       = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1236)(ISTRIN(I:I),I=1,100)
 1236 FORMAT('      (ISTRIN(I:I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
 1238 CONTINUE
      IERROR='YES'
      GOTO9000
 1239 CONTINUE
C
C               ************************************************
C               **  STEP 21--                                 **
C               **  IDENTIFY THE COLUMNS WHERE                **
C               **  THE K     -TH STRING RESIDES              **
C               **  ICOL1 = START COLUMN OF A STRING          **
C               **  ICOL2 = STOP  COLUMN OF A STRING          **
C               ************************************************
C
      ICOL2=ISTART-1
      DO2100ILOOP=1,K
C
      ICOL1=ISTOP+1
      IMIN=ICOL2+1
      IF(IMIN.GT.ISTOP)GOTO2119
      DO2110I=IMIN,ISTOP
      I2=I
      IF(ISTRIN(I:I).NE.' ')GOTO2115
 2110 CONTINUE
      ICOL1=ISTOP+1
      GOTO2119
 2115 CONTINUE
      ICOL1=I2
      GOTO2119
 2119 CONTINUE
C
      ICOL2=ISTOP
      IMIN=ICOL1+1
      IF(IMIN.GT.ISTOP)GOTO2129
      DO2120I=IMIN,ISTOP
      I2=I
      IF(ISTRIN(I:I).EQ.' ')GOTO2125
 2120 CONTINUE
      ICOL2=ISTOP
      GOTO2129
 2125 CONTINUE
      ICOL2=I2-1
      GOTO2129
 2129 CONTINUE
 
      IF(ICOL1.GE.ISTART.AND.ICOL2.GE.ISTART.AND.
     1   ICOL1.LE.ISTOP.AND.ICOL2.LE.ISTOP)GOTO2139
      IF(MESSAG.EQ.'OFF')GOTO2138
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2131)
 2131 FORMAT('***** ERROR IN DPEXS1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2132)
 2132 FORMAT('      ICOL1 OR ICOL2 IS < ISTART OR > ISTOP. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2133)ICOL1
 2133 FORMAT('      ICOL1  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2134)ICOL2
 2134 FORMAT('      ICOL2  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2135)ISTART
 2135 FORMAT('      ISTART = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2136)ISTOP
 2136 FORMAT('      ISTOP  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2137)(ISTRIN(I:I),I=1,100)
 2137 FORMAT('      (ISTRIN(I:I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
 2138 CONTINUE
      IERROR='YES'
      GOTO9000
 2139 CONTINUE
C
      IF(ICOL1.LE.ICOL2)GOTO2149
      IF(MESSAG.EQ.'OFF')GOTO2148
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2141)
 2141 FORMAT('***** ERROR IN DPEXS1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2142)
 2142 FORMAT('      ICOL1 EXCEEDS ICOL2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2143)ICOL1
 2143 FORMAT('      ICOL1  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2144)ICOL2
 2144 FORMAT('      ICOL2  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)(ISTRIN(I:I),I=1,100)
 2146 FORMAT('      (ISTRIN(I:I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
 2148 CONTINUE
      IERROR='YES'
      GOTO9000
 2149 CONTINUE
C
 2100 CONTINUE
C
C               *********************************************
C               **  STEP 22--                              **
C               **  COPY THE K     -TH STRING INTO ISTRI2  **
C               *********************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXS1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      DO2200I=ICOL1,ICOL2
      J=J+1
      ISTRI2(J:J)=ISTRIN(I:I)
 2200 CONTINUE
      NCSTR2=J
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXS1')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXS1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MESSAG,IBUGS2,ISUBRO,IERROR
 9013 FORMAT('MESSAG,IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(ISTRIN(J:J),J=1,100)
 9014 FORMAT('(ISTRIN(J:J),J=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ISTART,ISTOP
 9015 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)K
 9016 FORMAT('K      = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICOL1,ICOL2
 9021 FORMAT('ICOL1, ICOL2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)NCSTR2
 9022 FORMAT('NCSTR2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR2.GE.1)WRITE(ICOUT,9023)(ISTRI2(I:I),I=1,NCSTR2)
 9023 FORMAT('(ISTRI2(I:I),I=1,NCSTR2) = ',100A1)
      IF(NCSTR2.GE.1)CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXS2(IFOLOC,IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IANS,IWIDTH,
     1IHPN,IHPN2,ASTART,AINC,ASTOP,NUMINC,ILALOC,IBUGA3,IFOUND,IERROR)
C
C     NOTE--THIS SUBROUTINE IS IDENTICAL TO SUBROUTINE DPEXSE
C           AND HAS BEEN CREATED SO AS TO ACHIEVE
C           STORAGE ECONOMY IN THE MAPPING/LOADING.
C
C     PURPOSE--EXTRACT THE SEQUENCE OF VALUES
C            AS DICTATED BY A FOR SPECIFICATION.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IANS
      CHARACTER*4 IHPN
      CHARACTER*4 IHPN2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IVDU11
      CHARACTER*4 IVDU12
      CHARACTER*4 IVDU21
      CHARACTER*4 IVDU22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      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
      ISUBN1='DPEX'
      ISUBN2='S2  '
C
      IERROR='NO'
      IFOUND='NO'
C
      IFOUND='YES'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IFOLOC
   52 FORMAT('IFOLOC = ',I8)
      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),IHARG2(I),ARG(I)
   56 FORMAT('I,IHARG(I),IHARG2(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 3--                                        **
C               **  DETERMINE THE NAME OF THE  NEXT  DUMMY VARIABLE **
C               **  (IT NEVER GETS STORED PERMANENTLY)               **
C               **  IMMEDIATELY FOLLOWING THE        'FOR' KEYWORD   **
C               *******************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFOLOC.LT.NUMARG)GOTO3139
      WRITE(ICOUT,3121)
 3121 FORMAT('***** ERROR IN DPEXS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3122)
 3122 FORMAT('      THE       FOR    WAS THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3123)
 3123 FORMAT('      FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3124)
 3124 FORMAT('      THE WORD    FOR    SHOULD HAVE BEEN FOLLOWED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3125)
 3125 FORMAT('      BY 5    WORDS   --')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3126)
 3126 FORMAT('      1) A DUMMY VARIABLE NAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3127)
 3127 FORMAT('      2) AN EQUAL SIGN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3128)
 3128 FORMAT('      3) ONE LIMIT (LOWER OR UPPER) ',
     1'FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3129)
 3129 FORMAT('      4) THE INCREMENT FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3130)
 3130 FORMAT('      5) THE OTHER LIMIT (UPPER OR LOWER) ',
     1'FOR THE DUMMY VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3136)
 3136 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3137)(IANS(I),I=1,IWIDTH)
 3137 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3139 CONTINUE
      IFOLP1=IFOLOC+1
      IVDU11=IHARG(IFOLP1)
      IVDU12=IHARG2(IFOLP1)
C
C               *******************************************************
C               **  STEP 3.1--                                     **
C               **  DETERMINE THE NAME OF THE        DUMMY VARIABLE  **
C               **  (IT NEVER GETS STORED PERMANENTLY)               **
C               **  IMMEDIATELY FOLLOWING THE        'FOR' KEYWORD   **
C               *******************************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOLP2=IFOLOC+2
      IF(IFOLOC.GT.NUMARG)GOTO3159
      IF(IHARG(IFOLOC).EQ.'FOR')GOTO3169
C3150 CONTINUE
 3159 CONTINUE
C
      IBRAN=3161
      WRITE(ICOUT,3161)
 3161 FORMAT('***** ERROR IN DPEXS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3162)
 3162 FORMAT('      THE        FOR    NOT FOUND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3163)
 3163 FORMAT('      EVEN THOUGH THE STRING    =    WAS FOUND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3164)
 3164 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3165)(IANS(I),I=1,IWIDTH)
 3165 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3169 CONTINUE
C
      IF(IFOLOC.LT.NUMARG)GOTO3189
      WRITE(ICOUT,3171)
 3171 FORMAT('***** ERROR IN DPEXS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3172)
 3172 FORMAT('      THE        FOR    WAS THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3173)
 3173 FORMAT('      FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3174)
 3174 FORMAT('      THE WORD    FOR    SHOULD HAVE BEEN FOLLOWED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3175)
 3175 FORMAT('      BY 5    WORDS   --')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3176)
 3176 FORMAT('      1) A DUMMY VARIABLE NAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3177)
 3177 FORMAT('      2) AN EQUAL SIGN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3178)
 3178 FORMAT('      3) ONE LIMIT (LOWER OR UPPER) ',
     1'FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3179)
 3179 FORMAT('      4) THE INCREMENT FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3180)
 3180 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,3186)
 3186 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3187)(IANS(I),I=1,IWIDTH)
 3187 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3189 CONTINUE
      IFOLP1=IFOLOC+1
      IVDU21=IHARG(IFOLP1)
      IVDU22=IHARG2(IFOLP1)
C
C               *******************************************
C               **  STEP 4--                             **
C               **  EVALUATE THE FUNCTION OVER           **
C               **  THE VARIOUS POINTS IN THE INTERVAL.  **
C               *******************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOLP1=IFOLOC+1
      IFOLP3=IFOLOC+3
      IFOLP4=IFOLOC+4
      IFOLP5=IFOLOC+5
C
      IHPN=IHARG(IFOLP1)
      IHPN2=IHARG2(IFOLP1)
C
      ASTART=ARG(IFOLP3)
C
      AINC=0.0
      IF(IFOLP4.GT.NUMARG)GOTO3240
      IF(IHARG(IFOLP4).EQ.'FOR '.AND.IHARG2(IFOLP4).EQ.'    ')GOTO3240
      IF(IHARG(IFOLP4).EQ.'SUBS'.AND.IHARG2(IFOLP4).EQ.'ET  ')GOTO3240
      IF(IHARG(IFOLP4).EQ.'EXCE'.AND.IHARG2(IFOLP4).EQ.'PT  ')GOTO3240
      AINC=ARG(IFOLP4)
 3240 CONTINUE
C
      ASTOP=ASTART
      IF(IFOLP4.GT.NUMARG)GOTO3250
      IF(IHARG(IFOLP4).EQ.'FOR '.AND.IHARG2(IFOLP4).EQ.'    ')GOTO3250
      IF(IHARG(IFOLP4).EQ.'SUBS'.AND.IHARG2(IFOLP4).EQ.'ET  ')GOTO3250
      IF(IHARG(IFOLP4).EQ.'EXCE'.AND.IHARG2(IFOLP4).EQ.'PT  ')GOTO3250
      ASTOP=ARG(IFOLP5)
 3250 CONTINUE
C
      NUMINC=0
      IF(AINC.NE.0.0)NUMINC=(ASTOP-ASTART)/AINC
      IF(NUMINC.LT.0)NUMINC=-NUMINC
      NUMINC=NUMINC+1
C
      ILALOC=IFOLP3
      IF(IFOLP4.GT.NUMARG)GOTO3260
      IF(IHARG(IFOLP4).EQ.'FOR '.AND.IHARG2(IFOLP4).EQ.'    ')GOTO3260
      IF(IHARG(IFOLP4).EQ.'SUBS'.AND.IHARG2(IFOLP4).EQ.'ET  ')GOTO3260
      IF(IHARG(IFOLP4).EQ.'EXCE'.AND.IHARG2(IFOLP4).EQ.'PT  ')GOTO3260
      ILALOC=IFOLP5
 3260 CONTINUE
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IHPN,IHPN2
 9012 FORMAT('IHPN,IHPN2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ASTART,AINC,ASTOP
 9013 FORMAT('ASTART,AINC,ASTOP = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMINC
 9014 FORMAT('NUMINC = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ILALOC
 9015 FORMAT('ILALOC = ',I8)
      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 DPEXS3(ISEED,XMAT,N,NUMFAC,Y,
     1IBUGA3,ISUBRO,IERROR)
C
CCCCC SUBROUTINE DPEXS3(ISIMID,IAUTH,IBOOK,IPAGE,
CCCCC1GMEAN,INDEXB,B,NUMB,
CCCCC1GSD,INDEXS,S,NUMS,
CCCCC1DMINT,DMSLOP,
CCCCC1DSINT,DSSLOP,
C
C     PURPOSE--GENERATE SIMULATED RESPONSES
C              FROM AN EXPERIMENTAL MODEL.
C     INPUT  ARGUMENTS--IPAGE  = PAGE NUMBER
C                       ISEED   = CURRENT VALUE OF RANDOM NUMBER SEED
C                       X1      = FACTOR 1
C                       X2      = FACTOR 2
C                       X3      = FACTOR 3
C                       .
C                       .
C                       .
C                       N       = NUMBER OF ELEMENTS IN EACH FACTOR.
C                       NUMFAC   = NUMBER OF FACTORS PROVIDED.
C     OUTPUT ARGUMENTS--Y      = A SINGLE PRECISION VECTOR
C                                INTO WHICH THE GENERATED
C                                SIMULATED RESPONSE WILL BE PLACED.
C     OUTPUT--A SIMULATED SAMPLE OF SIZE N
C             FROM THE MODEL
C                Y = F(X1,X2,X3, ...) + RANDOM ERROR
C                  + DMINT + DMSLOP*TIME + RANDOM ERROR
C             WHERE (FOR EXAMPLE)
C                F(X1,X2,X3) =
C                B0 + 0.5 * [ B1*X1 + B2*X2 + B3*X3 +
C                B12*X1*X2 + B13*X1*X3 + B23*X2*X3 +
C                B123*X1*X2*X3) ]
C             WHERE
C                XK = TAKES ON 2 VALUES: +1 AND -1
C             AND WHERE
C                B0 = 71.25
C                B1 = 23
C                B2 = -5
C                B3 = 1.5
C                B12 = 1.5
C                B13 = 10
C                B23 = 0
C                B123 = 0.5
C             AND
C                SD(ERROR) = 0.1
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--89.1
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --APRIL   1992.  NUMCOL TO NUMFAC
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
C
      DIMENSION XMAT(20,20)
C
      DIMENSION IDIGIT(10)
C
      DIMENSION DET(100)
C
      DIMENSION Z1(100)
      DIMENSION SRAND1(100)
      DIMENSION RAND1(100)
C
      DIMENSION TIME(100)
C
      DIMENSION Z2(100)
      DIMENSION SRAND2(100)
      DIMENSION RAND2(100)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODE.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'DEX3')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXS3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ISIMID,N,NUMFAC
   53 FORMAT('ISIMID,N,NUMFAC = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO56I=1,N
CCCCC THE FOLLOWING 2 LINES WERE CHANGED   APRIL 1992  (ALAN)
CCCCC WRITE(ICOUT,57)I,(XMAT(I,J),J=1,NUMCOL)
CCC57 FORMAT('I,(XMAT(I,J),J=1,NUMCOL) = ',I8,10F7.1)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)I,(XMAT(I,J),J=1,NUMFAC)
   57 FORMAT('I,(XMAT(I,J),J=1,NUMFAC) = ',I8,10F7.1)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   90 CONTINUE
C
      HALF=0.5
C
C               **************************************************
C               **  STEP 11--                                   **
C               **  DEFINE THE DEFAULT MODEL                    **
C               **************************************************
C
      IF(ISIMID.LE.1)GOTO1100
      GOTO1190
C
 1100 CONTINUE
      GMEAN=71.25
      NUMB=7
      INDEXB(1)=1
      INDEXB(2)=2
      INDEXB(3)=3
      INDEXB(4)=12
      INDEXB(5)=13
      INDEXB(6)=23
      INDEXB(7)=123
      B(1)=23.0
      B(2)=(-5.0)
      B(3)=1.5
      B(4)=1.5
      B(5)=10.0
      B(6)=0.0
      B(7)=0.5
C
CCCCC GSD=0.1
      GSD=0.0
      NUMS=0
C
      DMINT=0.0
      DMSLOP=0.0
C
      DSINT=0.0
      DSSLOP=0.0
C
 1190 CONTINUE
C
C               **************************************************
C               **  STEP 21--                                   **
C               **  COMPUTE THE DETERMINISTIC COMPONENT         **
C               **************************************************
C
      IF(N.LE.0)GOTO2119
      DO2110I=1,N
      SUM=0.0
      SUM=SUM+GMEAN
C
      IF(NUMB.LE.0)GOTO2129
      DO2120J=1,NUMB
      TERM1=B(J)
      TERM2=1.0
      J2=INDEXB(J)
      CALL EXTDIG(J2,IDIGIT,NDIGIT,IBUGA3,IERROR)
C
      IF(NDIGIT.LE.0)GOTO2139
      DO2130K=1,NDIGIT
      L=IDIGIT(K)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DEX3')
     1WRITE(ICOUT,2131)NDIGIT,K,L,I,TERM2,XMAT(I,L)
 2131 FORMAT('NDIGIT,K,L,I,TERM2,XMAT(I,L) = ',4I8,2E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DEX3')
     1CALL DPWRST('XXX','BUG ')
      TERM2=TERM2*XMAT(I,L)
 2130 CONTINUE
 2139 CONTINUE
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DEX3')
     1WRITE(ICOUT,2132)I,SUM,TERM1,TERM2
 2132 FORMAT('I,SUM,TERM1,TERM2 = ',I8,3E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DEX3')
     1CALL DPWRST('XXX','BUG ')
      SUM=SUM+HALF*TERM1*TERM2
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DEX3')
     1WRITE(ICOUT,2133)I,SUM,TERM1,TERM2
 2133 FORMAT('I,SUM,TERM1,TERM2 = ',I8,3E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DEX3')
     1CALL DPWRST('XXX','BUG ')
 2120 CONTINUE
 2129 CONTINUE
C
      DET(I)=SUM
CCCCC WRITE(ICOUT,778)I,DET(I)
CC778 FORMAT('I,DET(I) = ',I8,E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
 2110 CONTINUE
 2119 CONTINUE
C
C               **************************************************
C               **  STEP 22--                                   **
C               **  COMPUTE THE RANDOM COMPONENT                **
C               **************************************************
C
      CALL NORRAN(N,ISEED,Z1)
C
      IF(N.LE.0)GOTO2219
      DO2210I=1,N
      SUM=0.0
      SUM=SUM+GSD
C
      IF(NUMS.LE.0)GOTO2229
      DO2220J=1,NUMS
      TERM1=S(J)
      TERM2=1.0
      J2=INDEXS(J)
      CALL EXTDIG(J2,IDIGIT,NDIGIT,IBUGA3,IERROR)
C
      IF(NDIGIT.LE.0)GOTO2239
      DO2230K=1,NDIGIT
      L=IDIGIT(K)
      TERM2=TERM2*XMAT(I,L)
 2230 CONTINUE
 2239 CONTINUE
C
      SUM=SUM+HALF*TERM1*TERM2
 2220 CONTINUE
 2229 CONTINUE
C
      SRAND1(I)=SUM
      RAND1(I)=Z1(I)*SRAND1(I)
 2210 CONTINUE
 2219 CONTINUE
C
C               **************************************************
C               **  STEP 23--                                   **
C               **  COMPUTE THE CONTRIBUTION DUE TO A           **
C               **  CHANGE IN LOCATION WITH TIME (DRIFT)        **
C               **************************************************
C
      DO2300I=1,N
      AI=I
      TIME(I)=DMINT*DMSLOP*AI
 2300 CONTINUE
C
C               **************************************************
C               **  STEP 24--                                   **
C               **  COMPUTE THE CONTRIBUTION DUE TO A           **
C               **  CHANGE IN VARIATION WITH TIME               **
C               **************************************************
C
      CALL NORRAN(N,ISEED,Z2)
      DO2400I=1,N
      AI=I
      SRAND2(I)=DSINT+DSSLOP*AI
      RAND2(I)=Z2(I)*SRAND2(I)
 2400 CONTINUE
C
C               **************************************************
C               **  STEP 29--                                   **
C               **  COMPUTE THE FINAL RESPONSE =                **
C               **  SUM OF ALL CONTRIBUTIONS                    **
C               **************************************************
C
      DO2900I=1,N
      Y(I)=DET(I)+RAND1(I)+TIME(I)+RAND2(I)
CCCCC WRITE(ICOUT,779)I,DET(I),RAND1(I),Y(I)
CC779 FORMAT('I,DET(I),RAND1(I),Y(I) = ',I8,3E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2911)I,Y(I),(XMAT(I,J),J=1,NUMFAC)
 2911 FORMAT(I4,'--','RESULT = ',F10.5,5X,15F7.2)
      CALL DPWRST('XXX','BUG ')
 2900 CONTINUE
C
C               **************************************************
C               **   STEP 90--                                  **
C               **   EXIT                                       **
C               **************************************************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'DEX3')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXS3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3
 9012 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ISIMID,N,NUMFAC
 9013 FORMAT('ISIMID,N,NUMFAC = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,XMAT(I,1),XMAT(I,2),XMAT(I,3),Y(I)
 9017 FORMAT('I,XMAT(I,1),XMAT(I,2),XMAT(I,3),Y(I) = ',I8,6E11.4)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
      WRITE(ICOUT,9021)GMEAN
 9021 FORMAT('GMEAN = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)TERM1,TERM2,SUM
 9022 FORMAT('TERM1,TERM2,SUM = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXSE(IFOLOC,IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IANS,IWIDTH,
     1IHPN,IHPN2,ASTART,AINC,ASTOP,NUMINC,ILALOC,IBUGA3,IFOUND,IERROR)
C
C     PURPOSE--EXTRACT THE SEQUENCE OF VALUES
C            AS DICTATED BY A FOR SPECIFICATION.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER    1981.
C     UPDATED         --NOVEMBER   1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IANS
      CHARACTER*4 IHPN
      CHARACTER*4 IHPN2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IVDU11
      CHARACTER*4 IVDU12
      CHARACTER*4 IVDU21
      CHARACTER*4 IVDU22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      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
      ISUBN1='DPEX'
      ISUBN2='SE  '
C
      IERROR='NO'
      IFOUND='NO'
C
      IFOUND='YES'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXSE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IFOLOC
   52 FORMAT('IFOLOC = ',I8)
      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),IHARG2(I),ARG(I)
   56 FORMAT('I,IHARG(I),IHARG2(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 3--                                        **
C               **  DETERMINE THE NAME OF THE  NEXT  DUMMY VARIABLE **
C               **  (IT NEVER GETS STORED PERMANENTLY)               **
C               **  IMMEDIATELY FOLLOWING THE        'FOR' KEYWORD   **
C               *******************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFOLOC.LT.NUMARG)GOTO3139
      WRITE(ICOUT,3121)
 3121 FORMAT('***** ERROR IN DPEXSE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3122)
 3122 FORMAT('      THE       FOR    WAS THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3123)
 3123 FORMAT('      FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3124)
 3124 FORMAT('      THE WORD    FOR    SHOULD HAVE BEEN FOLLOWED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3125)
 3125 FORMAT('      BY 5    WORDS   --')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3126)
 3126 FORMAT('      1) A DUMMY VARIABLE NAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3127)
 3127 FORMAT('      2) AN EQUAL SIGN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3128)
 3128 FORMAT('      3) ONE LIMIT (LOWER OR UPPER) ',
     1'FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3129)
 3129 FORMAT('      4) THE INCREMENT FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3130)
 3130 FORMAT('      5) THE OTHER LIMIT (UPPER OR LOWER) ',
     1'FOR THE DUMMY VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3136)
 3136 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3137)(IANS(I),I=1,IWIDTH)
 3137 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3139 CONTINUE
      IFOLP1=IFOLOC+1
      IVDU11=IHARG(IFOLP1)
      IVDU12=IHARG2(IFOLP1)
C
C               *******************************************************
C               **  STEP 3.1--                                     **
C               **  DETERMINE THE NAME OF THE        DUMMY VARIABLE  **
C               **  (IT NEVER GETS STORED PERMANENTLY)               **
C               **  IMMEDIATELY FOLLOWING THE        'FOR' KEYWORD   **
C               *******************************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOLP2=IFOLOC+2
      IF(IFOLOC.GT.NUMARG)GOTO3159
      IF(IHARG(IFOLOC).EQ.'FOR')GOTO3169
C3150 CONTINUE
 3159 CONTINUE
C
      IBRAN=3161
      WRITE(ICOUT,3161)
 3161 FORMAT('***** ERROR IN DPEXSE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3162)
 3162 FORMAT('      THE        FOR    NOT FOUND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3163)
 3163 FORMAT('      EVEN THOUGH THE STRING    =    WAS FOUND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3164)
 3164 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3165)(IANS(I),I=1,IWIDTH)
 3165 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3169 CONTINUE
C
      IF(IFOLOC.LT.NUMARG)GOTO3189
      WRITE(ICOUT,3171)
 3171 FORMAT('***** ERROR IN DPEXSE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3172)
 3172 FORMAT('      THE        FOR    WAS THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3173)
 3173 FORMAT('      FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3174)
 3174 FORMAT('      THE WORD    FOR    SHOULD HAVE BEEN FOLLOWED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3175)
 3175 FORMAT('      BY 5    WORDS   --')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3176)
 3176 FORMAT('      1) A DUMMY VARIABLE NAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3177)
 3177 FORMAT('      2) AN EQUAL SIGN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3178)
 3178 FORMAT('      3) ONE LIMIT (LOWER OR UPPER) ',
     1'FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3179)
 3179 FORMAT('      4) THE INCREMENT FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3180)
 3180 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,3186)
 3186 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3187)(IANS(I),I=1,IWIDTH)
 3187 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3189 CONTINUE
      IFOLP1=IFOLOC+1
      IVDU21=IHARG(IFOLP1)
      IVDU22=IHARG2(IFOLP1)
C
C               *******************************************
C               **  STEP 4--                             **
C               **  EVALUATE THE FUNCTION OVER           **
C               **  THE VARIOUS POINTS IN THE INTERVAL.  **
C               *******************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOLP1=IFOLOC+1
      IFOLP3=IFOLOC+3
      IFOLP4=IFOLOC+4
      IFOLP5=IFOLOC+5
C
      IHPN=IHARG(IFOLP1)
      IHPN2=IHARG2(IFOLP1)
C
      ASTART=ARG(IFOLP3)
C
      AINC=0.0
      IF(IFOLP4.GT.NUMARG)GOTO3240
      IF(IHARG(IFOLP4).EQ.'FOR '.AND.IHARG2(IFOLP4).EQ.'    ')GOTO3240
      IF(IHARG(IFOLP4).EQ.'SUBS'.AND.IHARG2(IFOLP4).EQ.'ET  ')GOTO3240
      IF(IHARG(IFOLP4).EQ.'EXCE'.AND.IHARG2(IFOLP4).EQ.'PT  ')GOTO3240
      AINC=ARG(IFOLP4)
 3240 CONTINUE
C
      ASTOP=ASTART
      IF(IFOLP4.GT.NUMARG)GOTO3250
      IF(IHARG(IFOLP4).EQ.'FOR '.AND.IHARG2(IFOLP4).EQ.'    ')GOTO3250
      IF(IHARG(IFOLP4).EQ.'SUBS'.AND.IHARG2(IFOLP4).EQ.'ET  ')GOTO3250
      IF(IHARG(IFOLP4).EQ.'EXCE'.AND.IHARG2(IFOLP4).EQ.'PT  ')GOTO3250
      ASTOP=ARG(IFOLP5)
 3250 CONTINUE
C
      NUMINC=0
      IF(AINC.NE.0.0)NUMINC=(ASTOP-ASTART)/AINC
      IF(NUMINC.LT.0)NUMINC=-NUMINC
      NUMINC=NUMINC+1
C
      ILALOC=IFOLP3
      IF(IFOLP4.GT.NUMARG)GOTO3260
      IF(IHARG(IFOLP4).EQ.'FOR '.AND.IHARG2(IFOLP4).EQ.'    ')GOTO3260
      IF(IHARG(IFOLP4).EQ.'SUBS'.AND.IHARG2(IFOLP4).EQ.'ET  ')GOTO3260
      IF(IHARG(IFOLP4).EQ.'EXCE'.AND.IHARG2(IFOLP4).EQ.'PT  ')GOTO3260
      ILALOC=IFOLP5
 3260 CONTINUE
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXSE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IHPN,IHPN2
 9012 FORMAT('IHPN,IHPN2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ASTART,AINC,ASTOP
 9013 FORMAT('ASTART,AINC,ASTOP = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMINC
 9014 FORMAT('NUMINC = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ILALOC
 9015 FORMAT('ILALOC = ',I8)
      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 DPEXSI(ISEED,XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT AN EXPERIMENTAL SIMULATION
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/6
C     ORIGINAL VERSION--MAY       1989.
C     UPDATED         --JULY      1989. CHAR*4 STATEMENTS FOR IDEXEF & IEXSIA
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASAN
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IDEXEF
      CHARACTER*4 IEXSIA
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION XMAT(20,20)
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
      IERROR='NO'
C
      ISUBN1='DPEX'
      ISUBN2='SI  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLL=0
      ICOLX=0
      ICOLXI=0
C
      NUMVAR=0
      NUMCOM=0
      NUMFAC=0
C
      IEXSIA='NONP'
      IDEXEF='STAT'
C
C               *********************************************
C               **  TREAT THE EXPERIMENTAL SIMULATION CASE **
C               *********************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'EXSI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXSI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO
   52 FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO  = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASAN
   53 FORMAT('ICASAN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISEED
   54 FORMAT('ISEED = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************************************
C               **  STEP 11--                                      **
C               **  EXTRACT THE COMMAND                            **
C               **  DETERMINE THE LOCATION     (IN IHARG(.))       **
C               **  OF THE WORD      SIMULATION OR RUN             **
C               **  PLACE IT IN    ILASTC   .                      **
C               **  THEN SHIFT LEFT THE ENTIRE COMMAND LINE        **
C               **  SO THAT THE FIRST VARIABLE ARGUMENT            **
C               **  IS MOVED TO  IHARG(1)                          **
C               *****************************************************
C
      IF(ICOM.EQ.'RUN')GOTO590
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIMU')GOTO501
      IFOUND='NO'
      GOTO9000
C
  501 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
C
  590 CONTINUE
      IFOUND='YES'
C
C               ***********************************************************
C               **  STEP 21--                                            **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'EXSI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               **************************************************
C               **  STEP 22-                                    **
C               **  EXTRACT EACH ARGUMENT                       **
C               **  TREAT THE ALL-NUMBER/PARAMETER CASE         **
C               **************************************************
C
      NUMROW=1
      NUMCOL=NUMARG
      DO2200J=1,NUMARG
      XMAT(1,J)=ARG(J)
 2200 CONTINUE
C
C               **************************************************
C               **  STEP 31--                                   **
C               **  GENERATE A SIMULATED VALUE(S)               **
C               **************************************************
C
      CALL DPEXS3(ISEED,XMAT,NUMROW,NUMCOL,Y,
     1IBUGA3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'EXSI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXSI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ISUBRO,IBUGA2,IBUGA3,IBUGQ
 9012 FORMAT('ISUBRO,IBUGA2,IBUGA3,IBUGQ  = ',
     1A4,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)ICASAN
 9014 FORMAT('ICASAN = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXSS(X1,Y1,D1,N1,DTARG,
     1X2,Y2,N2,DHIT,
     1IBUGU2,ISUBRO,IERROR)
C
C     PURPOSE--EXTRACT A SUBSET.
C              GIVEN THE VECTORS X1 AND Y1 CONTAINING N1
C              COORDINATES, AND THE VECTOR D1 CONTAINING
C              TAG INFORMATION, EXTRACT A SUBSET.
C              TWO CAPABILITITIES EXIST--
C                 CASE 1--IF DTARG IS SET AT CPUMIN,
C                         THEN SEARCH THE D1 VECTOR FOR EACH
C                         TAG VALUE.  THE FIRST SUCH TAG VALUE
C                         WHICH OCCURS MULTIPLE TIMES WILL
C                         HAVE ITS X AND Y VALUES EXTRACTED
C                         AND PLACED IN X2 AND Y2.
C                         THE EXTRACTED NUMBER OF OBSERVATIONS
C                         WILL BE PLACED IN N2.
C                         THE SUCCESSFUL TAG VALUE WILL BE PLACED
C                         IN DHIT.
C                         IF NO MULTIPLE VALUES ARE FOUND,
C                         THEN DHIT WILL BE SET AT THE LAST TAG
C                         VALUE EXAMINED, AND N2 WILL BE SET TO 1.
C                         IF MORE THAN ONE TAG VALUE HAS MULTIPLES,
C                         ONLY THE FIRST WILL BE USED; THE OTHERS
C                         WILL BE IGNORED.
C                 CASE 2--IF DTARG IS SET AT SOME FINITE VALUE,
C                         THEN THE SUBSET IS EXTRACTED AND PLACED
C                         IN X2 AND Y2, AND THE OUTPUT
C                         NUMBER OF OBSERVATIONS IS PLACED IN N2.
C                         DHIT IS SET TO DTARG.
C                         IF NO OCCURRANCES ARE FOUND,
C                         THEN N2 WILL BE SET TO 0.
C     CAUTION--THE OUTPUT VECTORS X2 AND Y2
C              MUST NOT BE THE SAME AS THE
C              INPUT VECTORS X AND Y IN THE CALLING SEQUENCE.
C     ORIGINAL VERSION--SEPTEMBER 1988
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGU2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION X1(*)
      DIMENSION Y1(*)
      DIMENSION D1(*)
      DIMENSION X2(*)
      DIMENSION Y2(*)
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='DPEX'
      ISUBN2='SS  '
C
      IF(IBUGU2.EQ.'ON'.OR.ISUBRO.EQ.'EXSS')GOTO50
      GOTO90
   50 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXSS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGU2,ISUBRO,IERROR
   52 FORMAT('IBUGU2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)CPUMIN
   53 FORMAT('CPUMIN = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)N1,DTARG
   61 FORMAT('N1,DTARG = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      DO62I=1,N1
      WRITE(ICOUT,63)I,X1(I),Y1(I),D1(I)
   63 FORMAT('I,X1(I),Y1(I),D1(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **  STEP 10--                                   **
C               **  BRANCH TO THE APPROPRIATE CASE              **
C               **************************************************
C
      IF(DTARG.EQ.CPUMIN)GOTO1100
      GOTO1200
C
C               **************************************************
C               **  STEP 11--                                   **
C               **  TREAT THE FLOATING TAG CASE                 **
C               **************************************************
C
 1100 CONTINUE
C
      N2=0
      DHIT=DTARG
      IF(N1.LE.1)GOTO1190
C
      N1M1=N1-1
      DO1110I=1,N1M1
      DTARG2=D1(I)
      IP1=I+1
C
      ICOUNT=0
      ICOUNT=ICOUNT+1
      X2(ICOUNT)=X1(I)
      Y2(ICOUNT)=Y1(I)
C
      DO1120J=IP1,N1
      IF(D1(J).EQ.DTARG2)GOTO1130
      GOTO1120
 1130 CONTINUE
      ICOUNT=ICOUNT+1
      X2(ICOUNT)=X1(J)
      Y2(ICOUNT)=Y1(J)
 1120 CONTINUE
C
      IF(ICOUNT.GE.2)GOTO1140
      GOTO1110
C
 1140 CONTINUE
      N2=ICOUNT
      DHIT=DTARG2
      GOTO1190
C
 1110 CONTINUE
C
 1190 CONTINUE
      GOTO9000
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  TREAT THE PRE-SPECIFIED FINITE TAG CASE     **
C               **************************************************
C
 1200 CONTINUE
C
      DTARG2=DTARG
C
      ICOUNT=0
      DO1220J=1,N1
      IF(D1(J).EQ.DTARG2)GOTO1230
      GOTO1220
 1230 CONTINUE
      ICOUNT=ICOUNT+1
      X2(ICOUNT)=X1(J)
      Y2(ICOUNT)=Y1(J)
 1220 CONTINUE
      N2=ICOUNT
      DHIT=DTARG2
C
 1290 CONTINUE
      GOTO9000
C
C               **************************************************
C               **  STEP 90--                                   **
C               **  EXIT.                                       **
C               **************************************************
C
 9000 CONTINUE
      IF(IBUGU2.EQ.'ON'.OR.ISUBRO.EQ.'EXSS')GOTO9010
      GOTO9090
 9010 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE BEGINNING OF DPEXSS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGU2,ISUBRO,IERROR
 9012 FORMAT('IBUGU2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)CPUMIN
 9013 FORMAT('CPUMIN = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)N1,DTARG
 9021 FORMAT('N1,DTARG = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,N1
      WRITE(ICOUT,9023)I,X1(I),Y1(I),D1(I)
 9023 FORMAT('I,X1(I),Y1(I),D1(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
      WRITE(ICOUT,9031)N2,DHIT
 9031 FORMAT('N2,DHIT = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9032I=1,N2
      WRITE(ICOUT,9033)I,X2(I),Y2(I)
 9033 FORMAT('I,X2(I),Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXCHF,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
C
C     PURPOSE--EXTRACT A STRING.
C     THE EXTRACTED STRING WILL BE DEFINED
C     BY THE FIRST NON-BLANK CHARACTER AFTER
C     THE WORD (OR THE COMPLETION OF THE WORD)
C     DEFINED BY IWD1 AND IWD12,
C     AND CONTINUE UNTIL THE LAST NON-BLANK CHARACTER
C     BEFORE THE WORD DEFINED BY IWD2 AND IWD22.
C     (E.G., IF IWD1 = 'DERI' AND IWD12 = 'VATI', THEN THE STRING
C     WILL BEGIN WITH THE FIRST NON-BLANK CHARACTER
C     AFTER 'DERIVATIVE', 'DERIVATIXXX', ETC.).
C     THE STRING WILL FINISH WITH THE LAST NON-BLANK CHARACTER BEFORE IWD2 AND
C     IWD22.  THE SCAN WILL COVER THE ENTIRE LINE.
C     NOTE THE FOLLOWING CONVENTIONS--
C          IF IWD1 = ' ', THE EXTRACTED STRING WILL START WITH THE
C          FIRST WORD OF THE LINE (INCLUSIVE).
C          IF IWD2 = ' ', THE EXTRACTED STRING WILL STOP WITH THE
C          LAST WORD OF THE LINE (INCLUSIVE).
C     NOTE--ONLY THE STRING EXTRACTION IS DONE--
C           NO FUNCTION REPLACEMENT IS DONE.
C     OUTPUT ARGUMENTS--IFUNC2 = THE HOLLERITH VARIABLE
C                                CONTAINING THE EXTRACTED
C                                STRING (1 CHARACTER PER WORD).
C                     --N2     = THE INTEGER NUMBER OF A1 CHARACTERS
C                                IN THE EXTRACTED STRING.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --MAY       1982.
C     ORIGINAL VERSION--FEBRUARY  1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --JUNE      1989.  FIX MIS-PARSING OF LET S = ABCFORDEF
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 IWD1
      CHARACTER*4 IWD12
      CHARACTER*4 IWD2
      CHARACTER*4 IWD22
      CHARACTER*4 IFUNC2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICH1
      CHARACTER*4 ICH2
      CHARACTER*4 IX1
      CHARACTER*4 IX2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
      DIMENSION IFUNC2(*)
C
      DIMENSION ICH1(8)
      DIMENSION ICH2(8)
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='DPEX'
      ISUBN2='ST  '
C
      NUMASC=4
      NUMAS2=2*NUMASC
C
      IEND1=0
      IEND2=0
      ILOCST=0
      ILOC1=0
      I2=0
      J2=0
      ISTART=0
      ILOC2=0
      ISTOP=0
C
C               ***************************
C               **  EXTRACT A FUNCTION.  **
C               ***************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,91)
   91 FORMAT('***** AT THE BEGINNING OF DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,92)IWIDTH
   92 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,93)(IANS(I),I=1,IWIDTH)
   93 FORMAT('IANS(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,94)IWD1,IWD12
   94 FORMAT('IWD1,IWD12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,95)IWD2,IWD22
   95 FORMAT('IWD2,IWD22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IFOUND='NO'
C
      N2=0
      DO100I=1,MAXCHF
      IFUNC2(I)='    '
  100 CONTINUE
C
      DO110I=1,NUMAS2
      ICH1(I)=' '
      ICH2(I)=' '
  110 CONTINUE
C
C               **************************************************************
C               **  STEP 2--                                                **
C               **  DECOMPOSE THE 2 TARGET WORDS INTO INDIVIDUAL CHARACTERS.**
C               **************************************************************
C
      J=0
      IF(IWD1.EQ.' ')GOTO390
      IX1=IWD1
      ISTAR2=0
      ILEN1=NUMBPC
      ILEN2=ILEN1
      DO200I=1,NUMASC
      J=J+1
      IX2=' '
      ISTAR1=(I-1)*NUMBPC
      CALL DPCHEX(ISTAR1,ILEN1,IX1,ISTAR2,ILEN2,IX2)
      ICH1(J)=IX2
  200 CONTINUE
C
      IF(IWD12.EQ.' ')GOTO290
      IX1=IWD12
      ISTAR2=0
      ILEN1=NUMBPC
      ILEN2=ILEN1
      DO250I=1,NUMASC
      J=J+1
      IX2=' '
      ISTAR1=(I-1)*NUMBPC
      CALL DPCHEX(ISTAR1,ILEN1,IX1,ISTAR2,ILEN2,IX2)
      ICH1(J)=IX2
  250 CONTINUE
  290 CONTINUE
C
      K=0
      DO300I=1,J
      K=K+1
      IF(ICH1(I).EQ.' ')GOTO350
  300 CONTINUE
      IEND1=K
      GOTO390
  350 CONTINUE
      IEND1=K-1
  390 CONTINUE
C
      J=0
      IF(IWD2.EQ.' ')GOTO590
      IX1=IWD2
      ISTAR2=0
      ILEN1=NUMBPC
      ILEN2=ILEN1
      DO400I=1,NUMASC
      J=J+1
      IX2=' '
      ISTAR1=(I-1)*NUMBPC
      CALL DPCHEX(ISTAR1,ILEN1,IX1,ISTAR2,ILEN2,IX2)
      ICH2(J)=IX2
  400 CONTINUE
C
      IF(IWD22.EQ.' ')GOTO490
      IX1=IWD22
      ISTAR2=0
      ILEN1=NUMBPC
      ILEN2=ILEN1
      DO450I=1,NUMASC
      J=J+1
      IX2=' '
      ISTAR1=(I-1)*NUMBPC
      CALL DPCHEX(ISTAR1,ILEN1,IX1,ISTAR2,ILEN2,IX2)
      ICH2(J)=IX2
  450 CONTINUE
  490 CONTINUE
C
      K=0
      DO500I=1,J
      K=K+1
      IF(ICH2(I).EQ.' ')GOTO550
  500 CONTINUE
      IEND2=K
      GOTO590
  550 CONTINUE
      IEND2=K-1
  590 CONTINUE
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  EXTRACT THE                                              **
C               **  EXPRESSION FROM THE INPUT COMMAND LINE.                  **
C               **  START WITH THE FIRST NON-BLANK CHARACTER AFTER THE       **
C               **  WORD (OR THE CONTINUATION OF THE WORD)                   **
C               **  DEFINED IN IWD1 AND IWD12,                               **
C               **  AND END WITH THE FIRST NON-BLANK CHARACTER               **
C               **  BEFORE THE WORD DEFINED IN IWD2 AND IWD22.               **
C               **  NOTE THAT IF IWD1 = ' ', THEN THIS IS TO BE INTERPRETED  **
C               **  AS STARTING WITH THE FIRST NON-BLANK CHARACTER AFTER     **
C               **  (BUT NOT INCLUDING) THE EQUAL SIGN.                      **
C               **  NOTE THAT IF IWD2 = ' ', THEN THIS IS TO BE INTERPRETED  **
C               **  AS ENDING WITH THE FIRST NON-BLANK CHARACTER UP TO       **
C               **  (AND INCLUDING) THE END OF THE LINE.                     **
C               **  THE EXTRACTED FUNCTION WILL BE PUT INTO IFUNC2(.).       **
C               **  THE NUMBER OF CHARACTERS IN IFUNC2(.) WILL BE N2.        **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IWIDTH.GE.1)GOTO1109
      IBRAN=1100
      WRITE(ICOUT,1101)
 1101 FORMAT('INTERNAL ERROR IN DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)IBRAN
 1102 FORMAT('AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)
 1103 FORMAT('IWIDTH IS NON-POSITIVE FOR FUNCTION EXTRACTION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1104)IWIDTH
 1104 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1105)
 1105 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1106)(IANS(I),I=1,IWIDTH)
 1106 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1109 CONTINUE
C
C               *************************************************
C               **  STEP 3.2--                                 **
C               **  SEARCH FOR THE STRING DEFINED BY THE       **
C               **  CHARACTERS IN IWD1 AND IWD12.              **
C               *************************************************
C
      ISTEPN='3.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCST=0
      ILOC1=(-99)
      IF(IWD1.EQ.' ')ILOC1=ILOCST
      IF(IWD1.EQ.' ')GOTO3290
      IMIN=ILOCST+1
      IF(IMIN.GT.IWIDTH)GOTO3290
      DO3210I=IMIN,IWIDTH
      I2=I
      IF(IANS(I).EQ.ICH1(1))GOTO3215
      GOTO3210
 3215 CONTINUE
      DO3212J=1,IEND1
      J2=I2+J-1
      IF(IANS(J2).EQ.ICH1(J))GOTO3212
      GOTO3210
 3212 CONTINUE
      ILOC1=J2
      GOTO3290
 3210 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO3259
      WRITE(ICOUT,3251)
 3251 FORMAT('***** BUG-MODE DIAGNOSTIC IN DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)IWD1,IWD12
 3252 FORMAT('      NO ',A4,A4,' FOUND AFTER EQUAL SIGN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3254)(IANS(I),I=1,IWIDTH)
 3254 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 3259 CONTINUE
      IFOUND='NO'
      GOTO9000
 3290 CONTINUE
C
C               ********************************************
C               **  STEP 3.3--                            **
C               **  DETERMINE IF THERE IS A CONTINUATION  **
C               **  OF THE WORD DEFINED BY IWD1 AND IWD12.**
C               ********************************************
C
      ISTEPN='3.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IWD1.EQ.' ')GOTO3390
      IF(IEND1.NE.NUMAS2)GOTO3390
      IMIN=ILOC1+1
      IF(IMIN.GT.IWIDTH)GOTO3319
      DO3300I=IMIN,IWIDTH
      I2=I
      IF(IANS(I).EQ.' ')GOTO3310
 3300 CONTINUE
      ILOC1=I2+1
      GOTO3319
 3310 CONTINUE
      ILOC1=I2-1
 3319 CONTINUE
C
      IF(ILOC1.GE.1)GOTO3359
      WRITE(ICOUT,3351)
 3351 FORMAT('***** ERROR IN DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3352)IWD1,IWD12
 3352 FORMAT('      NO ',A4,A4,' FOUND AFTER EQUAL SIGN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3353)
 3353 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3354)(IANS(I),I=1,IWIDTH)
 3354 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3359 CONTINUE
C
      IF(ILOC1.LT.IWIDTH)GOTO3369
      WRITE(ICOUT,3361)
 3361 FORMAT('***** ERROR IN DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3362)IWD1,IWD12
 3362 FORMAT('      ',A4,A4,' IS LAST WORD ON COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3363)
 3363 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3364)(IANS(I),I=1,IWIDTH)
 3364 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3369 CONTINUE
C
 3390 CONTINUE
C
C               ********************************************
C               **  STEP 3.4--                            **
C               **  SEARCH FOR FIRST NON-BLANK CHARACTER  **
C               **  AFTER THE WORD (OR THE CONTINUATION   **
C               **  OF THE WORD) DEFINED BY IWD1 AND IWD12.**
C               ********************************************
C
      ISTEPN='3.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTART=(-99)
      IMIN=ILOC1+1
      IF(IMIN.GT.IWIDTH)GOTO3419
      DO3410I=IMIN,IWIDTH
      I2=I
      IF(IANS(I).NE.' ')GOTO3415
 3410 CONTINUE
      GOTO3419
 3415 CONTINUE
      ISTART=I2
 3419 CONTINUE
C
      IF(ISTART.GE.1)GOTO3459
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)IWD1,IWD12
 3452 FORMAT('      ALL CHARACTERS AFTER ',A4,A4,' ARE BLANK.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3454)(IANS(I),I=1,IWIDTH)
 3454 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3459 CONTINUE
C
C               *************************************************
C               **  STEP 3.5--                                 **
C               **  SEARCH FOR FIRST OCCURRANCE OF CHARACTER   **
C               **  DEFINED BY IWD2.                           **
C               *************************************************
C
      ISTEPN='3.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOC2=(-99)
      IF(IWD2.EQ.' ')ILOC2=IWIDTH+1
      IF(IWD2.EQ.' ')GOTO3590
C     THE FOLLOWING LINE WAS ENTERED (SEPT 1987)
C     TO HANDLE THE PROBLEM THAT AROSE WHEN THE RIGHT HAND SIDE OF
C     THE EQUAL SIGN CONSISTED OF ONLY 1 CHARACTER, AS IN
C     LET FUNCTION ABC = F
      IF(IWD2.EQ.'FOR'.AND.ISTART.EQ.IWIDTH)GOTO3511
      IMIN=ISTART+1
      IF(IMIN.GT.IWIDTH)GOTO3590
      DO3510I=IMIN,IWIDTH
      I2=I
      IF(IANS(I).EQ.ICH2(1))GOTO3515
      GOTO3510
 3515 CONTINUE
      DO3512J=1,IEND2
      J2=I2+J-1
      IF(IANS(J2).EQ.ICH2(J))GOTO3512
      GOTO3510
 3512 CONTINUE
      ILOC2=I2-1
      GOTO3590
 3510 CONTINUE
 3511 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO3559
      WRITE(ICOUT,3551)
 3551 FORMAT('***** BUG-MODE DIAGNOSTIC IN DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3552)IWD2,IWD22
 3552 FORMAT('      NO ',A4,A4,' FOUND AFTER EQUAL SIGN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3553)
 3553 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3554)(IANS(I),I=1,IWIDTH)
 3554 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 3559 CONTINUE
      IFOUND='NO'
      GOTO9000
 3590 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED                         JUNE 1989
CCCCC TO CORRECT MIS-PARSING OF    LET STRING S = ABCFORDEF   JUNE 1989
      IF(IWD2.EQ.'FOR'.AND.ILOC2.GE.1)GOTO3591
      GOTO3599
 3591 CONTINUE
      DO3592I=ILOC2,IWIDTH
      IF(IANS(I).EQ.'=')GOTO3599
 3592 CONTINUE
      IFOUND='NO'
      GOTO9000
 3599 CONTINUE
C
C               ********************************************
C               **  STEP 3.6--                            **
C               **  SEARCH FOR FIRST NON-BLANK CHARACTER  **
C               **  BEFORE THE WORD DEFINED BY IWD2.      **
C               ********************************************
C
      ISTEPN='3.6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTOP=(-99)
      IMAX=ILOC2-1
      IF(IMAX.LT.ISTART)GOTO3619
      DO3610I=ISTART,IMAX
      IREV=IMAX-I+ISTART
      IF(IANS(IREV).NE.' ')GOTO3615
 3610 CONTINUE
      GOTO3619
 3615 CONTINUE
      ISTOP=IREV
 3619 CONTINUE
C
      IF(ISTOP.GE.1)GOTO3659
      WRITE(ICOUT,3651)
 3651 FORMAT('***** ERROR IN DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3652)IWD2,IWD22
 3652 FORMAT('      ALL CHARACTERS BEFORE ',A4,A4,' ARE BLANK.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3653)
 3653 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3654)(IANS(I),I=1,IWIDTH)
 3654 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3659 CONTINUE
C
      IF(ISTART.LE.ISTOP)GOTO3919
      IBRAN=3910
      WRITE(ICOUT,3911)
 3911 FORMAT('INTERNAL ERROR IN DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3912)IBRAN
 3912 FORMAT('AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3913)
 3913 FORMAT('ISTART GREATER THAN ISTOP FOR FUNCTION EXTRACTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3914)ISTART,ISTOP
 3914 FORMAT('ISTART, ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
       WRITE(ICOUT,3915)
 3915 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3916)(IANS(I),I=1,IWIDTH)
 3916 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3919 CONTINUE
C
C               **********************************
C               **  STEP 4--                    **
C               **  COPY OUT THE STRING AS IS.  **
C               **  COPY IT INTO IFUNC2(.).     **
C               **********************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      DO4000I=ISTART,ISTOP
      J=J+1
      IFUNC2(J)=IANS(I)
 4000 CONTINUE
      N2=J
C
      IFOUND='YES'
C
C               ****************
C               **  STEP 5--  **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IEND1,IEND2
 9012 FORMAT('IEND1,IEND2 = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)(ICH1(I),I=1,8)
 9013 FORMAT('ICH1(I),I=1,8)--',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(ICH2(I),I=1,8)
 9014 FORMAT('ICH2(I),I=1,8)--',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ILOCST,ILOC1,ISTART,ISTOP,ILOC2
 9015 FORMAT('ILOCST,ILOC1,ISTART,ISTOP,ILOC2 = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)N2
 9017 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)(IFUNC2(I),I=1,N2)
 9018 FORMAT('IFUNC2(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXTE(IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--EXTEND A VARIABLE X BY APPENDING VARIABLE Y
C              TO THE END OF X.
C      EXAMPLE--EXTEND X Y
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (IN DPLET)--APRIL     1984.
C     UPDATED                    --JUNE      1990.  ADD ISUBRO ARGUMENT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
CCCCC FOLLOWING LINE ADDED JUNE, 1990.
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IVAR11
      CHARACTER*4 IVAR12
      CHARACTER*4 IVAR21
      CHARACTER*4 IVAR22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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='DPEX'
      ISUBN2='TE  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='YES'
      IERROR='NO'
C
      I2=0
      N1=0
      N2=0
      ICOL1=0
      ICOL2=0
C
      IVAR11='UNKN'
      IVAR12='UNKN'
      IVAR21='UNKN'
      IVAR22='UNKN'
      ILIST1=(-999)
      ILIST2=(-999)
      N1PN2=(-999)
      N1PI=(-999)
      IJ1=(-999)
      IJ2=(-999)
      N1NEW=(-999)
      IROW1=(-999)
      IROWN=(-99)
C
C               **********************************************
C               **  TREAT THE CASE OF EXTENDING A VARIABLE  **
C               **  WITH THE CONTENTS OF ANOTHER VARIABLE.  **
C               **********************************************
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 DPEXTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,IBUGQ
   52 FORMAT('IBUGS2,IBUGQ = ',A4,2X,A4)
      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(IBUGS2.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 3--
C               **  EXAMINE THE FIRST  VARIABLE.
C               **  IS IT IN THE TABLE?
C               **  IS IT A VARIABLE?
C               **  IVAR11 AND IVAR12 = THE NAME OF THE FIRST  VARIABLE.
C               **  ILIST1 = THE LINE IN THE INTERNAL TABLE
C               **           WHERE THE FIRST  VARIABLE IS FOUND.
C               **  ICOL1  = THE DATA COLUMN FOR THE FIRST  VARIABLE.
C               **  N1     = THE NUMBER OF OBSERVATIONS FOR THE FIRST  VARIABLE.
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IVAR11=IHARG(1)
      IVAR12=IHARG2(1)
C
      DO310I=1,NUMNAM
      I2=I
      IF(IVAR11.EQ.IHNAME(I).AND.IVAR12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO380
      IF(IVAR11.EQ.IHNAME(I).AND.IVAR12.EQ.IHNAM2(I).AND.
     1IUSE(I).NE.'V')GOTO330
  310 CONTINUE
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPEXTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE FIRST  VARIABLE NAME REFERENCED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)IVAR11,IVAR12
  323 FORMAT('      (= ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME TABLE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      SUGGESTED ACTION--USE THE STATUS COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  330 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,331)
  331 FORMAT('***** ERROR IN DPEXTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,332)
  332 FORMAT('      THE FIRST  VARIABLE NAME REFERENCED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,333)IVAR11,IVAR12
  333 FORMAT('      (= ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,334)
  334 FORMAT('      SHOULD HAVE BEEN A VARIABLE, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  380 CONTINUE
      ILIST1=I2
      ICOL1=IVALUE(ILIST1)
      N1=IN(ILIST1)
C
C               ****************************************************************
C               **  STEP 4--
C               **  EXAMINE THE SECOND VARIABLE.
C               **  IS IT IN THE TABLE?
C               **  IS IT A VARIABLE?
C               **  IVAR21 AND IVAR22 = THE NAME OF THE SECOND VARIABLE.
C               **  ILIST2 = THE LINE IN THE INTERNAL TABLE
C               **           WHERE THE SECOND VARIABLE IS FOUND.
C               **  ICOL2  = THE DATA COLUMN FOR THE SECOND VARIABLE.
C               **  N2     = THE NUMBER OF OBSERVATIONS FOR THE SECOND VARIABLE.
C               ****************************************************************
C
      ISTEPN='4'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IVAR21=IHARG(2)
      IVAR22=IHARG2(2)
C
      DO410I=1,NUMNAM
      I2=I
      IF(IVAR21.EQ.IHNAME(I).AND.IVAR22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO480
      IF(IVAR21.EQ.IHNAME(I).AND.IVAR22.EQ.IHNAM2(I).AND.
     1IUSE(I).NE.'V')GOTO430
  410 CONTINUE
C
  420 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,421)
  421 FORMAT('***** ERROR IN DPEXTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,422)
  422 FORMAT('      THE SECOND VARIABLE NAME REFERENCED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,423)IVAR21,IVAR22
  423 FORMAT('      (= ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,424)
  424 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME TABLE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,425)
  425 FORMAT('      SUGGESTED ACTION--USE THE STATUS COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,426)
  426 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  430 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,431)
  431 FORMAT('***** ERROR IN DPEXTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,432)
  432 FORMAT('      THE SECOND VARIABLE NAME REFERENCED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,433)IVAR21,IVAR22
  433 FORMAT('      (= ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,434)
  434 FORMAT('      SHOULD HAVE BEEN A VARIABLE, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  480 CONTINUE
      ILIST2=I2
      ICOL2=IVALUE(ILIST2)
      N2=IN(ILIST2)
C
      ISTEPN='6'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ***********************************************
C               **  STEP 6--                                 **
C               **  DO A PRELIMINARY CHECK--                 **
C               **  WILL APPENDING VARIABLE 2 TO VARIABLE 1  **
C               **  MAKE VARIABLE 1 TOO LONG?                **
C               **  (THAT IS, WILL IT EXCEED MAXN)?          **
C               ***********************************************
C
      N1PN2=N1+N2
      IF(N1PN2.LE.MAXN)GOTO690
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,621)
  621 FORMAT('***** ERROR IN DPEXTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,622)IVAR11,IVAR12
  622 FORMAT('      THE EXTENSION OF VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,623)IVAR21,IVAR22
  623 FORMAT('      BY VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,624)IVAR11,IVAR12
  624 FORMAT('      WILL MAKE VARIABLE ',A4,A4,' TOO LONG.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,625)IVAR11,IVAR12,N1
  625 FORMAT('      NUMBER OF OBSERVATIONS IN ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,626)IVAR21,IVAR22,N2
  626 FORMAT('      NUMBER OF OBSERVATIONS IN ',A4,A4,' = ' ,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,627)IVAR11,IVAR12,N1PN2
  627 FORMAT('      NEW NUMBER OF OBSERVATIONS IN ',A4,A4,
     1' WOULD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,628)MAXN
  628 FORMAT('      ALLOWABLE NUMBER OF OBSERVATIONS    = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,629)
  629 FORMAT('      THEREFORE, NO EXTENSION CARRIED OUT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  690 CONTINUE
C
C               ****************************************************
C               **  STEP 10--                                     **
C               **  APPEND VARIABLE 2 ONTO THE END OF VARIABLE 1  **
C               ****************************************************
C
      ISTEPN='10'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2100I=1,N2
      N1PI=N1+I
      IJ1=MAXN*(ICOL1-1)+N1PI
      IJ2=MAXN*(ICOL2-1)+I
      IF(ICOL1.LE.MAXCOL)V(IJ1)=V(IJ2)
      IF(ICOL1.EQ.MAXCP1)PRED(N1PI)=Y(IJ2)
      IF(ICOL1.EQ.MAXCP2)RES(N1PI)=Y(IJ2)
 2100 CONTINUE
      N1NEW=N1PI
C
C               *******************************************
C               **  STEP 11--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING.   **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHNAME(ILIST1)=IVAR11
      IHNAM2(ILIST1)=IVAR12
      IUSE(ILIST1)='V'
      IVALUE(ILIST1)=ICOL1
      VALUE(ILIST1)=ICOL1
      IN(ILIST1)=N1NEW
C
      DO2400J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOL1)GOTO2405
      GOTO2400
 2405 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOL1
      VALUE(J4)=ICOL1
      IN(J4)=N1NEW
 2400 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO2459
      IF(IFEEDB.EQ.'OFF')GOTO2459
      NNUM=N2
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2411)IVAR11,IVAR12,NNUM
 2411 FORMAT('THE NUMBER OF VALUES ADDED TO ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
C
      IROW1=N1+1
      IROWN=N1+N2
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOL1-1)+IROW1
      IF(ICOL1.LE.MAXCOL)WRITE(ICOUT,2421)IVAR11,IVAR12,V(IJ),
     1IROW1
      IF(ICOL1.LE.MAXCOL)CALL DPWRST('XXX','BUG ')
      IF(ICOL1.EQ.MAXCP1)WRITE(ICOUT,2421)IVAR11,IVAR12,PRED(IROW1),
     1IROW1
      IF(ICOL1.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
      IF(ICOL1.EQ.MAXCP2)WRITE(ICOUT,2421)IVAR11,IVAR12,RES(IROW1),
     1IROW1
 2421 FORMAT('THE FIRST           VALUE ADDED TO ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOL1.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOL1-1)+IROWN
      IF(ICOL1.LE.MAXCOL.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,IVAR11,IVAR12,V(IJ),IROWN
      IF(ICOL1.LE.MAXCOL.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOL1.EQ.MAXCP1.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,IVAR11,IVAR12,PRED(IROWN),IROWN
      IF(ICOL1.EQ.MAXCP1.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOL1.EQ.MAXCP2.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,IVAR11,IVAR12,RES(IROWN),IROWN
 2431 FORMAT('THE LAST (',I5,'-TH) VALUE ADDED TO ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOL1.EQ.MAXCP2.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2453)IVAR11,IVAR12,N1NEW
 2453 FORMAT('THE NEW     LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 2459 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,IBUGQ
 9013 FORMAT('IBUGS2,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IVAR11,IVAR12,ILIST1,ICOL1,N1
 9021 FORMAT('IVAR11,IVAR12,ILIST1,ICOL1,N1 = ',A4,2X,A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IVAR22,IVAR22,ILIST2,ICOL2,N2
 9022 FORMAT('IVAR22,IVAR22,ILIST2,ICOL2,N2 = ',A4,2X,A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)N1PI,N1PN2,N1NEW,IROW1,IROWN,IJ1,IJ2
 9023 FORMAT('N1PI,N1PN2,N1NEW,IROW1,IROWN,IJ1,IJ2 = ',6I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXTL(IHRE11,IHRE12,IHRE21,IHRE22,
     1KNUMB,IVAL1,IVAL2,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--EXTRACT "TO" LIMITS.
C              DO A CHARACTER-BY-CHARACTER COMPARISON
C              OF IHRE11/IHRE12 AND IHRE21/IHRE22,
C              AND NOTE (THIS WILL BECOME KNUMB)
C              WHERE THE TRAILING NUMBERS BEGIN.
C              THEN EXTRACT THE 2 TRAILING NUMERIC STRINGS
C              AND CONVERT
C              THESE 2 NUMBERS INTO INTEGERS (IVAL1 AND IVAL2)
C
C     ORIGINAL VERSION--DECEMBER   1986.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IHRE11
      CHARACTER*4 IHRE12
      CHARACTER*4 IHRE21
      CHARACTER*4 IHRE22
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IVALI3
      CHARACTER*4 IVALI4
      CHARACTER*8 IS1
      CHARACTER*8 IS2
      CHARACTER*4 IS3
      CHARACTER*4 IS4
C
      CHARACTER*1 IC
C
      DIMENSION IS3(8)
      DIMENSION IS4(8)
C
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
      KDIFF=(-999)
      KNUMB=(-999)
      IVAL1=(-999)
      IVAL2=(-999)
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXTL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXTL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IHRE11,IHRE12,IHRE21,IHRE22
   53 FORMAT('IHRE11,IHRE12,IHRE21,IHRE22 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ****************************************************
C               **  STEP 11--                                     **
C               **  FORM IS1 WHICH WILL BE A CHARACTER*8          **
C               **  COMBINATION OF IHRE11 AND IHRE12.             **
C               **  COPY IHRE11 INTO THE FIRST  HALF OF IS1.      **
C               **  COPY IHRE12 INTO THE SECOND HALF OF IS1.      **
C               **  FORM IS2 WHICH WILL BE A CHARACTER*8          **
C               **  COMBINATION OF IHRE21 AND IHRE22.             **
C               **  COPY IHRE21 INTO THE FIRST  HALF OF IS2.      **
C               **  COPY IHRE22 INTO THE SECOND HALF OF IS2.      **
C               **  FORM IS3 WHICH WILL BE A 8-TERM VECTOR        **
C               **  VERSION OF IS1.                               **
C               **  FORM IS4 WHICH WILL BE A 8-TERM VECTOR        **
C               **  VERSION OF IS2.                               **
C               ****************************************************
C
      IS1(1:8)='        '
      IS2(1:8)='        '
      IS1(1:4)=IHRE11
      IS1(5:8)=IHRE12
      IS2(1:4)=IHRE21
      IS2(5:8)=IHRE22
C
      DO 1100 K=1,8
      IS3(K)='    '
      IS4(K)='    '
      IS3(K)=IS1(K:K)
      IS4(K)=IS2(K:K)
 1100 CONTINUE
C
C               ****************************************************
C               **  STEP 12--                                     **
C               **  FORM IS3 WHICH WILL BE A 8-TERM VECTOR        **
C               **  DETERMINE THE LENGTH OF THE NON-BLANK         **
C               **  PART OF IS3.                                  **
C               **  DETERMINE THE LENGTH OF THE NON-BLANK         **
C               **  PART OF IS4.                                  **
C               ****************************************************
C
      DO1210K=1,8
      KREV=8-K+1
      IF(IS3(KREV).NE.'    ')GOTO1219
 1210 CONTINUE
      KREV=0
 1219 CONTINUE
      NS3=KREV
C
      DO1220K=1,8
      KREV=8-K+1
      IF(IS4(KREV).NE.'    ')GOTO1229
 1220 CONTINUE
      KREV=0
 1229 CONTINUE
      NS4=KREV
C
C               *******************************************
C               **  STEP 13--                            **
C               **  DETERMINE THE POSITION (1 TO 8)      **
C               **  WHEREBY IS1 AND IS2                  **
C               **  (OR EQUIVALENTLY IS3 AND IS4)        **
C               **  FIRST DIFFER.                        **
C               *******************************************
C
C
      DO1300K=1,8
      KDIFF=K
      IF(IS3(K).NE.IS4(K))GOTO1390
 1300 CONTINUE
C
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPEXTL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      NO DIFFERENCE FOUND IN ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      THE 2 REFERENCE STRINGS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1314)
 1314 FORMAT('      IN ATTEMPTING TO EXTRACT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('      LIMITS IN CONNECTION WITH THE   TO   KEYWORD.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)IS1
 1316 FORMAT('            IS1 = ',A8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)IS2
 1317 FORMAT('            IS2 = ',A8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1390 CONTINUE
C
C               *************************************************
C               **  STEP 14--                                  **
C               **  STEP BACK TO SEE IF PREVIOUS CHARACTERS    **
C               **  ARE DIGITS                                 **
C               *************************************************
C
      KNUMB=KDIFF
      KDIFM1=KDIFF-1
      IF(KDIFM1.LE.0)GOTO1490
      DO1400K=1,KDIFM1
      KREV=KDIFM1-K+1
      IC=IS1(KREV:KREV)
      CALL DPCOAN(IC,IX)
      IF(IX.LE.47)GOTO1490
      IF(IX.GE.58)GOTO1490
      KNUMB=KREV
 1400 CONTINUE
 1490 CONTINUE
      K31=KNUMB
      K32=NS3
      K41=KNUMB
      K42=NS4
C
C               *************************************************
C               **  STEP 15--                                  **
C               **  EXTRACT THE TRAILING DIFFERERING STRING    **
C               **  FOR IS1 AND CONVERT IT TO AN INTEGER.      **
C               **  EXTRACT THE TRAILING DIFFERERING STRING    **
C               **  FOR IS2 AND CONVERT IT TO AN INTEGER.      **
C               *************************************************
C
      CALL DPCOHI(K31,K32,IS3,NS3,IVALI3,VALCO3,IVALC3,
     1IBUGS2,IERROR)
      CALL DPCOHI(K41,K42,IS4,NS4,IVALI4,VALCO4,IVALC4,
     1IBUGS2,IERROR)
C
      IVAL1=IVALC3
      IVAL2=IVALC4
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXTL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXTL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IHRE11,IHRE12,IHRE21,IHRE22
 9013 FORMAT('IHRE11,IHRE12,IHRE21,IHRE22 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)KDIFF,KNUMB,IVAL1,IVAL2
 9014 FORMAT('KDIFF,KNUMB,IVAL1,IVAL2 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IS1,NS3,K31,K32
 9015 FORMAT('IS1,NS3,K31,K32 = ',A8,2X,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IVALI3,VALCO3,IVALC3,IVAL1
 9016 FORMAT('IVALI3,VALCO3,IVALC3,IVAL1 = ',A4,E15.7,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IS2,NS4,K41,K42
 9017 FORMAT('IS2,NS4,K41,K42 = ',A8,2X,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IVALI4,VALCO4,IVALC4,IVAL2
 9018 FORMAT('IVALI4,VALCO4,IVALC4,IVAL2 = ',A4,E15.7,2I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--SCAN THE CHARACTER*80 VARIABLE ISTRIN
C              BETWEEN COLUMNS ISTART TO ISTOP
C              AND EXTRACT THE IWORD-TH WORD
C              IN THAT INTERVAL.
C              PLACE THE FIRST AND LAST COLUMNS
C              OF THE IWORD-TH WORD INTO ICOL1 AND ICOL2,
C              PLACE THE IWORD-TH WORD ITSELF INTO
C              THE CHARACTER*80 VARIABLE ISTRI2;
C              PLACE THE NUMBER OF CHARACTERS IN THIS
C              IWORD-TH WORD INTO NCSTR2.
C              THE CHARACTER*80 STRING ISTRI2,
C              AND PLACE THE LENGTH OF
C              THE STRING INTO NCSTR2.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--DECEMBER  1985.
C     UPDATED         --APRIL     1997. DO NOT RESTRICT TO 80 CHARACTERS
C     UPDATED         --JULY      2002. ALLOW WORD TO BE ENCLOSED IN
C                                       QUOTES (PC FILE NAMES CAN
C                                       HAVE SPACES)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC USE DUMMY DIMENSIONING TO REMOVE ARTIFICIAL RESTRICTION ON
CCCCC 80 CHARACTERS.  APRIL 1997.
CCCCC CHARACTER*80 ISTRIN
CCCCC CHARACTER*80 ISTRI2
      CHARACTER*(*) ISTRIN
      CHARACTER*(*) ISTRI2
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      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='DPEX'
      ISUBN2='WO  '
C
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXWO')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXWO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(ISTRIN(J:J),J=1,MIN(100,ISTOP))
   54 FORMAT('(ISTRIN(J:J),J=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ISTART,ISTOP
   55 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IWORD
   56 FORMAT('IWORD = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************
C               **  STEP 11--                       **
C               **  INITIALIZE THE OUTPUT VARIABLES **
C               **************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXWO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOL1=(-999)
      ICOL2=(-999)
      NCSTR2=(-999)
CCCCC FOLLOWING CHANGED APRIL 1997
      ISTRI2=' '
CCCCC DO1100I=1,80
      DO1100I=1,ISTOP
      ISTRI2(I:I)=' '
 1100 CONTINUE
C
C               *******************************************
C               **  STEP 12--                            **
C               **  CHECK THE INPUT ARGUMENTS            **
C               *******************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXWO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC NO CHECK ON UPPER LIMIT.  APRIL 1997.
CCCCC IF(ISTART.GE.1.AND.ISTOP.GE.1.AND.
CCCCC1   ISTART.LE.80.AND.ISTOP.LE.80)GOTO1219
      IF(ISTART.GE.1.AND.ISTOP.GE.1)GOTO1219
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPEXWO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
C1212 FORMAT('      ISTART OR ISTOP IS < 1 OR > 80. ')
 1212 FORMAT('      ISTART OR ISTOP IS < 1. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)ISTART
 1213 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)ISTOP
 1214 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)(ISTRIN(I:I),I=1,MIN(100,ISTOP))
 1216 FORMAT('      (ISTRIN(I:I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1219 CONTINUE
C
      IF(ISTART.LE.ISTOP)GOTO1229
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** ERROR IN DPEXWO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)
 1222 FORMAT('      ISTART EXCEEDS ISTOP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)ISTART
 1223 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1224)ISTOP
 1224 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)(ISTRIN(I:I),I=1,MIN(100,ISTOP))
 1226 FORMAT('      (ISTRIN(I:I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1229 CONTINUE
C
      IF(IWORD.GE.1)GOTO1239
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1231)
 1231 FORMAT('***** ERROR IN DPEXWO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1232)
 1232 FORMAT('      IWORD IS LESS THAN 1 .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1233)IWORD
 1233 FORMAT('      IWORD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1236)(ISTRIN(I:I),I=1,MIN(ISTOP,100))
 1236 FORMAT('      (ISTRIN(I:I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1239 CONTINUE
C
C               ************************************************
C               **  STEP 21--                                 **
C               **  IDENTIFY THE COLUMNS WHERE                **
C               **  THE IWORD-TH STRING RESIDES               **
C               **  ICOL1 = START COLUMN OF A STRING          **
C               **  ICOL2 = STOP  COLUMN OF A STRING          **
C               ************************************************
C
      ICOL2=ISTART-1
      DO2100ILOOP=1,IWORD
C
      ICOL1=ISTOP+1
      IMIN=ICOL2+1
      IF(IMIN.GT.ISTOP)GOTO2119
      IQUOTE=0
      DO2110I=IMIN,ISTOP
      I2=I
      IF(ISTRIN(I:I).NE.' ' .AND. ISTRIN(I:I).NE.'-')THEN
        IF(IFILQU.EQ.'ON' .AND. ISTRIN(I:I).EQ.'"')IQUOTE=1
        GOTO2115
      ENDIF
 2110 CONTINUE
      ICOL1=ISTOP+1
      GOTO2119
 2115 CONTINUE
      ICOL1=I2
      GOTO2119
 2119 CONTINUE
C
      ICOL2=ISTOP
      IMIN=ICOL1+1
      IF(IMIN.GT.ISTOP)GOTO2129
      DO2120I=IMIN,ISTOP
      I2=I
      IF(IQUOTE.EQ.0)THEN
        IF(ISTRIN(I:I).EQ.' ' .OR. ISTRIN(I:I).EQ.'-')GOTO2125
      ELSE
        IF(ISTRIN(I:I).EQ.'"')GOTO2126
      ENDIF
 2120   CONTINUE
      ICOL2=ISTOP
      GOTO2129
 2125 CONTINUE
      ICOL2=I2-1
      GOTO2129
 2126 CONTINUE
      ICOL2=I2
      GOTO2129
 2129 CONTINUE
C
      IF(ICOL1.GE.ISTART.AND.ICOL2.GE.ISTART.AND.
     1   ICOL1.LE.ISTOP.AND.ICOL2.LE.ISTOP)GOTO2139
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2131)
 2131 FORMAT('***** ERROR IN DPEXWO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2132)
 2132 FORMAT('      ICOL1 OR ICOL2 IS < ISTART OR > ISTOP. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2133)ICOL1
 2133 FORMAT('      ICOL1  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2134)ICOL2
 2134 FORMAT('      ICOL2  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2135)ISTART
 2135 FORMAT('      ISTART = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2136)ISTOP
 2136 FORMAT('      ISTOP  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2137)(ISTRIN(I:I),I=1,80)
 2137 FORMAT('      (ISTRIN(I:I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 2139 CONTINUE
C
      IF(ICOL1.LE.ICOL2)GOTO2149
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2141)
 2141 FORMAT('***** ERROR IN DPEXWO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2142)
 2142 FORMAT('      ICOL1 EXCEEDS ICOL2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2143)ICOL1
 2143 FORMAT('      ICOL1  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2144)ICOL2
 2144 FORMAT('      ICOL2  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)(ISTRIN(I:I),I=1,MIN(80,ISTOP))
 2146 FORMAT('      (ISTRIN(I:I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 2149 CONTINUE
C
 2100 CONTINUE
C
C               *********************************************
C               **  STEP 22--                              **
C               **  COPY THE IWORD-TH STRING INTO ISTRI2   **
C               *********************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXWO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      DO2200I=ICOL1,ICOL2
      J=J+1
      ISTRI2(J:J)=ISTRIN(I:I)
 2200 CONTINUE
      NCSTR2=J
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXWO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXWO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,ISUBRO,IERROR
 9013 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9014)(ISTRIN(J:J),J=1,80)
      WRITE(ICOUT,9014)(ISTRIN(J:J),J=1,MIN(100,ISTOP))
 9014 FORMAT('(ISTRIN(J:J),J=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ISTART,ISTOP
 9015 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IWORD
 9016 FORMAT('IWORD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICOL1,ICOL2
 9021 FORMAT('ICOL1, ICOL2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)NCSTR2
 9022 FORMAT('NCSTR2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR2.GE.1)THEN
        WRITE(ICOUT,9023)(ISTRI2(I:I),I=1,MIN(100,NCSTR2))
 9023   FORMAT('(ISTRI2(I:I),I=1,NCSTR2) = ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEXW2(IFUNC2,N2,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,IFUNC3,N3,
     1IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--SCAN THE CHARACTER*4 DIMENSIONED VARIABLE IFUNC2
C              BETWEEN COLUMNS ISTART TO ISTOP
C              AND EXTRACT THE IWORD-TH WORD
C              IN THAT INTERVAL.
C              PLACE THE FIRST AND LAST COLUMNS
C              OF THE IWORD-TH WORD INTO ICOL1 AND ICOL2,
C              PLACE THE IWORD-TH WORD ITSELF INTO
C              THE CHARACTER*4 DIMENSIONED VARIABLE IFUNC3;
C              PLACE THE NUMBER OF CHARACTERS IN THIS
C              IWORD-TH WORD INTO N3.
C
C     NOTE--THIS SUBROUTINE IS SIMILAR
C           (ALTHOUGH THE INPUT ARGUMENT STRUCTURE DIFFERS
C            BY 2 EXTRA ARGUMENTS),
C           TO SUBROUTINE DPEXWO EXCEPT
C           DPEXWO OPERATES ON UNDIMENSIONED
C           CHARACTER*80 VARIABLES IFUNC2 AND IFUNC3,
C           WHEREAS THIS SUBROUTINE DPEXW2
C           OPERATES ON CHARACTER*4 DIMENSIONED
C           VARIABLES IFUNC2 AND IFUNC3.
C           THE FACT THAT THE VARIABLES ARE HERE DIMENSIONED
C           BECAUSE THEY ARE THEN NOT RESTRICTED
C           TO 80, OR 132, OR WHATEVER.
C     NOTE--EVEN THOUGH VARIABLES IFUNC2 AND IFUNC3
C           ARE CHARACTER*4, THERE IS NO ESSENTIAL
C           USE BEING MADE OF POSITIONS 2, 3, AND 4, AND SO
C           (IF CHANGES WERE MADE IN THE CALLING ROUTINE),
C           IFUNC2 AND IFUNC3 COULD JUST AS WELL
C           HAVE BEEN CHARACTER*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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--JULY  1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IFUNC2
      CHARACTER*4 IFUNC3
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IFUNC2(*)
      DIMENSION IFUNC3(*)
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='DPEX'
      ISUBN2='W2  '
C
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXW2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPEXW2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N2
   53 FORMAT('N2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IFUNC2(J),J=1,100)
   54 FORMAT('(IFUNC2(J),J=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ISTART,ISTOP
   55 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IWORD
   56 FORMAT('IWORD = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************
C               **  STEP 11--                       **
C               **  INITIALIZE THE OUTPUT VARIABLES **
C               **************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXW2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOL1=(-999)
      ICOL2=(-999)
      N3=(-999)
      DO1100I=1,N2
      IFUNC3(I)='    '
 1100 CONTINUE
C
C               *******************************************
C               **  STEP 12--                            **
C               **  CHECK THE INPUT ARGUMENTS            **
C               *******************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXW2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTART.GE.1.AND.ISTOP.GE.1.AND.
     1   ISTART.LE.N2.AND.ISTOP.LE.N2)GOTO1219
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPEXW2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)N2
 1212 FORMAT('      ISTART OR ISTOP IS < 1 OR > ',I8,'.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)ISTART
 1213 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)ISTOP
 1214 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)(IFUNC2(I),I=1,100)
 1216 FORMAT('      (IFUNC2(I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1219 CONTINUE
C
      IF(ISTART.LE.ISTOP)GOTO1229
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** ERROR IN DPEXW2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)
 1222 FORMAT('      ISTART EXCEEDS ISTOP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)ISTART
 1223 FORMAT('      ISTART  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1224)ISTOP
 1224 FORMAT('      ISTOP   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)(IFUNC2(I),I=1,100)
 1226 FORMAT('      (IFUNC2(I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1229 CONTINUE
C
      IF(IWORD.GE.1)GOTO1239
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1231)
 1231 FORMAT('***** ERROR IN DPEXW2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1232)
 1232 FORMAT('      IWORD IS LESS THAN 1 .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1233)IWORD
 1233 FORMAT('      IWORD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1236)(IFUNC2(I),I=1,100)
 1236 FORMAT('      (IFUNC2(I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1239 CONTINUE
C
C               ************************************************
C               **  STEP 21--                                 **
C               **  IDENTIFY THE COLUMNS WHERE                **
C               **  THE IWORD-TH STRING RESIDES               **
C               **  ICOL1 = START COLUMN OF A STRING          **
C               **  ICOL2 = STOP  COLUMN OF A STRING          **
C               ************************************************
C
      ICOL2=ISTART-1
      DO2100ILOOP=1,IWORD
C
      ICOL1=ISTOP+1
      IMIN=ICOL2+1
      IF(IMIN.GT.ISTOP)GOTO2119
      DO2110I=IMIN,ISTOP
      I2=I
      IF(IFUNC2(I).NE.'    ')GOTO2115
 2110 CONTINUE
      ICOL1=ISTOP+1
      GOTO2119
 2115 CONTINUE
      ICOL1=I2
      GOTO2119
 2119 CONTINUE
C
      ICOL2=ISTOP
      IMIN=ICOL1+1
      IF(IMIN.GT.ISTOP)GOTO2129
      DO2120I=IMIN,ISTOP
      I2=I
      IF(IFUNC2(I).EQ.'    ')GOTO2125
 2120 CONTINUE
      ICOL2=ISTOP
      GOTO2129
 2125 CONTINUE
      ICOL2=I2-1
      GOTO2129
 2129 CONTINUE
 
      IF(ICOL1.GE.ISTART.AND.ICOL2.GE.ISTART.AND.
     1   ICOL1.LE.ISTOP.AND.ICOL2.LE.ISTOP)GOTO2139
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2131)
 2131 FORMAT('***** ERROR IN DPEXW2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2132)
 2132 FORMAT('      ICOL1 OR ICOL2 IS < ISTART OR > ISTOP. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2133)ICOL1
 2133 FORMAT('      ICOL1  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2134)ICOL2
 2134 FORMAT('      ICOL2  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2135)ISTART
 2135 FORMAT('      ISTART = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2136)ISTOP
 2136 FORMAT('      ISTOP  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2137)(IFUNC2(I),I=1,100)
 2137 FORMAT('      (IFUNC2(I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 2139 CONTINUE
C
      IF(ICOL1.LE.ICOL2)GOTO2149
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2141)
 2141 FORMAT('***** ERROR IN DPEXW2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2142)
 2142 FORMAT('      ICOL1 EXCEEDS ICOL2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2143)ICOL1
 2143 FORMAT('      ICOL1  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2144)ICOL2
 2144 FORMAT('      ICOL2  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)(IFUNC2(I),I=1,100)
 2146 FORMAT('      (IFUNC2(I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 2149 CONTINUE
C
 2100 CONTINUE
C
C               *********************************************
C               **  STEP 22--                              **
C               **  COPY THE IWORD-TH STRING INTO IFUNC3   **
C               *********************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'EXW2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      DO2200I=ICOL1,ICOL2
      J=J+1
      IFUNC3(J)=IFUNC2(I)
 2200 CONTINUE
      N3=J
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'EXW2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPEXW2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N2
 9013 FORMAT('N2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(IFUNC2(J),J=1,100)
 9014 FORMAT('(IFUNC2(J),J=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ISTART,ISTOP
 9015 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IWORD
 9016 FORMAT('IWORD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICOL1,ICOL2
 9021 FORMAT('ICOL1, ICOL2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)N3
 9022 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)(IFUNC3(I),I=1,100)
 9023 FORMAT('(IFUNC3(I),I=1,N3) = ',100A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEYCO(IHARG,IARGT,ARG,NUMARG,
     1AEYEXC,AEYEYC,AEYEZC,
     1X3DEYE,Y3DEYE,Z3DEYE,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE (X,Y,Z) EYE COORDINATES CONTAINED IN THE
C              3 VARAIBLES AEYEXC,AEYEYC,AEYEZC
C              SUCH EYE COORDINATES ARE USED IN 3-DIMENSIONAL PLOTS.
C     COMMAND = EYE (COORDINATES) ... ... ...
C     NOTE--LOGIC HEREIN ASSUMES THE WORD    COORDINATES   HAS BEEN
C           SHIFTED OUT (DONE IN MAIPC4).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--AEYEXC  = X-COORDINATE OF EYE
C                     --AEYEYC  = Y-COORDINATE OF EYE
C                     --AEYEZC  = Z-COORDINATE OF EYE
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --SEPTEMBER 1993.  REWRITE ALL
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
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE CASE          **
C               ********************************************
C
      IF(NUMARG.EQ.0)GOTO1000
      IF(NUMARG.GE.1)THEN
         IF(IHARG(NUMARG).EQ.'ON')GOTO1000
         IF(IHARG(NUMARG).EQ.'OFF')GOTO1000
         IF(IHARG(NUMARG).EQ.'AUTO')GOTO1000
         IF(IHARG(NUMARG).EQ.'DEFA')GOTO1000
         IF(IHARG(NUMARG).EQ.'?')GOTO3000
         IF(IARGT(1).EQ.'NUMB'.OR.IARGT(2).EQ.'NUMB'.OR.
     1   IARGT(3).EQ.'NUMB')GOTO2000
         GOTO8000
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  TREAT THE    DEFAULT    CASE--        **
C               ********************************************
C
 1000 CONTINUE
      IFOUND='YES'
      AEYEXC=CPUMIN
      AEYEYC=CPUMIN
      AEYEZC=CPUMIN
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,999)
  999    FORMAT(1X)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1011)
 1011    FORMAT('THE (X,Y,Z) EYE COORDINATES HAVE JUST BEEN SET')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1012)
 1012    FORMAT('TO AUTOMATICALLY FLOAT WITH THE DATA.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1013)
 1013    FORMAT('THE (X,Y,Z) EYE COORDINATES WILL BE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1021)
 1021    FORMAT('    X = XMIN + 3 * (XMAX - XMIN)')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1022)
 1022    FORMAT('    Y = YMIN + 3 * (YMAX - YMIN)')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1023)
 1023    FORMAT('    Z = ZMIN + 3 * (ZMAX - ZMIN)')
         CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO9000
C
C               ********************************************
C               **  STEP 12--                             **
C               **  TREAT THE    USER-SPEC    CASE--      **
C               ********************************************
C
 2000 CONTINUE
      IFOUND='YES'
      IF(IARGT(1).EQ.'NUMB'.AND.IHARG(1).NE.'.')THEN
         AEYEXC=ARG(1)
         X3DEYE=ARG(1)
      ENDIF
      IF(IARGT(2).EQ.'NUMB'.AND.IHARG(2).NE.'.')THEN
         AEYEYC=ARG(2)
         Y3DEYE=ARG(2)
      ENDIF
      IF(IARGT(3).EQ.'NUMB'.AND.IHARG(3).NE.'.')THEN
         AEYEZC=ARG(3)
         Z3DEYE=ARG(3)
      ENDIF
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2011)
 2011    FORMAT('THE (X,Y,Z) EYE COORDINATES HAVE JUST BEEN SET TO')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2021)AEYEXC
 2021    FORMAT('    X = ',E15.7)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2022)AEYEYC
 2022    FORMAT('    Y = ',E15.7)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2023)AEYEZC
 2023    FORMAT('    Z = ',E15.7)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO9000
C
C               ********************************************
C               **  STEP 13--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 3000 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3011)
 3011 FORMAT('THE CURRENT (X,Y,Z) EYE COORDINATES ARE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3021)X3DEYE
 3021 FORMAT('    X = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3022)Y3DEYE
 3022 FORMAT('    Y = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3023)Z3DEYE
 3023 FORMAT('    Z = ',E15.7)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3031)
 3031 FORMAT('THE DEFAULT (X,Y,Z) EYE COORDINATES ARE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3041)
 3041 FORMAT('    X = XMIN + 3 * (XMAX - XMIN)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3042)
 3042 FORMAT('    Y = YMIN + 3 * (YMAX - YMIN)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3043)
 3043 FORMAT('    Z = ZMIN + 3 * (ZMAX - ZMIN)')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
C
C               ********************************************
C               **  STEP 14--                             **
C               **  TREAT THE    ERROR    CASE            **
C               ********************************************
C
 8000 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,8011)
 8011 FORMAT('***** ERROR IN DPEYCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)
 8012 FORMAT('      ILLEGAL FORM FOR EYE COORDINATES ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8014)
 8014 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8015)
 8015 FORMAT('      SUPPOSE IT IS DESIRED TO POSITION ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8016)
 8016 FORMAT('      THE AXES EYE FOR A 3 DIMENSIONAL PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8017)
 8017 FORMAT('      AT (IN UNITS OF THE PLOTTED DATA)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8018)
 8018 FORMAT('      (X=500, Y=25000, Z=.03)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8019)
 8019 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8020)
 8020 FORMAT('      EYE COORDINATES 500 2500 .03')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
