      SUBROUTINE DPREAL(IRD2,ICOL1,ICOL2,MINCO2,MAXCO2,X,N,IXC,NXC,
     1ICASRE,IFUNC2,N2,MAXN2,
     1IMACRO,IMACNU,IMACCS,
     1IANSLC,IWIDTH,IREACS,ISTOR1,ISTOR2,IEND,NUMLRD,
     1IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1ICOMCH,ICOMSW,LINETY,IGRPAU,
     1ICOLL,ICOLU,ITYPE,NCOLS,NCALL,IREADL,PREAMV,MAXRDV,MAXCHV,
     1IDECPT,
     1IB,
     1IERRFI,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A FORMAT-FREE READ
C              OF ONE LINE OF DATA FROM INPUT UNIT = IRD2.
C              ONLY THE CARD COLUMNS BETWEEN ICOL1 AND ICOL2
C              (INCLUSIVELY) ARE SCANNED FOR THE READ.
C              THIS SUBROUTINE GIVES THE DATA ANALYST THE ABILITY
C              TO GET DATA INTO THE MACHINE FROM A VARIETY OF INPUT
C              SOURCES (CARD, TAPE, DISC, ETC.) WITHOUT HAVING
C              TO WORRY ABOUT AND SPECIFY FORMATS.  THE DATA CARD
C              IMAGES MAY BE MADE WITHOUT REGARD TO ANY PARTICULAR
C              FORMAT AND MAY BE ENTERED INTO THE MACHINE
C              WITHOUT DEFINING ANY FORMATS.
C     INPUT  ARGUMENTS--IRD2   = THE INTEGER VALUE SPECIFYING
C                                THE INPUT UNIT FROM WHICH
C                                THE CARD IMAGES WILL COME.
C                     --ICOL1  = THE INTEGER CARD COLUMN NUMBER
C                                WHICH DEFINES THE LOWER BOUND
C                                (INCLUSIVELY) OF THE INTERVAL
C                                ON EACH CARD IMAGE TO BE SCANNED
C                                FOR THE READ.
C                     --ICOL2  = THE INTEGER CARD COLUMN NUMBER
C                                WHICH DEFINES THE UPPER BOUND
C                                (INCLUSIVELY) OF THE INTERVAL
C                                ON EACH CARD IMAGE TO BE SCANNED
C                                FOR THE READ.
C     OUTPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE READ DATA VALUES
C                                WILL BE SEQUENTIALLY PLACED.
C                     --N      = THE INTEGER VALUE
C                                WHICH WILL EQUAL THE NUMBER OF DATA
C                                VALUES WHICH WERE READ.
C     OUTPUT--THE SINGLE PRECISION VECTOR X WHICH
C             WILL CONTAIN THE READ DATA VALUES, AND
C             THE INTEGER VALUE N WHICH WILL EQUAL THE NUMBER OF
C             DATA VALUES READ INTO X.  ALSO, 7 LINES OF SUMMARY
C             INFORMATION WILL BE GENERATED--
C             REGARDING WHAT WAS IN FACT READ INTO THE MACHINE--
C             1) THE VALUES OF ICOL1 AND ICOL2;
C             2) THE (ENTIRE) FIRST DATA CARD READ;
C             3) THE (ENTIRE) LAST DATA CARD READ;
C             4) THE TOTAL NUMBER OF DATA CARDS READ;
C             5) THE TOTAL NUMBER OF DATA VALUES READ.
C     PRINTING--YES.
C     RESTRICTIONS--ICOL1 AND ICOL2 MUST BE BETWEEN 1 AND 132,
C                   INCLUSIVELY.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     COMMENT--ADJACENT DATA VALUES ON THE SAME CARD MUST BE
C              SEPARATED BY AT LEAST 1 BLANK OR 1 ALPHABETIC
C              CHARACTER, OR BY  ANY COMBINATION OF BLANKS AND
C              ALPHABETIC CHARACTERS.  IN THIS CONTEXT, AN
C              ALPHABETIC CHARACTER IS ANY CHARACTER
C              OTHER THAN 0, 1, 2, ..., 9, +, -, OR ..
C              IN EFFECT, THEREFORE, ALL ALPHABETIC INFORMATION
C              IN THE INTERVAL DEFINED BY ICOL1 AND ICOL2
C              (INCLUSIVELY) IS IGNORED FOR READING PURPOSES.
C              ALL INFORMATION (BOTH NUMERIC AND ALPHABETIC)
C              OUTSIDE THE DEFINED INTERVAL IS ALSO IGNORED
C              FOR READING PURPOSES.
C     COMMENT--THE DATA VALUES ON THE CARDS ARE FREE-FORMAT.
C              THEY MAY BE EITHER INTEGER OR FLOATING POINT
C              (THAT IS, WITHOUT OR WITH THE DECIMAL POINTS).
C              EXPONENTIAL FLOATING POINT FORMAT (E FORMAT)
C              IS NOT PERMITTED.  ALL DATA, WHETHER WITHOUT OR WITH
C              THE DECIMAL POINT ON THE CARDS, WILL BE READ INTO
C              THE MACHINE INTO THE X VECTOR AND WILL RESIDE THERE
C              AS FLOATING POINT NUMBERS.
C     COMMENT--ANY PARTICULAR DATA VALUE MUST START AND END
C              ON THE SAME DATA CARD; DATA VALUES MAY NOT
C              START ON ONE CARD AND FINISH ON THE NEXT.
C              VARIOUS ILLEGAL COMBINATIONS (SUCH AS
C              MULTIPLE DECIMAL POINTS, MULTIPLE PLUSSES OR
C              MINUSES, INCOMPLETE VALUES CONSISTING ONLY
C              OF A DECIMAL POINT, OR ONLY OF A SIGN AND A DECIMAL
C              POINT, ETC. ARE NOT ACCEPTED AND THE
C              DATA ANALYST WILL BE INFORMED OF THE EXISTENCE OF
C              SUCH BY AN ERROR DIAGNOSTIC.
C              IN THE EVENT OF SUCH AN ILLEGAL COMBINATION,
C              THAT 'NUMBER' AND ALL REMAINING NUMBERS ON THAT CARD WILL
C              WILL BE IGNORED (NOT READ INTO THE MACHINE)
C              AND THE NEXT DATA CARD WILL THEN BE READ.
C     COMMENT--THIS SUBROUTINE WILL CONTINUOUSLY AND
C              SEQUENTIALLY READ CARDS UNTIL A CARD WITH
C              THE WORD         END       (SOMEWHERE BETWEEN
C              COLUMNS ICOL1 AND ICOL2 (INCLUSIVELY) IS ENCOUNTERED.
C              TO TERMINATE A DATA SET, THE ANALYST SHOULD
C              APPEND SUCH A CARD WHICH HAS THE WORD
C              END        SOMEWHERE IN THE INTERVAL
C              DEFINED BY ICOL1 AND ICOL2.  FOR EXAMPLE, IF
C              ICOL1 = 1 AND ICOL2 = 20, THEN A SEPARATE CARD WITH
C                 END   IN COLUMNS 1, 2, AND 3, OR IN COLUMNS 10, 11,
C              AND 12, ETC.  WOULD TERMINATE THE READ.
C              IT IS IMPORTANT TO APPEND SUCH A CARD--
C              FAILURE TO DO SO WILL RESULT IN AN INCOMPLETE
C              DATA SET OR (ON SOME COMPUTERS) AN
C              UNPREDICTABLE RUN TERMINATION.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--DECEMBER  1972.
C     UPDATED         --AUGUST    1974.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --OCTOBER   1976.
C     UPDATED         --JANUARY   1977.
C     UPDATED         --MARCH     1977.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --MARCH     1986.
C     UPDATED         --NOVEMBER  1989.  READ STRINGS FROM CERTAIN COLUMNS
C     UPDATED         --MAY       1990.  1) IGNORE BLANK LINES
C                                        2) CHECK FOR "D" EXPONENTIAL NOTATION
C                                        3) CHECK FOR COMMENT CHARACTER COL 1
C     UPDATED         --JULY      1990.  ICOMFL RENAMED AS ICOMSW
C     UPDATED         --FEBRUARY  1994.  WRITE STATEMENTS: 132->80
C     UPDATED         --SEPTEMBER 1995.  REPORT BLANK LINE VIA LINETY
C     UPDATED         --JANUARY   1998.  CHECK LINE FOR NON-PRINTING
C                                        CHARACTERS (CONVERT TO SPACE)
C     UPDATED         --DECEMBER  1999.  ROW LABEL CASE (ROWI)
C     UPDATED         --FEBRUARY  2003.  INCREASE MAXIMUM RECORD LENGTH
C                                        THAT CAN BE READ
C     UPDATED         --JANUARY   2004.  RECODE FOR BETTER CLARITY
C     UPDATED         --JANUARY   2004.  SUPPORT FOR CHARACTER DATA
C     UPDATED         --APRIL     2005.  HANDLE BLANK FIELDS FOR
C                                        VECTOR COLUMN LIMITS CASE
C     UPDATED         --APRIL     2005.  SUPPORT "," AS DECIMAL POINT
C                                        (FOR INTERNATIONAL)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASRE
      CHARACTER*4 IFUNC2
C
      CHARACTER*4 IMACRO
      CHARACTER*12 IMACCS
      CHARACTER*4 IANSLC
      CHARACTER*12 IREACS
      CHARACTER*4 ISTOR1
      CHARACTER*4 ISTOR2
      CHARACTER*4 IEND
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IOFILE
C
      CHARACTER*4 IB
      CHARACTER*4 ICHAR3
      CHARACTER*4 IC
      CHARACTER*4 ICHEXP
C
      CHARACTER*1 IQUOTE
      CHARACTER*4 ICOMCH
      CHARACTER*4 ICOMSW
      CHARACTER*4 LINETY
      CHARACTER*4 IGRPAU
      CHARACTER*4 IREADL
      CHARACTER*4 IREAD2
      CHARACTER*4 IDECPT
C
C---------------------------------------------------------------------
C
      CHARACTER*24 IXC(*)
      DIMENSION X(*)
C
      INTEGER ICOLL(*)
      INTEGER ICOLU(*)
      INTEGER ITYPE(*)
C
      DIMENSION IFUNC2(*)
C
      DIMENSION ISTOR1(*)
      DIMENSION ISTOR2(*)
      DIMENSION IANSLC(*)
      DIMENSION IB(*)
      DIMENSION ICHAR3(41)
      DIMENSION ICHEXP(41)
      DIMENSION IC(10)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOHO.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-----DATA STATEMENTS-------------------------------------------------
C
      DATA IC(1),IC(2),IC(3),IC(4),IC(5),IC(6),IC(7),IC(8),IC(9),IC(10)
     1/'0','1','2','3','4','5','6','7','8','9'/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPRE'
      ISUBN2='AL  '
C
      ISUBN0='REAL'
C
C     THE FOLLOWING NULL-CORRECTION WAS MADE IN APRIL OF 1987 (ELGIN PERRY
C     AND DICK ATLEE FROM THE UNIV. OF MARYLAND; UNIVAC COMPILER MESSAGE)
C
      IOFILE='-999'
C
      IEND='NO'
      IERROR='NO'
      N=0
      NXC=0
      I=0
      ICOL22=0
      LINETY='NUME'
      CALL DPCONA(39,IQUOTE)
      IZERO=48
      IF(IHOST1.EQ.'PRIM')IZERO=48+128
      IF(IHOST1.EQ.'IBM')IZERO=240
      IF(IHOST1.EQ.'CDC')IZERO=16
C
C               **************************************
C               **  CHECK FOR VECTOR COLUMN LIMITS  **
C               **************************************
C
      IF(NCALL.EQ.0)THEN
        DO11I=1,MAXRDV
          ITYPE(I)=-1
   11   CONTINUE
        NCOLS=0
        DO20I=1,50
          IF(ICOLL(I).GT.0 .AND. ICOLU(I).GT.0)THEN
            NCOLS=NCOLS+1
          ELSE
            GOTO29
          ENDIF
   20   CONTINUE
   29   CONTINUE
      ENDIF
      NREAD=0
C
C               *************************
C               **  READ A LINE IMAGE  **
C               *************************
C
      IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'REAL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPREAL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IRD2,ICOL1,ICOL2
   52   FORMAT('IRD2,ICOL1,ICOL2 = ',3I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)MINCO2,MAXCO2,NCALL,NCOLS
   53   FORMAT('MINCO2,MAXCO2,NCALL,NCOLS = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)IBUGS2
   54   FORMAT('IBUGS2 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)IWIDTH
   55   FORMAT('IWIDTH = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,56)(IANSLC(I),I=1,MIN(100,IWIDTH))
   56   FORMAT('(IANSLC(I),I=1,IWIDTH) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,57)IMACCS,IREACS
   57   FORMAT('IMACCS,IREACS = ',A12,2X,A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,58)IOUNIT
   58   FORMAT('IOUNIT = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,61)ICASRE,IREADL,IDECPT,PREAMV,N2,MAXN2
   61   FORMAT('ICASRE,IREADL,IDECPT,PREAMV,N2,MAXN2=',A4,2X,A4,2X,
     1         A4,2X,F10.5,2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(MINCO2.LE.ICOL1.AND.ICOL1.LE.MAXCO2.AND.
     1   MINCO2.LE.ICOL2.AND.ICOL2.LE.MAXCO2)GOTO 89
        WRITE(ICOUT,81)
   81   FORMAT('***** ERROR IN DPREAL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,82)
   82   FORMAT('      THE SPECIFIED COLUMN LIMITS ARE OUTSIDE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,83)
   83   FORMAT('      THE ALLOWABLE LIMITS FOR THIS INPUT DEVICE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,84)IRD2
   84   FORMAT('      INPUT UNIT NUMBER     = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,85)ICOL1,ICOL2
   85   FORMAT('      SPECIFIED COLUMN LIMITS = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,86)MINCO2,MAXCO2
   86   FORMAT('      ALLOWABLE COLUMN LIMITS = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
   89 CONTINUE
C
      NUMCRD=0
  120 CONTINUE
C
C               *********************************************
C               **  STEP 2--                               **
C               **  IF THE READ IS DONE FROM A FILE,       **
C               **  THEN CARRY OUT THE FILE READ OPERATION.**
C               *********************************************
C
      ISTEPN='2'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,91)IOFILE,IRD,IRD2,IOUNIT,IMACCS
   91   FORMAT('IOFILE,IRD,IRD2,IOUNIT,IMACCS = ',A4,3I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IOFILE.EQ.'NO')THEN
C
        IF(IRD2.EQ.IRD)THEN
          READ(IRD2,93,END=8000)(IB(IZ),IZ=1,ICOL2)
   93     FORMAT(132A1)
        ELSEIF(IMACCS.EQ.'OPEN')THEN
          NUMCHA=MAXCO2
          CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                IB,NUMCHA,
     1                ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
        ENDIF
C
      ELSE
        NUMCHA=MAXCO2
        CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1              IB,NUMCHA,
     1              ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      ENDIF
C
CCCCC CHECK FOR COMMENT LINE IN DATA FILE
C
      IF(ICOMSW.EQ.'ON  '.AND.IB(1).EQ.ICOMCH(1:1))THEN
         LINETY='BLAN'
         GOTO9000
      ENDIF
C
      IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'REAL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,96)
   96   FORMAT('***** FROM THE MIDDLE OF DPREAL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,97)(IB(J)(1:1),J=1,80)
   97   FORMAT('IB(.) = ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC REMOVE NON-PRINTING CHARACTERS.  CHECK FOR BLANK LINE
CCCCC AS WELL
C
      IBLANK=0
      DO105J=1,MAXCO2
        ISTOR1(J)=ISTOR2(J)
        CALL DPCOAN(IB(J),ITEMPV)
        IF(ITEMPV.LE.32.OR.ITEMPV.GT.127)IB(J)=' '
        ISTOR2(J)=IB(J)
        IF(IB(J).NE.' ')IBLANK=1
  105 CONTINUE
      IF(IBLANK.EQ.0)THEN
        LINETY='BLAN'
        GOTO9000
      ENDIF
C
      N2=0
      DO106J=ICOL2,ICOL1,-1
        IF(IB(J)(1:1).NE.' ')THEN
          NLAST=J
          GOTO107
        ENDIF
  106 CONTINUE
      NLAST=ICOL1
  107 CONTINUE
      DO108J=ICOL1,NLAST
        N2=N2+1
        IFUNC2(N2)=IB(J)
  108 CONTINUE
      ICOL22=N2+ICOL1-1
C
      IF(ICASRE.EQ.'FUNC')GOTO8000
C
      IF(IB(1).EQ.'E'.AND.IB(2).EQ.'O'.AND.IB(3).EQ.'F')GOTO8000
      IF(ICOL22.LT.ICOL1)THEN
        LINETY='BLAN'
        GOTO9000
      ENDIF
C
C               *******************************************************
C               **  STEP 4--                                         **
C               **  SCAN FOR THE PHRASE     END DATA                 **
C               **  OR THE PHRASE           END OF DATA              **
C               **  OR THE PHRASE           END OF READ              **
C               **  OR THE PHRASE           EOF                      **
C               **  SCAN FOR THE PHRASE BETWEEN COLUMNS 1 TO ICOL2.  **
C               **  EXCEPTION--IF ICOL2 IS LESS THAT 11              **
C               **  (11 = THE NUMBER OF LETTERS IN THE PHRASE        **
C               **  END OF DATA  )                                   **
C               **  THEN EXPAND THE SCAN TO COVER THE COLUMNS 1 TO 11.*
C               *******************************************************
C
      ISTEPN='4'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMAX=ICOL22
      IF(JMAX.GE.3)THEN
        DO130J=1,JMAX-2
          IF((IB(J).EQ.'E'.OR.IB(J).EQ.'e').AND.
     1       (IB(J+1).EQ.'O'.OR.IB(J+1).EQ.'o').AND.
     1       (IB(J+2).EQ.'F'.OR.IB(J+2).EQ.'f'))GOTO8000
  130   CONTINUE
      ENDIF
C
      JMAX=ICOL22
      IF(JMAX.GE.11)THEN
        DO132J=1,JMAX-10
          IF((IB(J).EQ.'E'.OR.IB(J).EQ.'e').AND.
     1       (IB(J+1).EQ.'N'.OR.IB(J+1).EQ.'n').AND.
     1       (IB(J+2).EQ.'D'.OR.IB(J+2).EQ.'d').AND.
     1       (IB(J+3).EQ.' ').AND.
     1       (IB(J+4).EQ.'O'.OR.IB(J+4).EQ.'o').AND.
     1       (IB(J+5).EQ.'F'.OR.IB(J+5).EQ.'f').AND.
     1       (IB(J+6).EQ.' ').AND.
     1       (IB(J+7).EQ.'D'.OR.IB(J+7).EQ.'d').AND.
     1       (IB(J+8).EQ.'A'.OR.IB(J+8).EQ.'a').AND.
     1       (IB(J+9).EQ.'T'.OR.IB(J+9).EQ.'t').AND.
     1       (IB(J+10).EQ.'A'.OR.IB(J+10).EQ.'a'))GOTO8000
  132   CONTINUE
      ENDIF
C
C               *************************************
C               **  STEP 4.2--                     **
C               **  INCREMENT THE NUMBER OF CARDS  **
C               *************************************
C
      ISTEPN='4.2'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMCRD=NUMCRD+1
      IF(ICASRE.EQ.'ROWI')GOTO9000
C
      IF(NCOLS.GT.0)ICOL1=ICOLL(1)
      I=ICOL1
C
C  START OF A NEW VARIABLE.  BASIC ALGORITHM IS:
C
C  1) IF FIRST CHARACTER IS A NUMBER OR A "+" OR "-" OR A ".", ASSUME
C     WE HAVE A NUMBER.
C
C     A) A NUMBER MAY CONTAIN A ".", "+", "-", "E", OR "D".
C
C        4/2005: DECIMAL POINT IS NOW USER SETTABLE.
C
C     B) IF A SINGLE OR DOUBLE QUOTE IS ENCOUNTERED, END NUMBER
C        AND START A STRING.
C
C     C) IF A SPACE, ",", ":", ";", "/", "\", "[", "(", ")", "]",
C        TREAT AS A DELIMITER.  THAT IS, END THE NUMERIC VARIABLE.
C
C     D) ANY OTHER CHARACTER IS ASSUMED TO BE PART OF A CHARACTER
C        VARIABLE.  DEPENDING ON IGRPAU:
C
C        ERROR      - TREAT NON-NUMERIC CHARACTER AS AN ERROR
C        IGNORE     - SKIP THE CURRENT CHARACTER AND ALL SUBSEQUENT
C                     CHARACTERS UNTIL THE NEXT NUMERIC VARIABLE IS
C                     FOUND.
C        CHARACTER  - SEARCH UNTIL ONE OF THE DELIMITERS IS FOUND
C                     AND SAVE STRING IN IXC.
C
C  2) IF FIRST CHARACTER IS A DELIMITER, SIMPLY GO TO NEXT CHARACTER.
C
C  3) IF THE FIRST CHARACTER IS A NON-NUMERIC CHARACTER AND NOT A
C     DELIMITER, THEN ASSUME A CHARACTER VARIABLE.  INTERPERT BASED
C     ON VALUE OF IGRPAU AS DESCRIBED ABOVE.
C
C     IF THE FIRST CHARACTER IS A SINGLE OR DOUBLE QUOTE, ASSUME
C     ANY CHARACTERS UNTIL MATCHING QUOTE FOUND IS PART OF THE
C     CHARACTER VARIABLE.
C
C  APRIL 2005.  FOR VECTOR COLUMN LIMITS, CHECK IMMEDIATELY FOR
C               A BLANK FIELD.  IF BLANK FIELD ENCOUNTERED, THEN
C               SET TO MISSING VALUE AND CONTINUE TO NEXT FIELD.
C
  149 CONTINUE
      NREAD=NREAD+1
      IF(NCOLS.GT.0)THEN
        IF(NREAD.GT.NCOLS)GOTO9000
        I=ICOLL(NREAD)
        ICOL22=ICOLU(NREAD)
C
        DO22140II=I,ICOL22
          IF(IB(II).NE.' ')GOTO22149
22140   CONTINUE
C
        N=N+1
        X(N)=PREAMV
        GOTO149
C
22149   CONTINUE
      ENDIF
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        WRITE(ICOUT,1149)NREAD,I,ICOL22
 1149   FORMAT('NREAD,I,ICOL22 = ',3I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
  150 CONTINUE
C
      DO151J=1,41
        ICHAR3(J)=' '
  151 CONTINUE
C
      NC=0
      NDP=0
      NSIGN=0
      NCE=0
      NUMDEX=0
      ISUMEX=0
      LOCPT=0
      AFACT=1.0
      NSTR=0
C
      IF(IDECPT.NE.'.')THEN
        IF(IDECPT.EQ.IREADL)THEN
          IF(IREADL.NE.';')THEN
            IREAD2=';'
          ELSE
            IREAD2=':'
          ENDIF
        ENDIF
      ELSE
        IREAD2=IREADL
      ENDIF
C
C               **************************************************
C               **  VECTOR COLUMN LIMITS CASE                   **
C               **************************************************
C
      ITYP=0
      IF(NCALL.GT.0)ITYP=ITYPE(NREAD)
C
C  HANDLE CHARACTER FIELD IMMEDIATELY
C
      IF(NCOLS.GT.0 .AND. ITYP.EQ.1)THEN
        IF(IGRPAU.EQ.'IGNO')GOTO149
        DO153L=I,ICOL22
          IF(IB(L).NE.' ')THEN
            IFRST=L
            GOTO154
          ENDIF
  153   CONTINUE
        IF(NXC.LE.MAXCHV)THEN
          NXC=NXC+1
          IXC(NXC)=' '
        ENDIF
        GOTO149
  154   CONTINUE
        DO157L=ICOL22,I,-1
          IF(IB(L).NE.' ')THEN
            ILAST=L
            GOTO159
          ENDIF
  157   CONTINUE
        ILAST=IFRST
  159   CONTINUE
        IF(NXC.LE.MAXCHV)THEN
          NXC=NXC+1
          IXC(NXC)=' '
          J=0
          DO158II=IFRST,ILAST
            J=J+1
            IXC(NXC)(J:J)=IB(II)
  158     CONTINUE
        ENDIF
        GOTO149
      ENDIF
      IF(NCALL.EQ.0)ITYPE(NREAD)=1
C
C               **************************************************
C               **  STEP 6--                                    **
C               **  EXAMINE THE I-TH CHARACTER IN THIS STRING,  **
C               **************************************************
C
C
  160 CONTINUE
C
      ISTEPN='6'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,161)I,IB(I)
  161   FORMAT('I,IB(I) = ',I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************************
C               **  STEP 6.1--             **
C               **  TREAT THE 0 TO 9 CASE  **
C               *****************************
C
      IBASCI=ICHAR(IB(I)(1:1)) - IZERO
      IF(IBASCI.GE.0 .AND. IBASCI.LE.9)THEN
        IF(NC.EQ.0)NSIGN=NSIGN+1
        NC=NC+1
        ICHAR3(NC)=IB(I)
        I=I+1
        IF(I.LE.ICOL22)GOTO160
        GOTO1050
      ELSEIF(IB(I).EQ.'+' .OR. IB(I).EQ.'-')THEN
C
C               **************************
C               **  STEP 6.3--          **
C               **  TREAT THE +/- CASE  **
C               **************************
C
C
        ISTEPN='6.3'
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IF(NC.NE.0)THEN
          IF(NSIGN.EQ.1)THEN
            IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
              WRITE(ICOUT,3001)I,IB(I)
 3001         FORMAT('AT START OF EXPONENT EVALUATION--I,IB(I) = ',
     1               I6,2X,A1)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            NCE=1
            NUMDEX=NCE-1
            ICHEXP(1)=IB(I)
            I=I+1
            IF(I.LE.ICOL22)THEN
 3160         CONTINUE
              IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
                WRITE(ICOUT,3002)I,IB(I)
 3002           FORMAT('IN MIDST OF EXPONENT EXTRACTION--I,IB(I) = ',
     1                 I6,2X,A1)
                CALL DPWRST('XXX','BUG ')
              ENDIF
              IBASCI=ICHAR(IB(I)(1:1)) - IZERO
              IF(IBASCI.GE.0 .AND. IBASCI.LE.9)THEN
                NCE=NCE+1
                NUMDEX=NCE-1
                ICHEXP(NCE)=IB(I)
                I=I+1
                IF(I.LE.ICOL22)GOTO3160
                GOTO1050
              ENDIF
              IF(IB(I).EQ.'+'.OR.IB(I).EQ.'-'.OR.IB(I).EQ.IDECPT)THEN
                IERROR='YES'
                WRITE(ICOUT,999)
                CALL DPWRST('XXX','BUG ')
                WRITE(ICOUT,2051)
 2051           FORMAT('***** INPUT DATA ERROR--AN ILLEGAL CHARACTER ',
     1               'HAS OCCURRED IN THE MIDDLE OF SOME EXPONENT ON ',
     1               'THE CARD BELOW *****')
                CALL DPWRST('XXX','BUG ')
                WRITE(ICOUT,2052)IB(I)
 2052           FORMAT('THE ILLEGAL CHARACTER WAS ',A1)
                CALL DPWRST('XXX','BUG ')
                GOTO8100
              ENDIF
              GOTO1050
            ENDIF
            GOTO1050
          ENDIF
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2001)
 2001     FORMAT('***** INPUT    DATA ERROR--',
     1           'A PLUS OR MINUS HAS OCCURRED IN THE MIDDLE OF SOME ',
     1           'DATA VALUE ON THE CARD BELOW *****')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2021)
 2021     FORMAT('      THIS ILLEGAL DATA VALUE AND ALL ',
     1           'SUBSEQUENT DATA VALUES ON THIS CARD IMAGE ',
     1           'HAVE BEEN DELETED')
          CALL DPWRST('XXX','BUG ')
          GOTO8100
        ELSE
          IF(IB(I).EQ.'-')AFACT=-1.0
          NSIGN=NSIGN+1
          I=I+1
          IF(I.LE.ICOL22)GOTO160
          N=N+1
          X(N)=AFACT
          GOTO149
        ENDIF
      ELSEIF(IB(I).EQ.IDECPT)THEN
C
C               *****************************************
C               **  STEP 7--                           **
C               **  TREAT THE DECIMAL POINT CASE--     **
C               *****************************************
C
        ISTEPN='7'
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IF(NC.EQ.0 .AND. NSIGN.EQ.0)THEN
          AFACT=1.0
          NSIGN=NSIGN+1
        ENDIF
        NC=NC+1
        ICHAR3(NC)=IB(I)
        NDP=NDP+1
        I=I+1
        LOCPT=NC
        IF(I.LE.ICOL22)GOTO160
        IF(NC.GE.2)THEN
          IF(NDP.EQ.1)THEN
            GOTO1050
          ELSE
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2005)
 2005       FORMAT('***** INPUT     DATA ERROR--',
     1             'SOME DATA VALUE ON THE CARD BELOW ',
     1             'HAS MULTIPLE DECIMAL POINTS *****')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2021)
            CALL DPWRST('XXX','BUG ')
            GOTO8100
          ENDIF
        ELSE        
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IF(NC.EQ.0)THEN
            WRITE(ICOUT,2007)
 2007       FORMAT('***** INPUT     DATA ERROR--',
     1             'THE LAST DATA VALUE ON THE CARD BELOW',
     1             'CONSISTS ONLY OF A DECIMAL POINT')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(NC.EQ.1)THEN
            WRITE(ICOUT,2006)IDECPT,IDECPT
 2006       FORMAT('***** INPUT     DATA ERROR--',
     1             'THE LAST DATA VALUE ON THE CARD BELOW ',
     1             'CONSISTS OF ONLY A    +',A1,'  OR   -',A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,2021)
          CALL DPWRST('XXX','BUG ')
          GOTO8100
        ENDIF
      ELSEIF((IB(I).EQ.'E'.OR.IB(I).EQ.'e'.OR.
     1       IB(I).EQ.'D'.OR.IB(I).EQ.'d') .AND. NC.GT.0)THEN
C
C               ***************************************************
C               **  STEP 10--                                    **
C               **  FORM THE VECTOR ICHEXP(.) WHICH              **
C               **  CONTAINS CHARACTERS OF THE EXPONENT (IF ANY).**
C               ***************************************************
C
        ISTEPN='10'
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        NCE=0
        I=I+1
        IF(I.LE.ICOL22)THEN
          IF(IB(I).NE.'+' .AND. IB(I).NE.'-')THEN
            NCE=NCE+1
            NUMDEX=NCE-1
            ICHEXP(NCE)='+'
          ENDIF
          NCE=NCE+1
          NUMDEX=NCE-1
          ICHEXP(NCE)=IB(I)
          I=I+1
          IF(I.LE.ICOL22)THEN
 4160       CONTINUE
            IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
              WRITE(ICOUT,3002)I,IB(I)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            IBASCI=ICHAR(IB(I)(1:1)) - IZERO
            IF(IBASCI.GE.0 .AND. IBASCI.LE.9)THEN
              NCE=NCE+1
              NUMDEX=NCE-1
              ICHEXP(NCE)=IB(I)
              I=I+1
              IF(I.LE.ICOL22)GOTO4160
              GOTO1050
            ENDIF
            IF(IB(I).EQ.'+'.OR.IB(I).EQ.'-'.OR.IB(I).EQ.IDECPT)THEN
              IERROR='YES'
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,2051)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,2052)IB(I)
              CALL DPWRST('XXX','BUG ')
              GOTO8100
            ENDIF
            GOTO1050
          ENDIF
          GOTO1050
        ENDIF
        GOTO1050
      ELSE
C
        IF(NC.EQ.1.AND.ICHAR3(I).EQ.IDECPT.AND.IGRPAU.EQ.'ERRO')THEN
C
C               ****************************************************
C               **  STEP 8.3--                                    **
C               **  TREAT THE SPECIAL CASE WHEN THE SECOND OR MORE**
C               **  CHARACTER  IS ALPHABETIC, BLANK, ETC.         **
C               ****************************************************
C
          ISTEPN='8.3'
          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2009)IDECPT,IDECPT
 2009     FORMAT('***** INPUT    DATA ERROR--',
     1           'SOME DATA VALUE ON THE CARD BELOW ',
     1           'CONSISTS OF ONLY A   +',A1,' OR -',A1)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2021)
          CALL DPWRST('XXX','BUG ')
          GOTO8100
        ENDIF
        IF(NC.GE.1 .AND. (IB(I).EQ.' ' .OR. IB(I).EQ.IREAD2))GOTO1050
        IQFLAG=0
        ISFLAG=0
 6160   CONTINUE
C
        IF(IB(I).EQ.' ')THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.IREAD2)THEN
          IDELIM=1
          IF(NC.EQ.0)THEN
            IF(NCALL.EQ.0)THEN
              N=N+1
              X(N)=PREAMV
              ITYPE(NREAD)=0
            ELSE
              IF(ITYP.EQ.0)THEN
                N=N+1
                X(N)=PREAMV
              ELSE
                NXC=NXC+1
                IXC(NXC)=' '
              ENDIF
            ENDIF
            I=I+1
            IF(I.LE.ICOL22)GOTO149
            GOTO1040
          ENDIF
        ELSEIF(IB(I).EQ.IREAD2)THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.':')THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.';')THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.'%')THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.'/')THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.'(')THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.'[')THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.')')THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.']')THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.IBASLC)THEN
          IDELIM=1
        ELSEIF(IB(I).EQ.'"')THEN
          IDELIM=2
        ELSEIF(IB(I).EQ.IQUOTE)THEN
          IDELIM=3
        ELSE
          IDELIM=0
        ENDIF
C
        IF(NC.EQ.0 .AND. ISFLAG.EQ.0)THEN
C
C            *******************************************************
C            **  STEP 8.1--                                       **
C            **  TREAT THE SPECIAL CASE WHEN THE LEADING CHARACTER**
C            **  IS ALPHABETIC, BLANK, ETC.                       **
C            *******************************************************
C
          ISTEPN='8.1'
          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
            WRITE(ICOUT,6081)IDELIM,ISFLAG,IQFLAG,NC,NSTR,NSIGN
 6081       FORMAT('IDELIM,ISFLAG,IQFLAG,NC,NSTR,NSIGN=',6I5)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IF(NSIGN.EQ.1)THEN
            N=N+1
            X(N)=AFACT
            GOTO149
          ENDIF
C
C  FOR ALL CASES, TREAT DELIMITER
C
          IF(IGRPAU.EQ.'ERRO')THEN
            I=I+1
            IF(I.LE.ICOL22)GOTO160
            GOTO9000
          ELSEIF(IGRPAU.EQ.'IGNO' .OR. IGRPAU.EQ.'CHAR')THEN
            IF(IDELIM.EQ.0)THEN
              NXC=NXC+1
              IXC(NXC)=' '
              NSTR=1
              IXC(NXC)(NSTR:NSTR)=IB(I)
              ISFLAG=1
              NC=NC+1
              I=I+1
              IF(I.LE.ICOL22)GOTO6160
              GOTO1040
            ELSEIF(IDELIM.EQ.1)THEN
              I=I+1
              IF(I.LE.ICOL22)GOTO150
              IF(NCOLS.GT.0)THEN
                N=N+1
                X(N)=PREAMV
                IF(NCALL.EQ.0)ITYPE(NREAD)=0
                GOTO149
              ELSE
                GOTO9000
              ENDIF
            ELSEIF(IDELIM.EQ.2)THEN
              ISFLAG=1
              NXC=NXC+1
              IF(NXC.LE.MAXCHV)IXC(NXC)=' '
              IQFLAG=1
              IF(I.LE.ICOL22)GOTO6160
              GOTO1040
            ELSEIF(IDELIM.EQ.3)THEN
              ISFLAG=1
              NXC=NXC+1
              IF(NXC.LE.MAXCHV)IXC(NXC)=' '
              IQFLAG=2
              IF(I.LE.ICOL22)GOTO6160
              GOTO1040
            ENDIF
          ENDIF
        ELSEIF(NC.GE.1 .OR. ISFLAG.EQ.1)THEN
          IF(IGRPAU.EQ.'ERRO')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6009)
 6009       FORMAT('***** INPUT    DATA ERROR--',
     1             'SOME DATA VALUE ON THE CARD BELOW ',
     1             'CONSISTS OF A NON-NUMERIC CHARACTER.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2021)
            CALL DPWRST('XXX','BUG ')
            GOTO8100
          ELSEIF(IGRPAU.EQ.'IGNO' .OR. IGRPAU.EQ.'CHAR')THEN
            IF(IQFLAG.EQ.1)THEN
              IF(IDELIM.EQ.2)THEN
                IQFLAG=0
                ISFLAG=0
                I=I+1
                IF(I.LE.ICOL22)GOTO149
                GOTO1040
              ELSE
                IF(IGRPAU.EQ.'CHAR' .AND. NXC.LE.MAXCHV)THEN
                  NSTR=NSTR+1
                  IF(NSTR.LE.24)IXC(NXC)(NSTR:NSTR)=IB(I)
                ENDIF
                I=I+1
                IF(I.LE.ICOL22)GOTO6160
                GOTO1040
              ENDIF
            ELSEIF(IQFLAG.EQ.2)THEN
              IF(IDELIM.EQ.3)THEN
                IQFLAG=0
                I=I+1
                IF(I.LE.ICOL22)GOTO149
                GOTO1040
              ELSE
                IF(IGRPAU.EQ.'CHAR' .AND. NXC.LE.MAXCHV)THEN
                  NSTR=NSTR+1
                  IF(NSTR.LE.24)IXC(NXC)(NSTR:NSTR)=IB(I)
                ENDIF
                I=I+1
                IF(I.LE.ICOL22)GOTO6160
                GOTO1040
              ENDIF
            ENDIF
            IF(IDELIM.EQ.0)THEN
              IF(IGRPAU.EQ.'CHAR' .AND. NXC.LE.MAXCHV)THEN
                NSTR=NSTR+1
                IF(NSTR.LE.24)IXC(NXC)(NSTR:NSTR)=IB(I)
              ENDIF
              NC=NC+1
              I=I+1
              IF(I.LE.ICOL22)GOTO6160
              GOTO1040
            ELSEIF(IDELIM.EQ.1)THEN
              IF(ISFLAG.EQ.1)ISFLAG=0
              I=I+1
              IF(I.LE.ICOL22)GOTO149
              GOTO1040
            ELSEIF(IDELIM.EQ.2)THEN
              NC=0
              IQFLAG=1
              ISFLAG=1
              IF(I.LE.ICOL22)GOTO6160
              GOTO1040
            ELSEIF(IDELIM.EQ.3)THEN
              NC=0
              IQFLAG=2
              ISFLAG=1
              IF(I.LE.ICOL22)GOTO6160
              GOTO1040
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      GOTO1050
C
C               **************************************
C               **  FOR VECTOR COLUMN LIMITS, GO TO **
C               **  NEXT FIELD.                     **
C               **************************************
C
 1040 CONTINUE
      IF(NCOLS.GT.0)GOTO150
      GOTO9000
C
C               **************************************
C               **  STEP 12--                       **
C               **  OPERATE ON THE ICHAR3(.) VECTOR **
C               **************************************
C
 1050 CONTINUE
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,1051)NC
 1051   FORMAT('NC = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1052)(ICHAR3(IZ),IZ=1,NC)
 1052   FORMAT('ICHAR3(.) = ',30A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ************************************************
C               **  STEP 12.1--                               **
C               **  LOCATE THE POSITION OF THE DECIMAL POINT  **
C               ************************************************
C
      IF(NCALL.EQ.0)ITYPE(NREAD)=0
      IF(NC.EQ.0)THEN
        IF(NSIGN.EQ.1)THEN
          N=N+1
          X(N)=AFACT
        ELSEIF(NCOLS.GT.0)THEN
          N=N+1
          X(N)=PREAMV
        ENDIF
        GOTO149
      ENDIF
C
      IF(NDP.EQ.0)THEN
        NC=NC+1
        ICHAR3(NC)=IDECPT
        LOCPT=NC
      ENDIF
C
C               ********************************
C               **  STEP 12.2--               **
C               **  COMPUTE THE INTEGER PART  **
C               ********************************
C
C
      ISTEPN='12.2'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUMINT=0.0
      NUMINT=LOCPT-1
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        WRITE(ICOUT,1201)NC,LOCPT,NUMINT
 1201   FORMAT('NC,LOCPT,NUMINT = ',3I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(NUMINT.GT.0)THEN
        IPOWER=-1
        DO1200J=LOCPT-1,1,-1
          IBASCI=ICHAR(ICHAR3(J)(1:1)) - IZERO
          IF(IBASCI.GE.0 .AND. IBASCI.LE.9)THEN
            IPOWER=IPOWER+1
            SUMINT=SUMINT+REAL(IBASCI)*(10.0**IPOWER)
            GOTO1200
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2024)
 2024     FORMAT('***** INTERNAL ERROR IN DPREAL--A ',
     1           'NON-NUMERIC CHARACTER WAS ENCOUNTERED IN ',
     1           'CONVERTING THE INTEGER PART')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2025)(ICHAR3(L),L=1,41)
 2025     FORMAT('     OF THE FOLLOWING DATA VALUE--',41A1)
          CALL DPWRST('XXX','BUG ')
          GOTO8100
C
 1200   CONTINUE
      ENDIF
C
C               ***********************************
C               **  STEP 12.2--                  **
C               **  COMPUTE THE FRACTIONAL PART  **
C               ***********************************
C
      SUMDEC=0.0
      NUMDEC=NC-LOCPT
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        ISTEPN='12.2'
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,1601)NC,LOCPT,NUMDEC
 1601   FORMAT('NC,LOCPT,NUMDEC = ',3I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(NUMDEC.NE.0)THEN
        IPOWER=0
        DO1500J=LOCPT+1,NC
          IBASCI=ICHAR(ICHAR3(J)(1:1)) - IZERO
          IF(IBASCI.GE.0 .AND. IBASCI.LE.9)THEN
            IPOWER=IPOWER+1
            SUMDEC=SUMDEC+REAL(IBASCI)/(10.0**IPOWER)
            GOTO1500
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2026)
 2026     FORMAT('***** INTERNAL ERROR IN DPREAL--A NON-NUMERIC ',
     1           'CHARACTER WAS ENCOUNTERED IN CONVERTING ',
     1           'THE DECIMAL PART')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2025)(ICHAR3(L),L=1,41)
          CALL DPWRST('XXX','BUG ')
          GOTO8100
 1500   CONTINUE
      ENDIF
C
C               ***************************************************
C               **  STEP 12.3--                                  **
C               **  IF EXPONENTIAL FORMAT, COMPUTE THE           **
C               **  EXPONENTIAL PART.                            **
C               ***************************************************
C
      ISTEPN='12.3'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,1851)NCE,NUMDEX,ICHEXP(1),ICHEXP(2),ICHEXP(3)
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1851 FORMAT('NCE,NUMDEX,ICHEXP(1),ICHEXP(2),ICHEXP(3) = ',2I8,
     12X,A4,2X,A4,2X,A4)
      ISUMEX=0
      IF(NUMDEX.NE.0)THEN
        ISTART=2
        ISTOP=NUMDEX+1
        IPOWER=-1
        DO1860J=ISTART,ISTOP
          JREV=ISTOP-J+2
          IBASCI=ICHAR(ICHEXP(JREV)(1:1)) - IZERO
          IF(IBASCI.GE.0 .AND. IBASCI.LE.9)THEN
            IPOWER=IPOWER+1
            ISUMEX=ISUMEX+IBASCI*(INT(10.0**IPOWER + 0.01))
              GOTO1860
            ENDIF
 1870     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2027)
 2027     FORMAT('***** INTERNAL ERROR IN DPREAL--A NON-NUMERIC',
     1           'CHARACTER WAS ENCOUNTERED IN CONVERTING ',
     1           'THE EXPONENTIAL PART')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2028)(ICHEXP(L),L=1,41)
 2028     FORMAT('      THE EXPONENT WAS AS FOLLOWS--',41A1)
          CALL DPWRST('XXX','BUG ')
          GOTO8100
 1860   CONTINUE
        IF(ICHEXP(1).EQ.'-')ISUMEX=-ISUMEX
      ENDIF
C
C               ****************************************************
C               **  STEP 12.4--                                   **
C               **  FINAL STEPS:                                  **
C               **  1) COMBINE THE INTEGER, DECIMAL, AND          **
C               **     EXPONENTIAL PARTS                          **
C               **  2) DETERMINE THE SIGN FOR THE ENTIRE NUMBER   **
C               **  3) PLACE THE COMPUTED NUMBER                  **
C               **     IN THE PROPER ELEMENT OF X(.)  **
C               ****************************************************
C
      ISTEPN='12.4'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,3003)SUMINT,SUMDEC,ISUMEX,NUMDEX
 3003   FORMAT('SUMINT,SUMDEC,ISUMEX,NUMDEX = ',2E15.7,2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      SUM=AFACT*(SUMINT+SUMDEC)*(10.0**ISUMEX)
      N=N+1
      X(N)=SUM
C
C               *********************************************
C               **  STEP 15--                              **
C               **  INCREMENT THE COLUMN AND DETERMINE IF  **
C               **  THE READ OF THE LINE IS FINISHED       **
C               *********************************************
C
      ISTEPN='15'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3011)I,ICOL22
 3011   FORMAT('I,ICOL22 = ',I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      I=I+1
      IF(I.LE.ICOL22 .OR. NCOLS.GT.0)GOTO149
      GOTO9000
C               **********************************
C               **  STEP 18--                   **
C               **  TREAT THE END OF FILE CASE  **
C               **********************************
C
 8000 CONTINUE
C
      ISTEPN='18'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IEND='YES'
      GOTO9000
C               **********************************
C               **  STEP 19                     **
C               **  ERROR READING FILE          **
C               **********************************
C
 8100 CONTINUE
C
      ISTEPN='19'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NUMLR2=NUMLRD+NUMCRD
      WRITE(ICOUT,8122)NUMLR2
 8122 FORMAT('      THIS CARD IMAGE WAS THE ',I8,' TH DATA CARD ',
     1       'IMAGE THAT WAS READ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8123)(IB(J),J=1,80)
 8123 FORMAT('      THE CARD IMAGE IS AS FOLLOWS--',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REAL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPREAL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)ICOL1,ICOL2,ICOL22
 9012   FORMAT('ICOL1,ICOL2,ICOL22 = ',3I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)MINCO2,MAXCO2
 9013   FORMAT('MINCO2,MAXCO2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)IBUGS2
 9014   FORMAT('IBUGS2 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)N,NXC
 9015   FORMAT('N,NXC = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)X(1),X(2),X(3)
 9016   FORMAT('X(1),X(2),X(3) = ',3E15.7)
        CALL DPWRST('XXX','BUG ')
        IF(N.GE.1)THEN
          WRITE(ICOUT,9017)X(N)
 9017     FORMAT('X(1) = ',E15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NXC.GE.1)THEN
          DO9119I=1,NXC
            WRITE(ICOUT,9117)I,IXC(I)
 9117       FORMAT('I,IXC(I) = ',I8,A24)
            CALL DPWRST('XXX','BUG ')
 9119     CONTINUE
        ENDIF
        WRITE(ICOUT,9018)IEND,IERROR
 9018   FORMAT('IEND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9019)I,ICOL22
 9019   FORMAT('I,ICOL22D = ',I8,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9021)IWIDTH
 9021   FORMAT('IWIDTH = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9022)(IANSLC(I),I=1,MIN(100,IWIDTH))
 9022   FORMAT('(IANSLC(I),I=1,IWIDTH) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9023)IMACCS,IOFILE
 9023   FORMAT('IMACCS,IOFILE = ',A12,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9024)IOUNIT
 9024   FORMAT('IOUNIT = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9031)ICASRE,N2,MAXN2
 9031   FORMAT('ICASRE,N2,MAXN2 = ',A4,2X,2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9032)(IFUNC2(I),I=1,100)
 9032   FORMAT('(IFUNC2(I),I=1,100) = ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPREBA(ADERBA,MAXREG,AREGBA,IREBIN,IREBPL,
CCCCC MARCH 1994.  ADD IREBPL ARGUMENT.
CCCCC SUBROUTINE DPREBA(ADERBA,MAXREG,AREGBA,IREBIN,
CCCCC SUBROUTINE DPREBA(IHARG,IARGT,ARG,NUMARG,ADERBA,MAXREG,AREGBA,
CCCCC OCTOBER 1993.  ABOVE LINE MODIFIED (DPCOHK.INC NOW INCLUDED
CCCCC IN THIS ROUTINE, SO NO NEED TO PASS).
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE REGION BASES.
C              THESE ARE LOCATED IN THE VECTOR AREGBA(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --ADERBA
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--AREGBA (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --OCTOBER   1993.  ADD REGION BASE AUTOMATIC Y
C     UPDATED         --OCTOBER   1993.  ADD REGION BASE INTERPOLATE
C                                               <ON/OFF>
C     UPDATED         --MARCH     1994.  ADD REGION BASE POLYGON
C                                               <ON/OFF>
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC OCTOBER 1993.  COMMENT OUT FOLLOWING 2 LINES
CCCCC CHARACTER*4 IHARG
CCCCC CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
CCCCC ADD FOLLOWING LINE NOVEMBER 1994.
      CHARACTER*4 IBUGQ
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC OCTOBER 1993.  ADD FOLLOWING SECTION.
      CHARACTER*4 IREBIN
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IWRITE
CCCCC MARCH 1994.  ADD FOLLOWING LINE.
      CHARACTER*4 IREBPL
C
CCCCC OCTOBER 1993.  COMMENT OUT FOLLOWING 3 LINES
CCCCC DIMENSION IHARG(*)
CCCCC DIMENSION IARGT(*)
CCCCC DIMENSION ARG(*)
      DIMENSION AREGBA(*)
C
CCCCC OCTOBER 1993.  ADD FOLLOWING COMMON BLOCKS
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPRE'
      ISUBN2='BA  '
C
      NUMREG=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPREBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ADERBA
   55 FORMAT('ADERBA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)AREGBA(1)
   70 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,AREGBA(I)
   76 FORMAT('I,AREGBA(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
CCCCC OCTOBER 1993.  ADD REGION BASE AUTOMATIC <VAR>
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'AUTO')GOTO3000
CCCCC OCTOBER 1993.  ADD REGION BASE INTERPOLATE <ON/OFF>
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'INTE')GOTO4000
CCCCC MARCH 1994.  ADD REGION BASE POLYGON <ON/OFF>
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'POLY')GOTO5000
C
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=ADERBA
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      AREGBA(1)=ADERBA
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-1
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADERBA
      IF(IHOLD1.EQ.'OFF')HOLD2=ADERBA
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADERBA
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADERBA
      AREGBA(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,AREGBA(I)
 1276 FORMAT('THE BASE OF REGION ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADERBA
      IF(IHOLD1.EQ.'OFF')HOLD2=ADERBA
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADERBA
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADERBA
      DO1315I=1,NUMREG
      AREGBA(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)AREGBA(I)
 1316 FORMAT('THE BASE OF ALL REGIONS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               ******************************************************
C               **  STEP 30--                                       **
C               **  TREAT THE REGION BASEAUTOMATIC <VARIABLE>   CASE**
C               ******************************************************
C
 3000 CONTINUE
C
C               ********************************************
C               **  STEP 31--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 2 (OR 3)**
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='31'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(3)
      IHLEF2=IHARG2(3)
      IF(IHARG(3).EQ.'DIST'.AND.IHARG2(3).EQ.'INCT')IHLEFT=IHARG(4)
      IF(IHARG(3).EQ.'DIST'.AND.IHARG2(3).EQ.'INCT')IHLEF2=IHARG2(4)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               *****************************************
C               **  STEP 32--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='32'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO3290
      DO3200J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO3210
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO3210
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO3220
 3200 CONTINUE
      GOTO3290
 3210 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO3290
 3220 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO3290
 3290 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO3295
      WRITE(ICOUT,3291)NUMARG,ILOCQ
 3291 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 3295 CONTINUE
C
C               *********************************************
C               **  STEP 33--                              **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='33'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO3310
      IF(ICASEQ.EQ.'SUBS')GOTO3320
      IF(ICASEQ.EQ.'FOR')GOTO3330
C
 3310 CONTINUE
      DO3315I=1,NLEFT
      ISUB(I)=1
 3315 CONTINUE
      NQ=NLEFT
      GOTO3350
C
 3320 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3350
C
 3330 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3350
C
 3350 CONTINUE
      MINN2=1
      IF(NQ.GE.MINN2)GOTO3360
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3351)
 3351 FORMAT('***** ERROR IN DPREBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3352)
 3352 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3353)IHLEFT,IHLEF2
 3353 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3354)
 3354 FORMAT('      (FOR WHICH REGION BASE DEFINITIONS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3355)
 3355 FORMAT('      ARE TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3356)MINN2
 3356 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3357)
 3357 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3358)
 3358 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3359)(IANS(I),I=1,IWIDTH)
 3359 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3360 CONTINUE
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3370I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3370
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 3370 CONTINUE
      NS=J
      NY=J
C
C               *****************************************
C               **  STEP 34--                          **
C               **  IF HAVE THE FORM--                 **
C               **  REGION BASE AUTOMATIC DISTINCT X   **
C               **  EXTRACT THE DISTINCT VALUES        **
C               **  FROM THE TARGET VARIABLE Y(.)   .  **
C               **  STORE THEM IN X(.)   .             **
C               **  IF HAVE THE FORM--                 **
C               **  CHARACTERS AUTOMATIC X             **
C               **  DO NOTHING                         **
C               *****************************************
C
      IF(IHARG(3).EQ.'DIST'.AND.IHARG2(3).EQ.'INCT')GOTO3420
C
 3410 CONTINUE
      DO3411I=1,NY
      X(I)=Y(I)
 3411 CONTINUE
      NX=NY
      GOTO3490
C
 3420 CONTINUE
      IWRITE='OFF'
      CALL DISTIN(Y,NY,IWRITE,X,NX,IBUGP2,IERROR)
      GOTO3490
C
 3490 CONTINUE
C
C               ******************************************
C               **  STEP 36--                           **
C               **  COPY VALUES IN X(.) TO ABARBA       **
C               **        MAX NUMBER OF BARS    = 100   **
C               ******************************************
C
      IMAX=NX
      IF(IMAX.GT.MAXREG)IMAX=MAXREG
      DO3650I=1,IMAX
      AREGBA(I)=X(I)
 3650 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO3679
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO3675I=1,IMAX
      WRITE(ICOUT,3676)I,AREGBA(I)
 3676 FORMAT('REGION BASE ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 3675 CONTINUE
 3679 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               ******************************************
C               **  STEP 40--                           **
C               **  REGION BASE INTERPOLATE <ON/OFF>    **
C               ******************************************
 4000 CONTINUE
      IREBIN='ON'
      IF(NUMARG.EQ.2)THEN
        IREBIN='ON'
      ELSE IF(NUMARG.EQ.3)THEN
        IF(IHARG(3).EQ.'ON')IREBIN='ON'
        IF(IHARG(3).EQ.'YES')IREBIN='ON'
        IF(IHARG(3).EQ.'TRUE')IREBIN='ON'
        IF(IHARG(3).EQ.'DEFA')IREBIN='ON'
        IF(IHARG(3).EQ.'AUTO')IREBIN='ON'
        IF(IHARG(3).EQ.'OFF')IREBIN='OFF'
        IF(IHARG(3).EQ.'NO')IREBIN='OFF'
        IF(IHARG(3).EQ.'FALS')IREBIN='OFF'
      ENDIF
C
      IF(IFEEDB.EQ.'OFF')GOTO4099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4010)IREBIN
 4010 FORMAT('REGION BASE INTERPOLATE HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 4099 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               ******************************************
C               **  STEP 50--                           **
C               **  REGION BASE POLYGON     <ON/OFF>    **
C               ******************************************
 5000 CONTINUE
      IREBPL='ON'
      IF(NUMARG.EQ.2)THEN
        IREBPL='ON'
      ELSE IF(NUMARG.EQ.3)THEN
        IF(IHARG(3).EQ.'ON')IREBPL='ON'
        IF(IHARG(3).EQ.'YES')IREBPL='ON'
        IF(IHARG(3).EQ.'TRUE')IREBPL='ON'
        IF(IHARG(3).EQ.'DEFA')IREBPL='ON'
        IF(IHARG(3).EQ.'AUTO')IREBPL='ON'
        IF(IHARG(3).EQ.'OFF')IREBPL='OFF'
        IF(IHARG(3).EQ.'NO')IREBPL='OFF'
        IF(IHARG(3).EQ.'FALS')IREBPL='OFF'
      ENDIF
C
      IF(IFEEDB.EQ.'OFF')GOTO5099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5010)IREBPL
 5010 FORMAT('REGION BASE POLYGON HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 5099 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPREBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ADERBA
 9015 FORMAT('ADERBA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)AREGBA(1)
 9030 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,AREGBA(I)
 9036 FORMAT('I,AREGBA(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRECH(IHARG,NUMARG,
     1IBASLC,
     1IREPCH,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE REPLACEMENT CHARACTOR WHICH MAY
C              BE USED TO REPLACE A PARAMETER NAME
C              OR A STRING NAME BY ITS CONTENTS.
C              WHEN A COMMAND LINE IS READ,
C              IT IS SEARCHED FOR THE REPLACEMENT CHARACTER;
C              IF IT IS FOUND, THE PARAMETER OR STRING
C              NAME IMMEDIATELY FOLLOWING THE REPLACEMENT CHARACTER
C              IS REPLACEWD/SUBSTITUTED IN LITERALLY
C              AND IMMEDIATELY.
C              THE REPLACEMENT CHARACTER CAPABILITY ALLOWS THE ANALYST
C              TO FILL IN CURRENT VALUES OF PARAMETERS
C              AS LABELS AND LEGENDS ON PLOTS,
C              IT ALSO ALLOWS FILE NAMES TO BE SYMBOLICALLY
C              BUILT INSIDE A LOOP, ETC.
C              THE SPECIFIED REPLACEMENT CHARACTOR WILL BE PLACED
C              IN THE CHARACTER VARIABLE IREPCH.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IBASLC (A CHARACTER VARIABLE--BACKSLASH)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--IREPCH (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND 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           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/7
C     ORIGINAL VERSION--JUNE     1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*1 IBASLC
      CHARACTER*1 IREPCH
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHARG4
      CHARACTER*1 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRECH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1150
      GOTO1110
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IBASLC
      GOTO1180
C
 1160 CONTINUE
      IHARG4=IHARG(NUMARG)
      IHOLD=IHARG4(1:1)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IREPCH=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IREPCH
 1181 FORMAT('THE REPLACEMENT CHARACTOR HAS JUST BEEN SET TO ',
     1A1)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPECH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IHARG4,IHOLD
 9013 FORMAT('IHARG4,IHOLD = ',A4,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IREPCH
 9014 FORMAT('IREPCH = ',A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRECI(ISEED,IBUGA2,IBUGA3,IBUGCO,IBUGEV,IBUGQ,
     1ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT MARK VANGEL'S RECIPE FIT
C              FOR LINEAR MODELS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/2
C      FIX IN HERE
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASRE
      CHARACTER*4 ICASDG
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ICASEQ
      CHARACTER*4 IKEY
CCCCC CHARACTER*4 IHPARN
CCCCC CHARACTER*4 IHPAR2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
CCCCC CHARACTER*4 ICH
CCCCC CHARACTER*4 IOP
      CHARACTER*4 IFLAG
C
CCCCC CHARACTER*4 IPARN4
      CHARACTER*4 IREPU
      CHARACTER*4 IRESU
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
CCCCC CHARACTER*4 IREP
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 IWRITE
C
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*20 IMODEL
C
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DMEAN
C
      LOGICAL SATT
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION ILIS(100)
      DIMENSION ICOLR(100)
C
      DOUBLE PRECISION XDESGN(MAXOBV/2)
      DOUBLE PRECISION XPTS(MAXOBV/2)
      DOUBLE PRECISION V2(MAXOBV/2)
      DOUBLE PRECISION TLM0(MAXOBV/2)
      DOUBLE PRECISION TLM1(MAXOBV/2)
      DOUBLE PRECISION ETA0(MAXOBV/2)
      DOUBLE PRECISION ETA1(MAXOBV/2)
      DOUBLE PRECISION XM(MAXOBV/2)
      DOUBLE PRECISION WK2(MAXOBV/2)
      DOUBLE PRECISION WK3(MAXOBV/2)
      DOUBLE PRECISION XN(MAXOBV)
      DOUBLE PRECISION T(MAXOBV/2)
      DOUBLE PRECISION CRT(MAXOBV/2)
C
      DIMENSION IP(MAXOBV)
      DIMENSION IQ(MAXOBV)
C
      DOUBLE PRECISION Y2(MAXOBV/2)
      DIMENSION PRED2(MAXOBV/2)
      DIMENSION RES2(MAXOBV/2)
C
      DOUBLE PRECISION XMAT(MAXOBV*10)
      DOUBLE PRECISION SCRTCH(MAXOBV*20)
C
      DOUBLE PRECISION XTX(100)
      DOUBLE PRECISION XTXI(100)
      DOUBLE PRECISION S1(100)
      DOUBLE PRECISION S2(100)
      DOUBLE PRECISION V1(100)
      DOUBLE PRECISION COEF(100)
C
CCCCC DIMENSION ICH(10)
      DIMENSION IVARN1(100)
      DIMENSION IVARN2(100)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      EQUIVALENCE (Y2(1),X3D(1))
      EQUIVALENCE (PRED2(1),X(1))
      EQUIVALENCE (RES2(1),D(1))
      EQUIVALENCE (CRT(1),DSIZE(1))
      EQUIVALENCE (XTX(1),DCOLOR(1))
      EQUIVALENCE (XTXI(1),DCOLOR(1001))
      EQUIVALENCE (S1(1),DCOLOR(2001))
      EQUIVALENCE (S2(1),DCOLOR(3001))
      EQUIVALENCE (V1(1),DCOLOR(4001))
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZI.INC'
      INCLUDE 'DPCOZD.INC'
      EQUIVALENCE (IGARBG(IIGAR1),IQ(1))
      EQUIVALENCE (IGARBG(IIGAR2),IP(1))
      EQUIVALENCE (G2RBAG(1),SCRTCH(1))
      EQUIVALENCE (G2RBAG(1+40*MAXOBV),XM(1))
      EQUIVALENCE (G2RBAG(1+41*MAXOBV),WK2(1))
      EQUIVALENCE (G2RBAG(1+42*MAXOBV),WK3(1))
      EQUIVALENCE (G2RBAG(1+43*MAXOBV),T(1))
      EQUIVALENCE (G2RBAG(1+44*MAXOBV),XN(1))
      EQUIVALENCE (GARBAG(1),XMAT(1))
      EQUIVALENCE (DGARBG(1),XDESGN(1))
      EQUIVALENCE (DGARBG(1+MAXOBV),XPTS(1))
      EQUIVALENCE (DGARBG(1+2*MAXOBV),V2(1))
      EQUIVALENCE (DGARBG(1+3*MAXOBV),TLM0(1))
      EQUIVALENCE (DGARBG(1+4*MAXOBV),TLM1(1))
      EQUIVALENCE (DGARBG(1+5*MAXOBV),ETA0(1))
      EQUIVALENCE (DGARBG(1+6*MAXOBV),ETA1(1))
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='DPRE'
      ISUBN2='CI  '
C
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
CCCCC IPAROC(1)='NONE'
C
      MAXPAR=20
      MAXV2=MAXPAR
      MINN2=2
C
      CPUEPS=R1MACH(3)
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
      MAXN4=MAXCHF
C
      MAXLVL=INT(SQRT(REAL(IGARB0)))
      MAXPT1=20*MAXOBV
      MAXPT2=10*MAXOBV
C
      NPAR=0
      NTOT=0
      NBCH=0
      NLEFT=0
C
C               *****************************
C               **  TREAT THE RECIPE CASE  **
C               *****************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'RECI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRECI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3
   53 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGCO,IBUGEV,IBUGQ
   54 FORMAT('IBUGCO,IBUGEV,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMNAM
   56 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO57I=1,NUMNAM
      WRITE(ICOUT,58)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
   58 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   57 CONTINUE
      WRITE(ICOUT,61)IRECSA,RECIDG,RECIPC,RECICO
   61 FORMAT('IRECSA,RECIDG,RECIPC,RECICO=',A4,1X,3(E15.7))
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  EXTRACT THE COMMAND         **
C               **    RECIPE FIT                **
C               **    RECIPE ANOVA              **
C               **    RECIPE Y <UNIVARIATE CASE **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'RECI'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'FIT')THEN
        IFOUND='YES'
        ICASRE='FREC'
        IFITFC=INT(RECIFF+0.5)
        IF(IFITFC.LT.0)IFITFC=0
        IF(IFITFC.GT.1)THEN
          ICASDG='1'
        ELSE
          IJUNK=INT(RECIDG+0.5)
          ICASDG='1'
          IF(IJUNK.EQ.0)ICASDG='0'
          IF(IJUNK.EQ.1)ICASDG='1'
          IF(IJUNK.EQ.2)ICASDG='2'
          IF(IJUNK.EQ.3)ICASDG='3'
          IF(IJUNK.EQ.4)ICASDG='4'
          IF(IJUNK.EQ.5)ICASDG='5'
          IF(IJUNK.EQ.6)ICASDG='6'
          IF(IJUNK.EQ.7)ICASDG='7'
          IF(IJUNK.EQ.8)ICASDG='8'
          IF(IJUNK.EQ.9)ICASDG='9'
          IF(IJUNK.EQ.10)ICASDG='10'
        ENDIF
      ELSEIF(ICOM.EQ.'RECI'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'ANOV')THEN
        IFOUND='YES'
        ICASRE='AREC'
      ELSEIF(ICOM.EQ.'RECI'.AND.NUMARG.GE.1)THEN
        IFOUND='YES'
        ICASRE='UREC'
      ENDIF
      IF(IBUGA2.EQ.'ON')THEN
        WRITE(ICOUT,66)ICASRE
   66   FORMAT('ICASRE=',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF 
      IF(ICASRE.EQ.'    ')GOTO9000
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=0
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ******************************************************
C               **  STEP 3--                                        **
C               **  IN PARTICULAR, CHECK THAT THE NUMBER OF ARGUMENTS*
C               **  IS AT LEAST 1,                                  **
C               *******************************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1)GOTO2090
      WRITE(ICOUT,2001)
 2001 FORMAT('***** ERROR IN DRECI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2002)
 2002 FORMAT('      NUMBER OF ARGUMENTS DETECTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2003)NUMARG
 2003 FORMAT('      IN RECIPE COMMAND = 0.  NUMARG = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2007)IWIDTH
 2007 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2008)(IANS(J),J=1,MIN(IWIDTH,100))
 2008 FORMAT('      COMMAND LINE--',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2090 CONTINUE
C
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO2110
 2100 CONTINUE
      ILOCQ=NUMARG+1
      GOTO2120
 2110 CONTINUE
      ILOCQ=J1
      GOTO2120
 2120 CONTINUE
C
 2290 CONTINUE
C
C               *******************************************************
C               **  STEP 4--                                         **
C               **  FOR RECIPE FIT AND RECIPE ANOVA,                 **
C               **  THE SECOND WORD AFTER  RECIPE SHOULD BE THE      **
C               **  RESPONSE VARIABLE (= THE DEPENDENT VARIABLE).    **
C               **  FOR RECIPE <Y>, RESPONSE VARIABLE IS FIRST WORD. **
C               **  EXTRACT THE RESPONSE VARIABLE AND DETERMINE      **
C               **  IF IT IS ALREADY IN THE NAME LIST AND IS, IN FACT,*
C               **  A VARIABLE (AS OPPOSED TO A PARAMETER).          **
C               *******************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCY=2
      IF(ICASRE.EQ.'UREC')ILOCY=1
      IHLEFT=IHARG(ILOCY)
      IHLEF2=IHARG2(ILOCY)
      DO2350I=1,NUMNAM
      I2=I
      IF(IHLEFT.EQ.IHNAME(I2).AND.IHLEF2.EQ.IHNAM2(I2).AND.
     1IUSE(I2).EQ.'V')GOTO2379
 2350 CONTINUE
      WRITE(ICOUT,2361)
 2361 FORMAT('***** ERROR IN DPRECI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2362)
 2362 FORMAT('      THE NAME FOLLOWING THE WORD RECIPE FIT ',
     1'(OR RECIPE ANOVA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2363)
 2363 FORMAT('      (WHICH SHOULD BE THE RESPONSE VARIABLE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2364)
 2364 FORMAT('      EITHER DOES NOT EXIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2365)
 2365 FORMAT('      OR IS A PARAMETER (AS OPPOSED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2366)
 2366 FORMAT('      TO A VARIABLE) IN THE CURRENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2367)
 2367 FORMAT('      LIST OF AVAILABLE VARIABLE AND PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2368)
 2368 FORMAT('      NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2369)IHLEFT,IHLEF2
 2369 FORMAT('      NAME AFTER THE WORD RECIPE FIT/ANOVA = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2378)(IANS(J),J=1,MIN(IWIDTH,100))
 2378 FORMAT('      COMMAND LINE--',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2379 CONTINUE
      ILOCV=I2
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
 2390 CONTINUE
C
C               *******************************************************
C               **  STEP 5--                                         **
C               **  FOR ALL VARIATIONS OF THE RECIPE COMMAND,        **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.        **
C               *******************************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPRECI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A RECIPE ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN PERFORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)NLEFT
  317 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS 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)WRITE(ICOUT,319)(IANS(I),I=1,IWIDTH)
  319 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  390 CONTINUE
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  EXTRACT THE INDEPENDENT VARIABLES           **
C               **  FOR RECIPE FIT:                             **
C               **      Y X <BATCH> <XPRED>                     **
C               **  FOR RECIPE ANOVA:                           **
C               **      Y X1 ... XK <BATCH>                     **
C               **  FOR RECIPE :                                **
C               **      Y <BATCH>                               **
C               **  IF THE   TO   FEATURE IS USED IN THE        **
C               **  ARGUMENT LIST, TRANSLATE THE   TO   TO      **
C               **  EXPLICIT VARIABLE NAMES             INTO    **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASRE.EQ.'FREC'.AND.IFITFC.LE.1)THEN
        MAXREC=3
        JMIN=ILOCY+1
        JMAX=ILOCQ-1
        CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXREC,
     1  IHNAME,IHNAM2,IUSE,NUMNAM,
     1  IVARN1,IVARN2,NUMVAR,IBUGA2,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IF(NUMVAR.EQ.1)THEN
          ILOCX=ILOCY+1
          ILOCB=-1
          ILOCXP=-1
        ELSEIF(NUMVAR.EQ.2)THEN
          ILOCX=ILOCY+1
          ILOCB=ILOCX+1
          ILOCXP=-1
        ELSEIF(NUMVAR.EQ.3)THEN
          ILOCX=ILOCY+1
          ILOCB=ILOCX+1
          ILOCXP=ILOCB+1
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,411)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,412)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,413)NUMVAR
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
  411 FORMAT('***** ERROR IN DPRECI (RECIPE FIT)--')
  412 FORMAT('      BETWEEN 1 AND 4 VARIABLE NAMES CAN BE SPECIFIED '
     1      ,'FOR THIS COMMAND')
  413 FORMAT('      ',I8,' VARIABLES WERE GIVEN.')
      ELSEIF(ICASRE.EQ.'FREC'.AND.IFITFC.GT.1)THEN
        MAXREC=2*IFITFC+1
        JMIN=ILOCY+1
        JMAX=ILOCQ-1
        CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXREC,
     1  IHNAME,IHNAM2,IUSE,NUMNAM,
     1  IVARN1,IVARN2,NUMVAR,IBUGA2,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IF(NUMVAR.LT.IFITFC)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1411)NUMVAR,IFITFC
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1422)NUMVAR,IFITFC
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(NUMVAR.EQ.IFITFC)THEN
          ILOCX=ILOCY+1
          ILOCB=-1
          ILOCXP=-1
        ELSEIF(NUMVAR.EQ.IFITFC+1)THEN
          ILOCX=ILOCY+1
          ILOCB=ILOCX+IFITFC
          ILOCXP=-1
        ELSEIF(NUMVAR.EQ.2*IFITFC)THEN
          ILOCX=ILOCY+1
          ILOCB=-1
          ILOCXP=ILOCX+1
        ELSEIF(NUMVAR.EQ.2*IFITFC+1)THEN
          ILOCX=ILOCY+1
          ILOCB=ILOCX+IFITFC
          ILOCXP=ILOCB+1
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1411)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1412)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 1411 FORMAT('***** ERROR IN DPRECI (RECIPE FIT)--')
 1422 FORMAT('      THE NUMBER OF VARIABLES ENTERED ',I5,' IS LESS ',
     1       'THAN THE NUMBER OF FIT FACTORS ',I5)
 1412 FORMAT('      AN IMPROPER NUMBER OF VARIABLE NAMES HAS BEEN ',
     1       'SPECIFIED FOR THIS COMMAND.')
      ELSEIF(ICASRE.EQ.'UREC')THEN
        MAXREC=1
        JMIN=ILOCY+1
        JMAX=ILOCQ-1
        CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXREC,
     1  IHNAME,IHNAM2,IUSE,NUMNAM,
     1  IVARN1,IVARN2,NUMVAR,IBUGA2,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ILOCX=-1
        ILOCXP=-1
        IF(NUMVAR.EQ.1)THEN
          ILOCB=ILOCX+1
        ELSEIF(NUMVAR.EQ.0)THEN
          ILOCB=-1
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,421)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,422)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,423)NUMVAR
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
  421 FORMAT('***** ERROR IN DPRECI (RECIPE)--')
  422 FORMAT('      BETWEEN 0 AND 1 VARIABLE NAMES CAN BE SPECIFIED '
     1      ,'FOR THIS COMMAND')
  423 FORMAT('      ',I8,' VARIABLES WERE GIVEN.')
      ELSEIF(ICASRE.EQ.'AREC')THEN
        NUMFAC=INT(RECIFA+0.5)
CCCCC   IF(NUMFAC.GT.MAXPAR)THEN
CCCCC     WRITE(ICOUT,999)
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     WRITE(ICOUT,511)
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     WRITE(ICOUT,512)NUMFAC,MAXPAR
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     IERROR='YES'
CCCCC     GOTO9000
CCCCC   ENDIF
  511   FORMAT('***** ERROR IN DPRECI (RECIPE ANOVA)--')
  512   FORMAT('      THE REQUESTED NUMBER OF FACTORS ',I8,
     1        ' IS GREATER THAN THE ALLOWED MAXIMUM OF ',I8)
        MAXREC=NUMFAC+1
        JMIN=ILOCY+1
        JMAX=ILOCQ-1
        CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXREC,
     1  IHNAME,IHNAM2,IUSE,NUMNAM,
     1  IVARN1,IVARN2,NUMVAR,IBUGA2,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IF(NUMVAR.EQ.NUMFAC)THEN
          ILOCX=ILOCY+1
          ILOCB=-1
          ILOCXP=-1
        ELSEIF(NUMVAR.EQ.NUMFAC+1)THEN
          ILOCX=ILOCY+1
          ILOCB=ILOCX+NUMFAC
          ILOCXP=-1
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,611)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,612)NUMFAC,NUMVAR
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
  611 FORMAT('***** ERROR IN DPRECI (RECIPE ANOVA)--')
  612 FORMAT('      ',I8,' FACTORS WERE SPECIFIED, BUT ONLY ',I8,
     1       ' VARIABLES WERE GIVEN ON THE COMMAND LINE.')
      ENDIF
C
      IF(IBUGA2.EQ.'ON')THEN
        WRITE(ICOUT,71)NUMVAR,NUMFAC
        CALL DPWRST('XXX','BUG')
      ENDIF
   71 FORMAT('NUMVAR,NUMFAC=',2I8)
 1290 CONTINUE
C
C               ***************************************
C               **  STEP 13--                        **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               **  THE DESIGN MATRIX (X) AND BATCH  **
C               **  IDENTIFIER VARIABLE MUST HAVE THE**
C               **  SAME NUMER OF OBSERVATIONS AS THE**
C               **  Y VARIABLE.  THE XPRED VARIABLE  **
C               **  MUST HAVE AT LEAST 2 OBSERVATIONS**
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASRE.EQ.'UREC'.AND.NUMVAR.EQ.0)GOTO1399
      NPRED=-1
      IFITVA=IFITFC
      IF(ILOCB.GT.0)IFITVA=IFITVA+1
      DO1300I=1,NUMVAR
C
      IHRIGH=IVARN1(I)
      IHRIG2=IVARN2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      NRIGHT=IN(ILOCV)
      ILIS(I)=ILOCV
      ICOLR(I)=IVALUE(ILOCV)
C
      IF(ICASRE.EQ.'AREC'.OR.(ICASRE.EQ.'FREC'.AND.IFITFC.LE.1).OR.
     1   ILOCXP.LT.0)THEN
        IF(ILOCXP.GT.0 .AND. I.EQ.NUMVAR)NPRED=NRIGHT
        IF(NRIGHT.EQ.NLEFT)GOTO1390
        IF(ILOCXP.GT.0 .AND. I.EQ.NUMVAR .AND. NRIGHT.GT.2)GOTO1390
        GOTO1309
      ENDIF
C
      IF(I.GT.IFITVA)THEN
        IF(NPRED.LT.0)THEN
          NPRED=NRIGHT
          GOTO1390
        ELSE
          NPREDN=NRIGHT
          IF(NPREDN.NE.NPRED.OR.NPRED.LT.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11311)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11313)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11315)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
11311 FORMAT('***** ERROR IN DPRECI--')
11313 FORMAT('      THE VARIABLES FOR THE PREDICTED VARIABLES DO ',
     1       'NOT ALL CONTAIN THE SAME')
11315 FORMAT('      NUMBER OF ELEMENTS FOR THE MULTI-LINEAR FIT ',
     1       'CASE.')
          ELSE
            GOTO1390
          ENDIF
        ENDIF
      ELSE
        IF(NRIGHT.EQ.NLEFT)GOTO1390
      ENDIF
C
 1309 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPRECI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('      FOR THE INDEPENDENT VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1322)
 1322 FORMAT('      MUST BE THE SAME AS THE DEPENDENT VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1323)
 1323 FORMAT('      IN ADDITION, THE VARIABLE CONTAINING THE X ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1324)
 1324 FORMAT('      VALUES FOR THE TOLERANCE LIMITS MUST HAVE AT ',
     1'LEAST 2 ELEMENTS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1327)
 1327 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1328)
 1328 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1329)(IANS(J),J=1,MIN(80,IWIDTH))
 1329 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1390 CONTINUE
C
 1300 CONTINUE
 1399 CONTINUE
C
C               **********************************************
C               **  STEP 6.3--                              **
C               **  FOR ALL VARIATIONS OF THE RECIPE COMMAND,*
C               **  CHECK TO SEE THE TYPE CASE--            **
C               **    1) UNQUALIFIED (THAT IS, FULL);       **
C               **    2) SUBSET/EXCEPT; OR                  **
C               **    3) FOR.                               **
C               **********************************************
C
      ISTEPN='6.3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     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'
      IKEY='SUBS'
      IF(IHARG(J1).EQ.'EXCE')IKEY='EXCE'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'RECI')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *******************************************************
C               **  STEP 11--                                        **
C               **  DUMP THE COMMON VECTOR V(.) OUT ONTO MASS STORAGE**
C               **  SO AS TO PRESERVE THEIR CONTENTS FOR LATER USE   **
C               **  (AFTER DPRECI2).                                 **
C               **  NOTE:  DON'T DO FOR NOW                          **
C               *******************************************************
C
CCCCC ISTEPN='11'
CCCCC IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IOP='WRIT'
CCCCC CALL DPSWAP(IOP,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
CCCCC1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGA3,ISUBRO,IERROR)
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; THEN          **
C               **  COPY OVER THE RESPONSE VECTOR TO BE USED IN THE  **
C               **  MODEL INTO THE VECTOR Y2; AND                    **
C               **  COPY OVER THE VECTORS THAT WERE USED IN THE MODEL**
C               **  INTO THE FULL DESIGN MATRIX                      **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')WRITE(ICOUT,601)NLEFT,NUMVAR
  601 FORMAT('NLEFT,NUMVAR = ',2I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')CALL DPWRST('XXX','BUG ')
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 DPSUB2(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
      NTOT=NQ
      K=ICOLL
      J=0
      DO4500I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO4500
      J=J+1
      IJ=MAXN*(K-1)+I
      IF(K.LE.MAXCOL)Y2(J)=DBLE(V(IJ))
      IF(K.EQ.MAXCP1)Y2(J)=DBLE(PRED(I))
      IF(K.EQ.MAXCP2)Y2(J)=DBLE(RES(I))
      IF(K.EQ.MAXCP3)Y2(J)=DBLE(YPLOT(I))
      IF(K.EQ.MAXCP4)Y2(J)=DBLE(XPLOT(I))
      IF(K.EQ.MAXCP5)Y2(J)=DBLE(X2PLOT(I))
      IF(K.EQ.MAXCP6)Y2(J)=DBLE(TAGPLO(I))
 4500 CONTINUE
      IF(IBUGA2.EQ.'ON')THEN
        DO4503I=1,NTOT
        WRITE(ICOUT,4504)I,Y2(I)
 4504   FORMAT('I,Y2(I)=',I8,2X,D15.7)
        CALL DPWRST('XXX','BUG')
 4503   CONTINUE
      ENDIF
C
C     ********************************************************
C     ** DEFINE A VECTOR OF ALL 1'S (FOR THE CONSTANT TERM) **
C     ** IN THE DESIGN MATRIX.                              **
C     ********************************************************
C
      J=0
      DO380I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO380
      J=J+1
      XMAT(J)=1.0D0
  380 CONTINUE
C
C     ********************************************************
C     ** DETERMINE IF THERE IS A BATCH VARIABLE.  IF NOT,   **
C     ** CREATE ONE EQUAL TO ALL 1'S.  IF YES, DETERMINE    **
C     ** HOW MANY UNIQUE VALUES.                            **
C     ********************************************************
C
      IF(ILOCB.LE.0)THEN
        J=0
        DO4610I=1,NLEFT
          IF(ISUB(I).EQ.0)GOTO4610
          J=J+1
          IQ(J)=1
 4610   CONTINUE
        NBCH=1
        GOTO4699
      ENDIF
C
      IF(ICASRE.EQ.'FREC'.AND.IFITFC.LE.1)THEN
        K=ICOLR(NUMVAR)
        IF(ILOCXP.GT.0)K=ICOLR(NUMVAR-1)
      ELSEIF(ICASRE.EQ.'FREC'.AND.IFITFC.GT.1)THEN
        K=ICOLR(ILOCB)
      ELSE
        K=ICOLR(NUMVAR)
      ENDIF
C
      J=0
      DO4600I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO4600
      J=J+1
      IJ=MAXN*(K-1)+I
      IF(K.LE.MAXCOL)RES2(J)=V(IJ)
      IF(K.EQ.MAXCP1)RES2(J)=PRED(I)
      IF(K.EQ.MAXCP2)RES2(J)=RES(I)
      IF(K.EQ.MAXCP3)RES2(J)=YPLOT(I)
      IF(K.EQ.MAXCP4)RES2(J)=XPLOT(I)
      IF(K.EQ.MAXCP5)RES2(J)=X2PLOT(I)
      IF(K.EQ.MAXCP6)RES2(J)=TAGPLO(I)
 4600 CONTINUE
C
      CALL SORT(RES2,NQ,PRED2)
      IWRITE='NO'
      CALL DISTIN(PRED2,NQ,IWRITE,PRED2,NBCH,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      DO4650I=1,NQ
        IQ(I)=0
        DO4660J=1,NBCH
          IF(RES2(I).EQ.PRED2(J))THEN
            IQ(I)=J
            GOTO4650
          ENDIF
 4660   CONTINUE
 4650 CONTINUE
C
 4699 CONTINUE
C
      IF(IBUGA2.EQ.'ON')THEN
        DO4603I=1,NTOT
        WRITE(ICOUT,4604)I,IQ(I)
 4604   FORMAT('I,IQ(I)=',I8,2X,I8)
        CALL DPWRST('XXX','BUG')
 4603   CONTINUE
      ENDIF
C
C     ********************************************************
C     ** DETERMINE IF THERE IS A PREDICTED VARIABLE (FIT    **
C     ** CASE ONLY).  IF SO, EXTRACT AND PUT IN XPTS.       **
C     ********************************************************
C
      IF(ICASRE.EQ.'UREC')THEN
        XPTS(1)=1.D0
        NPRED=1
        NPAR=1
        GOTO4799
      ELSEIF(ILOCXP.LT.0.OR.ICASRE.EQ.'AREC')THEN
        DO4701I=1,MAXOBV/2
          XPTS(I)=0.D0
 4701   CONTINUE
        NPRED=0
        GOTO4799
      ENDIF
C
      IF(ICASRE.EQ.'FREC'.AND.IFITFC.LE.1)THEN
        K=ICOLR(NUMVAR)
        DO4703I=1,NPRED
          XPTS(I)=1.D0
 4703   CONTINUE
        J=NPRED
        DO4700I=1,NPRED
        IF(ISUB(I).EQ.0)GOTO4700
        J=J+1
        IJ=MAXN*(K-1)+I
        IF(K.LE.MAXCOL)XPTS(J)=DBLE(V(IJ))
        IF(K.EQ.MAXCP1)XPTS(J)=DBLE(PRED(I))
        IF(K.EQ.MAXCP2)XPTS(J)=DBLE(RES(I))
        IF(K.EQ.MAXCP3)XPTS(J)=DBLE(YPLOT(I))
        IF(K.EQ.MAXCP4)XPTS(J)=DBLE(XPLOT(I))
        IF(K.EQ.MAXCP5)XPTS(J)=DBLE(X2PLOT(I))
        IF(K.EQ.MAXCP6)XPTS(J)=DBLE(TAGPLO(I))
 4700   CONTINUE
C
      ELSEIF(ICASRE.EQ.'FREC'.AND.IFITFC.GT.1)THEN
        DO5903I=1,NPRED
          XPTS(I)=1.D0
 5903   CONTINUE
        NLOOP=IFITFC
        ISTRT=IFITFC+1
        IF(ILOCB.GT.0)ISTRT=ISTRT+1
        ISTOP=ISTRT+IFITFC-1 
        DO5376IVAR=ISTRT,ISTOP
          K=ICOLR(IVAR)
          J=(IVAR-ISTRT+1)*NPRED
          DO5371I=1,NPRED
            IF(ISUB(I).EQ.0)GOTO5371
            J=J+1
            IJ=MAXN*(K-1)+I
            IF(K.LE.MAXCOL)XPTS(J)=DBLE(V(IJ))
            IF(K.EQ.MAXCP1)XPTS(J)=DBLE(PRED(I))
            IF(K.EQ.MAXCP2)XPTS(J)=DBLE(RES(I))
            IF(K.EQ.MAXCP3)XPTS(J)=DBLE(YPLOT(I))
            IF(K.EQ.MAXCP4)XPTS(J)=DBLE(XPLOT(I))
            IF(K.EQ.MAXCP5)XPTS(J)=DBLE(X2PLOT(I))
            IF(K.EQ.MAXCP6)XPTS(J)=DBLE(TAGPLO(I))
 5371     CONTINUE
 5376   CONTINUE
      ENDIF
C
 4799 CONTINUE
C
      IF(IBUGA2.EQ.'ON')THEN
        DO4713I=1,2*NPRED
        WRITE(ICOUT,4714)I,XPTS(I)
 4714   FORMAT('I,XPTS(I)=',I8,2X,D15.7)
        CALL DPWRST('XXX','BUG')
 4713   CONTINUE
      ENDIF
C
C     ********************************************************
C     ** COPY OVER THE FULL DESIGN MATRIX.                  **
C     ********************************************************
C
      IF(ICASRE.EQ.'FREC'.AND.IFITFC.LE.1)THEN
        NPAR=1
        IF(ICASDG.EQ.'0')GOTO379
        IF(ICASDG.EQ.'1')NLOOP=1
        IF(ICASDG.EQ.'2')NLOOP=2
        IF(ICASDG.EQ.'3')NLOOP=3
        IF(ICASDG.EQ.'4')NLOOP=4
        IF(ICASDG.EQ.'5')NLOOP=5
        IF(ICASDG.EQ.'6')NLOOP=6
        IF(ICASDG.EQ.'7')NLOOP=7
        IF(ICASDG.EQ.'8')NLOOP=8
        IF(ICASDG.EQ.'9')NLOOP=9
        IF(ICASDG.EQ.'10')NLOOP=10
        K=ICOLR(1)
        DO376IVAR=1,NLOOP
          J=IVAR*NTOT
          DO371I=1,NLEFT
            IF(ISUB(I).EQ.0)GOTO371
            J=J+1
            IJ=MAXN*(K-1)+I
            IF(K.LE.MAXCOL)XMAT(J)=DBLE(V(IJ)**NLOOP)
            IF(K.EQ.MAXCP1)XMAT(J)=DBLE(PRED(I)**NLOOP)
            IF(K.EQ.MAXCP2)XMAT(J)=DBLE(RES(I)**NLOOP)
            IF(K.EQ.MAXCP3)XMAT(J)=DBLE(YPLOT(I)**NLOOP)
            IF(K.EQ.MAXCP4)XMAT(J)=DBLE(XPLOT(I)**NLOOP)
            IF(K.EQ.MAXCP5)XMAT(J)=DBLE(X2PLOT(I)**NLOOP)
            IF(K.EQ.MAXCP6)XMAT(J)=DBLE(TAGPLO(I)**NLOOP)
  371     CONTINUE
  376   CONTINUE
        NPAR=NLOOP+1
  379   CONTINUE
C
      ELSEIF(ICASRE.EQ.'FREC'.AND.IFITFC.GT.1)THEN
        NPAR=1
        NLOOP=IFITFC
        DO1376IVAR=1,NLOOP
          K=ICOLR(IVAR)
          J=IVAR*NTOT
          DO1371I=1,NLEFT
            IF(ISUB(I).EQ.0)GOTO1371
            J=J+1
            IJ=MAXN*(K-1)+I
            IF(K.LE.MAXCOL)XMAT(J)=DBLE(V(IJ))
            IF(K.EQ.MAXCP1)XMAT(J)=DBLE(PRED(I))
            IF(K.EQ.MAXCP2)XMAT(J)=DBLE(RES(I))
            IF(K.EQ.MAXCP3)XMAT(J)=DBLE(YPLOT(I))
            IF(K.EQ.MAXCP4)XMAT(J)=DBLE(XPLOT(I))
            IF(K.EQ.MAXCP5)XMAT(J)=DBLE(X2PLOT(I))
            IF(K.EQ.MAXCP6)XMAT(J)=DBLE(TAGPLO(I))
 1371     CONTINUE
 1376   CONTINUE
        NPAR=NLOOP+1
      ELSEIF(ICASRE.EQ.'UREC')THEN
        NPAR=1
        J=NTOT
CCCCC   DO372I=1,NLEFT
CCCCC     IF(ISUB(I).EQ.0)GOTO372
CCCCC     J=J+1
CCCCC     XMAT(J)=1.D0
C372    CONTINUE
      ELSEIF(ICASRE.EQ.'AREC')THEN
        NLOOP=NUMVAR
        IF(ILOCB.GT.0)NLOOP=NUMVAR-1
        DO389IVAR=1,NLOOP
          K=ICOLR(IVAR)
          J=IVAR*NTOT
          DO381I=1,NLEFT
            IF(ISUB(I).EQ.0)GOTO381
            J=J+1
            IJ=MAXN*(K-1)+I
            IF(K.LE.MAXCOL)XMAT(J)=DBLE(V(IJ))
            IF(K.EQ.MAXCP1)XMAT(J)=DBLE(PRED(I))
            IF(K.EQ.MAXCP2)XMAT(J)=DBLE(RES(I))
            IF(K.EQ.MAXCP3)XMAT(J)=DBLE(YPLOT(I))
            IF(K.EQ.MAXCP4)XMAT(J)=DBLE(XPLOT(I))
            IF(K.EQ.MAXCP5)XMAT(J)=DBLE(X2PLOT(I))
            IF(K.EQ.MAXCP6)XMAT(J)=DBLE(TAGPLO(I))
  381     CONTINUE
  389   CONTINUE
        NPAR=NLOOP+1
      ENDIF
C
      IF(IBUGA2.EQ.'ON')THEN
        DO4803I=1,NTOT*NPAR
        WRITE(ICOUT,4804)I,XMAT(I)
 4804   FORMAT('I,XMAT(I)=',I8,2X,D15.7)
        CALL DPWRST('XXX','BUG')
 4803   CONTINUE
      ENDIF
C
C               ******************************************************
C               **  STEP 14--                                       **
C               **  CARRY OUT THE ACTUAL FIT                        **
C               **  VIA CALLING                                     **
C               **  REGINI AND REGDAT                               **
C               ******************************************************
C
      NSTOR=NTOT*(NPAR+NBCH)
      IF(NSTOR.GT.MAXPT1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6071)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6072)NSTOR
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6073)MAXPT1
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000 
      ENDIF
 6071 FORMAT('***** ERROR FROM DPRECI--THE AMOUNT OF SCRATCH STORAGE ',
     1'REQUIRED')
 6072 FORMAT('     NUMBER OF POINTS*(NUMBER OF PARAMETERS + NUMBER OF',
     1' BATCHES) = ',I8)
 6073 FORMAT('     EXCEEDS THE MAXIMIM ALLOWABLE OF ',I8)
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'RECI')GOTO6099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6081)
 6081 FORMAT('***** FROM DPRECI, AS ABOUT TO CALL REGINI--')
      CALL DPWRST('XXX','BUG ')
 6099 CONTINUE
C
 6530 CONTINUE
      SATT=.FALSE.
      IF(IRECSA.EQ.'YES'.OR.IRECSA.EQ.'TRUE'.OR.IRECSA.EQ.'ON')
     1SATT=.TRUE.
      NREPS=IRECR2
      MAXREP=10*MAXOBV
      IF(NREPS.GT.MAXREP)THEN
        NREPS=MAXREP
        WRITE(ICOUT,998)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6531)NREPS,MAXREP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6532)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,998)
        CALL DPWRST('XXX','WRIT')
      ENDIF
 6531 FORMAT('THE REQUESTED NUMBER OF SIMULATION REPLICATIONS ',I8,
     1' IS GREATER THAN THE ALLOWED MAXIMUM OF ',I8)
 6532 FORMAT('THE MAXIMUM ALLOWED NUMBER OF REPLICATIONS WILL BE ',
     1'USED.')
      CALL REGINI(NLVL,NPAR,NTOT,NBCH,NPRED,XDESGN,XPTS,IP,IQ,
     1            DBLE(RECIPC),DBLE(RECICO),XMAT,XTX,XTXI,XN,SCRTCH,
     1            S1,V1,S2,V2,TLM0,TLM1,ETA0,ETA1,
     1            SATT,IN2,WK2,WK3,
     1            CRT,ISEED,MAXREP,MAXLVL,
     1            ICASRE,ISUBRO,IBUGA2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'RECI')GOTO6199
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6181)
 6181 FORMAT('***** FROM DPRECI, AS ABOUT TO CALL REGDAT--')
      CALL DPWRST('XXX','BUG ')
 6199 CONTINUE
C
      IFLAG='RECI'
      CALL REGDAT(NPAR,NTOT,NBCH,NPRED,XPTS,Y2,COEF,
     1            SCRTCH,S1,V1,TLM0,TLM1,ETA0,ETA1,
     1            XMAT,XM,T,XDESGN,NLVL,
     1            ICASRE,IFLAG,ISUBRO,IBUGA2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      DSUM1=0.D0
      IF(ICASRE.EQ.'AREC'.OR.(ICASRE.EQ.'FREC'.AND.ILOCXP.LE.0))THEN
        DO1029I=1,NLVL
          TLM0(I)=T(I)
 1029   CONTINUE
      ENDIF
      DO1030I=1,NTOT
        INDX=IP(I)
        PRED2(I)=SNGL(XM(INDX))
        RES2(I)=SNGL(Y2(I))-PRED2(I)
        IF(ICASRE.EQ.'AREC'.OR.(ICASRE.EQ.'FREC'.AND.ILOCXP.LE.0))THEN
          T(I)=TLM0(INDX)
        ENDIF
        IF(IBUGA2.EQ.'ON')THEN
          WRITE(ICOUT,11030)I,INDX,PRED2(I),RES2(I)
          CALL DPWRST('XXX','BUG')
        ENDIF
11030   FORMAT('I,INDX,PRED2(I),RES2(I)=',2I8,2E15.7)
        DSUM1=DSUM1+DBLE(RES2(I))
 1030 CONTINUE
      DMEAN=DSUM1/DBLE(NTOT)
      DSUM1=0.D0
      DO1031I=1,NTOT
        DSUM1=DSUM1+(DBLE(RES2(I))-DMEAN)**2
 1031 CONTINUE
      RESDF=REAL(NTOT-NPAR)
      IF(ICASRE.EQ.'AREC')RESDF=REAL(NTOT-(NLVL-NUMFAC)-1)
      IF(ICASRE.EQ.'UREC')RESDF=REAL(NTOT-1)
      RESSD=SNGL(DSQRT(DSUM1)/DBLE(RESDF))
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1032)
 1032 FORMAT(20X,'RECIPE ANALYSIS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)
 1132 FORMAT(18X,'(MARK VANGEL, NIST)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,998)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1033)NTOT
 1033 FORMAT('NUMBER OF OBSERVATIONS         = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1034)NLVL
 1034 FORMAT('NUMBER OF UNIQUE DESIGN POINTS = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1035)NBCH
 1035 FORMAT('NUMBER OF BATCHES              = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,998)
      CALL DPWRST('XXX','WRIT')
      IF(ICASRE.EQ.'FREC'.AND.IFITFC.LE.1)THEN
        IMODEL='LINEAR FIT'
        IF(ICASDG.EQ.'0')IMODEL='0-DEGREE FIT'
        IF(ICASDG.EQ.'2')IMODEL='QUADRATIC FIT'
        IF(ICASDG.EQ.'3')IMODEL='CUBIC FIT'
        IF(ICASDG.EQ.'4')IMODEL='4TH-DEGREE FIT'
        IF(ICASDG.EQ.'5')IMODEL='5TH-DEGREE FIT'
        IF(ICASDG.EQ.'6')IMODEL='6TH-DEGREE FIT'
        IF(ICASDG.EQ.'7')IMODEL='7TH-DEGREE FIT'
        IF(ICASDG.EQ.'8')IMODEL='8TH-DEGREE FIT'
        IF(ICASDG.EQ.'9')IMODEL='9TH-DEGREE FIT'
        IF(ICASDG.EQ.'10')IMODEL='10TH-DEGREE FIT'
      ELSEIF(ICASRE.EQ.'FREC'.AND.IFITFC.GT.1)THEN
        IMODEL='MULTI-LINEAR FIT'
      ELSEIF(ICASRE.EQ.'UREC')THEN
        IMODEL='UNIVARIATE'
      ELSE
        IF(NUMFAC.EQ.0)THEN
          IMODEL='UNIVARIATE'
        ELSE
          IMODEL='ANOVA'
        ENDIF
      ENDIF
      WRITE(ICOUT,1036)IMODEL
 1036 FORMAT('MODEL: ',A20)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1037)RESSD
 1037 FORMAT('RESSD FROM THE FITTED MODEL    = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1237)RESDF
 1237 FORMAT('RESDF FROM THE FITTED MODEL    = ',F10.0)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,998)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,1136)100*RECIPC
 1136 FORMAT('PROBABILITY CONTENT            = ',F10.5,'%')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1137)100*RECICO
 1137 FORMAT('PROBABILITY CONFIDENCE         = ',F10.5,'%')
      CALL DPWRST('XXX','WRIT')
      IF(IRECSA.EQ.'YES'.OR.IRECSA.EQ.'ON'.OR.IRECSA.EQ.'TRUE')THEN
        WRITE(ICOUT,1138)
 1138   FORMAT('SATTERTHWAITE APPROXIMATION USED')
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,1139)MAXREP
 1139   FORMAT('SIMULATED CRITICAL VALUES (SIMPVT) USED WITH ',
     1         I8,' REPLICATIONS')
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,998)
  998 FORMAT(' ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,998)
      CALL DPWRST('XXX','WRIT')
C
CCCCC APRIL 1998.  SUPPRESS PRINTING OF THESE COLUMNS, CAN SOMETIMES
CCCCC BE TOO LONG.  INSTEAD, PRINT OUT NAME OF VARIABLES.
C1038 FORMAT(3X,'Y          ',4X,'PREDICTED ',6X,'RESIDUAL  ',6X,
CCCCC1'TOLERANCE')
C1238 FORMAT(3X,'Y ',14X,'X1         ',4X,'PREDICTED ',6X,'RESIDUAL  ',
CCCCC16X,'TOLERANCE')
C1041 FORMAT(4(E15.7,1X)) 
C1141 FORMAT(5(E15.7,1X)) 
CCCCC IF(ICASRE.EQ.'AREC')THEN
CCCCC   IF(NUMFAC.NE.1)THEN
CCCCC     WRITE(ICOUT,1038)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     DO1042I=1,NTOT
CCCCC     WRITE(ICOUT,1041) SNGL(Y2(I)),PRED2(I),RES2(I),T(I)
CCCCC     CALL DPWRST('XXX','WRIT')
C1042     CONTINUE
CCCCC   ELSE
CCCCC     WRITE(ICOUT,1238)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     DO1142I=1,NTOT
CCCCC     WRITE(ICOUT,1141)SNGL(Y2(I)),XMAT(NTOT+I),PRED2(I),
CCCCC1                      RES2(I),T(I)
CCCCC     CALL DPWRST('XXX','WRIT')
C1142   CONTINUE
CCCCC   ENDIF
CCCCC ELSEIF(ICASRE.EQ.'FREC')THEN
C1039 FORMAT(3X,'Y          ',4X,'X1        ',6X,'PREDICTED',6X,
CCCCC1'X2',14X,'TOLERANCE')
C1051 FORMAT(5E15.7) 
C1052 FORMAT(3E15.7) 
C1053 FORMAT(48X,2E15.7) 
CCCCC   WRITE(ICOUT,1039)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   ITEMP1=MIN(NPRED,NTOT)
CCCCC   ITEMP3=MAX(NPRED,NTOT)
CCCCC   DO1044I=1,ITEMP1
CCCCC     WRITE(ICOUT,1051) SNGL(Y2(I)),XMAT(NTOT+I),PRED2(I),
CCCCC1                      XPTS(NPRED+I),T(I)
CCCCC     CALL DPWRST('XXX','WRIT')
C1044   CONTINUE
CCCCC   IF(ITEMP1.NE.ITEMP3)THEN
CCCCC     IF(NTOT.GT.NPRED)THEN
CCCCC       DO1045I=ITEMP1+1,ITEMP3
CCCCC         WRITE(ICOUT,1052) XMAT(NTOT+I),SNGL(Y2(I)),PRED2(I)
CCCCC         CALL DPWRST('XXX','WRIT')
C1045       CONTINUE
CCCCC     ELSE
CCCCC       DO1046I=ITEMP1+1,ITEMP3
CCCCC         WRITE(ICOUT,1053)XPTS(NPRED+I),T(I)
CCCCC         CALL DPWRST('XXX','WRIT')
C1046       CONTINUE
CCCCC     ENDIF
CCCCC   ENDIF
CCCCC ELSEIF(ICASRE.EQ.'UREC')THEN
C1439 FORMAT(3X,'Y          ',4X,'PREDICTED',6X,'RESIDUAL',8X,
CCCCC1       'TOLERANCE')
CCCCC   WRITE(ICOUT,1439)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   DO1444I=1,NTOT
CCCCC     WRITE(ICOUT,1451) SNGL(Y2(I)),RES2(I),PRED2(1),T(1)
CCCCC     CALL DPWRST('XXX','WRIT')
C1444   CONTINUE
CCCCC ENDIF
C1451 FORMAT(4(E15.7,1X))
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1701)IRECTN(1:8)
 1701 FORMAT('TOLERANCE VALUES STORED IN VARIABLE ',A8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1702)
 1702 FORMAT('RESIDUALS        STORED IN VARIABLE RES')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1703)
 1703 FORMAT('PREDICTED VALUES STORED IN VARIABLE PRED')
      CALL DPWRST('XXX','WRIT')
C
C               ***************************************
C               **  STEP 15--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
 7000 CONTINUE
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOLPR=MAXCP1
      ICOLRE=MAXCP2
      IREPU='OFF'
      IRESU='ON'
      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
C               ***************************************
C               **  STEP 16--                        **
C               **  STORE THE TOLERANCE VALUES       **
C               ***************************************
 7640 CONTINUE
      IH=IRECTN(1:4)
      IH2=IRECTN(5:8)
C
      NEWNAM='NO'
      DO7650I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')THEN
        ICOLL1=IVALUE(I2)
        GOTO7680
      ENDIF
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).NE.'V')THEN
        WRITE(ICOUT,7646)
 7646   FORMAT('***** ERROR IN DPRECI--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7647)IRECTN
 7647   FORMAT('      THE REQUESTED NAME FOR THE TOLERANCE ',
     1         'VARIABLE, ',A8,', WAS FOUND IN THE') 
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7648)
 7648   FORMAT('      CURRENT NAME LIST, BUT NOT AS A VARIABLE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7649)
 7649   FORMAT('      THEREFORE THE TOLERANCE VARIABLE WAS NOT ',
     1         'UPDATED.')
        CALL DPWRST('XXX','BUG ')
        GOTO7699
      ENDIF
 7650 CONTINUE
      NEWNAM='YES'
C
C  NEW VARIABLE, CHECK TO ENSURE MAXIMUM NAMES AND MAXIMUM
C  COLUMNS NOT EXCEEDED.
C
      IF(NUMNAM.GE.MAXNAM)THEN
        WRITE(ICOUT,7651)
 7651   FORMAT('***** ERROR IN DPRECI--')
        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 TOLERANCE VARIABLE WAS NOT UPDATED--')
        CALL DPWRST('XXX','BUG ')
        GOTO7699
      ENDIF
C
      IF(NUMCOL.GE.MAXCOL)THEN
        WRITE(ICOUT,7665)
 7665   FORMAT('***** ERROR IN DPRECI--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7666)
 7666   FORMAT('      THE NUMBER OF DATA COLUMNS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7667)MAXCOL
 7667   FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7668)
 7668   FORMAT('      SUGGESTED ACTION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7669)
 7669   FORMAT('      ENTER      STATUS VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7670)
 7670   FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7671)
 7671   FORMAT('      AND THEN DELETE SOME COLUMNS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7672)
 7672   FORMAT('      THE TOLERANCE VARIABLE WAS NOT UPDATED--')
        CALL DPWRST('XXX','BUG ')
        GOTO7699
      ENDIF
C
 7680 CONTINUE
      IF(NEWNAM.EQ.'YES')THEN
        NUMCOL=NUMCOL+1
        ICOLL1=NUMCOL
        NUMNAM=NUMNAM+1
        IHNAME(NUMNAM)=IH
        IHNAM2(NUMNAM)=IH2
        IUSE(NUMNAM)='V'
        VALUE(NUMNAM)=ICOLL1
        IVALUE(NUMNAM)=ICOLL1
        NTEMP=NTOT
        IF(ICASRE.EQ.'FREC'.AND.ILOCXP.GT.0)NTEMP=NPRED
        IN(NUMNAM)=NTEMP
        IF(IBUGA2.EQ.'ON')THEN
          WRITE(ICOUT,7683)IN(NUMNAM)
 7683     FORMAT('IN(NUMNAM)=',I8)
          CALL DPWRST('XXX','BUG')
        ENDIF
      ELSE
        NTEMP=NTOT
        IF(ICASRE.EQ.'FREC'.AND.ILOCXP.GT.0)NTEMP=NPRED
        IF(ICASRE.EQ.'UREC')NTEMP=1
        IN(ICOLL1)=NTEMP
        IF(IBUGA2.EQ.'ON')THEN
          WRITE(ICOUT,7686)IN(ICOLL1)
 7686     FORMAT('IN(ICOLL1)=',I8)
          CALL DPWRST('XXX','BUG')
        ENDIF
      ENDIF
      IF(IBUGA2.EQ.'ON')THEN
        WRITE(ICOUT,7681)NEWNAM,ICOLL1,NUMCOL,NUMNAM,NPRED,NTEMP
        CALL DPWRST('XXX','BUG')
 7681   FORMAT('NEWNAM,ICOLL1,NUMCOL,NUMNAM,NPRED,NTEMP =',
     1         A4,1X,5I8)
      ENDIF
      K=ICOLL1
      DO7682I=1,NTEMP
        IJ=MAXN*(K-1)+I
        IF(K.LE.MAXCOL)V(IJ)=T(I)
        IF(K.EQ.MAXCP1)PRED(I)=T(I)
        IF(K.EQ.MAXCP1)RES(I)=T(I)
        IF(K.EQ.MAXCP1)YPLOT(I)=T(I)
        IF(K.EQ.MAXCP1)XPLOT(I)=T(I)
        IF(K.EQ.MAXCP1)X2PLOT(I)=T(I)
        IF(K.EQ.MAXCP1)TAGPLO(I)=T(I)
 7682 CONTINUE
C
 7699 CONTINUE
C
C               *******************************************************
C               **  STEP 16--
C               **  READ BACK IN FROM MASS STORAGE
C               **  THE CONTENTS OF THE V(.) VECTOR.
C               **  THE ABOVE RETRIEVAL FROM MASS STORAGE IS UNNECESSARY AND IS
C               **  FOR THE SPECIAL CASE WHEN THE NUMBER OF PARAMETERS
C               **  IS 0 (A NO-FIT CASE WHEREBY WE ARE REALLY INTERESTED
C               **  IN GENERATING PREDICTED VALUES AND RESIDUALS
C               **  FOR A GIVEN FULLY-SPECIFIED MODEL).
C               ****************************************************************
C
 8000 CONTINUE
C
CCCCC ISTEPN='16'
CCCCC IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'RECI')
CCCCC1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'RECI')GOTO8109
CCCCC WRITE(ICOUT,8101)
C8101 FORMAT('WE ARE IN DPRECI AND ARE ABOUT TO READ V BACK IN')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8102)MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1)
C8102 FORMAT('MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1) = ',
CCCCC15I6,3E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8103)
C8103 FORMAT('NOTE THAT IF NUMBER OF PARAMETERS = 0, THEN ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8104)
C8104 FORMAT('NO   DUMP TO/RETRIEVAL FROM   MASS STORAGE')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8105)
C8105 FORMAT('IS DONE.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8106)NUMPAR
C8106 FORMAT('NUMPAR = ',I8)
CCCCC CALL DPWRST('XXX','BUG ')
 8109 CONTINUE
C
CCCCC IOP='READ'
CCCCC CALL DPSWAP(IOP,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
CCCCC1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGA3,ISUBRO,IERROR)
C
CCCCC IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'RECI')GOTO8129
CCCCC WRITE(ICOUT,8121)
C8121 FORMAT('WE ARE IN DPRECI AND HAVE JUST READ ',
CCCCC1'V(.) BACK IN')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8122)MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1)
C8122 FORMAT('MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1) = ',
CCCCC15I6,3E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
 8129 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'RECI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRECI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGCO,IBUGEV,IBUGQ
 9013 FORMAT('IBUGCO,IBUGEV,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NPAR,NTOT,NBCH,NLVL,ICASRE
 9015 FORMAT('NPAR,NTOT,NBCH,NLEVL,ICASRE = ',4(I8,1X),2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMNAM
 9016 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9017I=1,NUMNAM
      WRITE(ICOUT,9018)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
 9018 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9017 CONTINUE
      WRITE(ICOUT,9052)ICASEQ
 9052 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)IWIDTH
 9061 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,9062)(IANS(I),I=1,MIN(100,IWIDTH))
 9062 FORMAT('(IANS(I),I=1,IWIDTH) = ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9069)IFOUND,IERROR
 9069 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRECO(IHARG,IARGT,ARG,NUMARG,DEFRCO,
     1RECICO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE RECIPE CONFIDENCE
C              IN THE FLOATING POINT VARIABLE RECICO.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFRCO (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--RECICO  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1140
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CONF')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'CONT')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 DPRECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR RECIPE CONFIDENCE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      AN EXAMPLE OF THIS COMMAND IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      RECIPE CONFIDENCE .90 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1140 CONTINUE
      IF(NUMARG.EQ.2)HOLD=DEFRCO
      IF(NUMARG.GT.2.AND.IARGT(NUMARG).EQ.'NUMB')HOLD=ARG(NUMARG)
      GOTO1180
C
 1150 CONTINUE
      HOLD=DEFRCO
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IF(HOLD.GE.1.0 .AND. HOLD.LT.100.0)HOLD=HOLD/100.
      IF(HOLD.LE.0.0 .OR. HOLD.GE.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1182)
 1182 FORMAT('**** THE RECIPE CONFIDENCE MUST BE SET TO BETWEEN 0 AND 1',
     1'EXCLUSIVE (WITH TYPICAL VALUES BETWEEN .9 AND .99)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1183)HOLD
 1183 FORMAT('     THE VALUE ENTERED WAS ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO1199
      ENDIF
      RECICO=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)RECICO
 1181 FORMAT('THE RECIPE CONFIDENCE HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPRECR(IHARG,IARGT,IARG,NUMARG,IDEFCR,
     1IRECCR,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE NUMBER OF RECIPE CORRELATION POINTS
C              TO USE FOR THE SIMCOV COMMAND
C              IN THE INTEGER POINT VARIABLE IRECCR.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (A  INTEGER POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFCR (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--IRECCR  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1140
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CORR')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'CORR')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 DPRECR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR RECIPE CORRELATION ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      AN EXAMPLE OF THIS COMMAND IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      RECIPE CORRELATION 11 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1140 CONTINUE
      IF(NUMARG.EQ.2)IHOLD=IDEFCR
      IF(NUMARG.GT.2.AND.IARGT(NUMARG).EQ.'NUMB')IHOLD=IARG(NUMARG)
      GOTO1180
C
 1150 CONTINUE
      IHOLD=IDEFCR
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IF(IHOLD.LE.3)IHOLD=3
      IF(IHOLD.GE.100)IHOLD=100
      IRECCR=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IRECCR
 1181 FORMAT('THE NUMBER OF CORRELATION POINTS FOR THE SIMCOV ',
     1'COMMAND HAS JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPREDG(IHARG,IARGT,ARG,NUMARG,DEFRDG,
     1RECIDG,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE RECIPE FIT DEGREE
C              IN THE FLOATING POINT VARIABLE RECIDG.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFRDG (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--RECIDG  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FIT '.AND.IHARG(2).EQ.'DEGR')
     1GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'=')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DEGR')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'DEGR')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 DPREDG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR RECIPE FIT DEGREE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      AN EXAMPLE OF THIS COMMAND IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      RECIPE FIT DEGREE 2 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFRDG
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IF(HOLD.LT.0.0 .OR. HOLD.GT.10.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1182)
 1182 FORMAT('**** THE RECIPE DEGREE MUST BE SET TO BETWEEN 0 AND 10',
     1' (WITH TYPICAL VALUES BEING 1 OR 2)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1183)HOLD
 1183 FORMAT('     THE VALUE ENTERED WAS ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO1199
      ENDIF
      RECIDG=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)RECIDG
 1181 FORMAT('THE RECIPE FIT DEGREE HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPREFA(IHARG,IARGT,ARG,NUMARG,DEFRFA,
     1RECIFA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE RECIPE ANOVA FACTORS
C              IN THE FLOATING POINT VARIABLE RECIFA.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFRFA (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--RECIFA  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'ANOV'.AND.IHARG(2).EQ.'FACT')
     1GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'=')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FACT')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'FACT')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 DPREFA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR RECIPE ANOVA FACTORS ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      AN EXAMPLE OF THIS COMMAND IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      RECIPE ANOVA FACTORS 2 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFRFA
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IF(HOLD.LT.0.51)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1182)
 1182 FORMAT('**** THE RECIPE FACTORS MUST BE POSITIVE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1183)HOLD
 1183 FORMAT('     THE VALUE ENTERED WAS ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO1199
      ENDIF
      RECIFA=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)RECIFA
 1181 FORMAT('THE NUMBER OF FACTORS FOR RECIPE ANOVA HAS JUST BEEN ',
     1'SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPREFF(IHARG,IARGT,ARG,NUMARG,DEFRFF,
     1RECIFF,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE RECIPE FIT FACTORS
C              IN THE FLOATING POINT VARIABLE RECIFF.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFRFF (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--RECIFF  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/4
C     ORIGINAL VERSION--APRIL    1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FIT '.AND.IHARG(2).EQ.'FACT')
     1GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'=')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FACT')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'FACT')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 DPREFF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR RECIPE FIT FACTORS ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      AN EXAMPLE OF THIS COMMAND IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      RECIPE FIT FACTORS 2 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFRFF
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IF(HOLD.LT.0.51)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1182)
 1182 FORMAT('**** THE RECIPE FACTORS MUST BE POSITIVE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1183)HOLD
 1183 FORMAT('     THE VALUE ENTERED WAS ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO1199
      ENDIF
      RECIFF=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)RECIFF
 1181 FORMAT('THE NUMBER OF FACTORS FOR RECIPE FIT HAS JUST BEEN ',
     1'SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPREGR(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--REPEAT A PREVIOUSLY CREATED PLOT AND PUT ON A DISTINCT
C              GRAPHICS WINDOW.
C
C                  REPEAT PLOT <FILE NAME>:
C                      REDRAWS THE PIXMAP FROM A SPECIFIED FILE
C
C                  REPEAT PLOT <+N>:
C                      REDRAWS THE Nth PIXMAP FROM THE CURRENT LIST
C
C                  REPEAT PLOT <-N>:
C                      REDRAWS THE Nth PIXMAP AGO FROM THE CURRENT LIST
C                      (E.G., IF THERE ARE CURRENTLY 8 PIXMAPS,
C                      REPEAT PLOT -2 PLOTS THE SIXTH PIXMAP
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGU
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/4
C     ORIGINAL VERSION--APRIL     1997.
C     UPDATED         --AUGUST    1997. MOVE SOME CODE TO A LOWER LEVEL
C                                       TO SUPPORT NON-X11 DEVICES
C                                       (SPECIFICALLY PC FOR NOW)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      INCLUDE 'DPCOPA.INC'
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IEXIST
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
      CHARACTER*4 IFOUND
C
      CHARACTER*4 IC4
      CHARACTER*4 ICODE
      CHARACTER*10 CTEMP
C  DIMENSION FOLLOWING 2 LINES TO MAXSTR
      CHARACTER*256 ISTRIN
      CHARACTER*256 ISTRI2
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DIMENSION IANSLC(*)
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
CCCCC DIMENSION IADE(128)
CCCCC DIMENSION IADE2(138)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPM.INC'
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPRE'
      ISUBN2='GR  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'REGR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPREGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IFOUND,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,54)(IANSLC(I),I=1,IWIDTH)
   54 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMARG
   55 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO58
      DO56I=1,NUMARG
      WRITE(ICOUT,57)I,IHARG(I)
   57 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   58 CONTINUE
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  DETERMINE IF HAVE AN EXPLICIT FILE REFERENCE    **
C               **  WHERE THE PIXMAP FILE IS STORED                 **
C               ******************************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REGR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFILWD=(-999)
C
      DO1100I=1,MAXSTR
      IC4=IANSLC(I)
      ISTRIN(I:I)=IC4(1:1)
 1100 CONTINUE
C
      IWORD=1
      ISTART=1
      ISTOP=MAXSTR-1
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
C
      IF(NUMARG.LE.0)GOTO1129
      IWORD=2
      ISTART=1
      ISTOP=MAXSTR-1
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
      IF(NCSTR2.LE.0)GOTO1129
      DO1121I=1,NCSTR2
      IF(ISTRI2(I:I).EQ.'.')GOTO1122
 1121 CONTINUE
      GOTO1129
 1122 CONTINUE
      IFILWD=2
      GOTO1150
 1129 CONTINUE
C
      IF(NUMARG.LE.1)GOTO1139
      IWORD=3
      ISTART=1
      ISTOP=MAXSTR-1
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
      IF(NCSTR2.LE.0)GOTO1139
      DO1131I=1,NCSTR2
      IF(ISTRI2(I:I).EQ.'.')GOTO1132
 1131 CONTINUE
      GOTO1139
 1132 CONTINUE
      IFILWD=3
      GOTO1150
 1139 CONTINUE
C
 1150 CONTINUE
      ISTAM1=0
      IF(IFILWD.EQ.2.OR.IFILWD.EQ.3)ISTAM1=1
C
C               ******************************************************
C               **  STEP 11.B--IF NO FILE, CHECK FOR NUMBER         **
C               ******************************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REGR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFILWD.LE.0)THEN
        IF(NUMARG.GE.1.AND.IARGT(NUMARG).EQ.'NUMB')THEN
          IHOLD=IARG(NUMARG)
          IF(IHOLD.GT.0)THEN
            IF(IHOLD.LE.NUMPXM)THEN
              ICURPM=IHOLD
              ISTRI2(1:128)=IPXMFN(ICURPM)(1:128)
            ELSE
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,1161)IHOLD
              CALL DPWRST('XXX','BUG')
              WRITE(ICOUT,1163)NUMPXM
              CALL DPWRST('XXX','BUG')
              IERROR='YES'
              GOTO9000
            ENDIF
          ELSE
            IF(NUMPXM-ABS(IHOLD).GT.0)THEN
              ICURPM=NUMPXM-ABS(IHOLD)
              ISTRI2(1:128)=IPXMFN(ICURPM)(1:128)
            ELSE
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,1171)IHOLD
              CALL DPWRST('XXX','BUG')
              WRITE(ICOUT,1173)NUMPXM
              CALL DPWRST('XXX','BUG')
              IERROR='YES'
              GOTO9000
            ENDIF
          ENDIF
        ELSE
          IF(NUMPXM.GT.0)THEN
            ICURPM=NUMPXM
            ISTRI2(1:128)=IPXMFN(ICURPM)(1:128)
          ELSE
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1181)
            CALL DPWRST('XXX','BUG')
            WRITE(ICOUT,1183)
            CALL DPWRST('XXX','BUG')
            IERROR='YES'
            GOTO9000
          ENDIF
        ENDIF
        NCSTR2=0
        DO1187I=128,1,-1
            NCSTR2=I
            IF(ISTRI2(I:I).NE.' ')GOTO1189
 1187   CONTINUE
 1189   CONTINUE
C
C  FOR PIXMAP SPECIFIED BY FILE NAME, CHECK CURRENT LIST.  IF NOT
C  FOUND, ADD TO LIST.
C
      ELSE
        ICURPM=0
        IF(NUMPXM.GE.1)THEN
          DO1191I=1,NUMPXM
            IF(ISTRI2(1:128).EQ.IPXMFN(I)(1:128))THEN
              ICURPM=I
              GOTO1199
            ENDIF
 1191     CONTINUE
          IF(NUMPXM.LT.MAXPM)THEN
            NUMPXM=NUMPXM+1
            IPXMFN(NUMPXM)(1:128)=ISTRI2(1:128)
            IPXMCM(NUMPXM)(1:128)=ISTRI2(1:128)
            ICURPM=NUMPXM
          ENDIF
 1199     CONTINUE
        ELSE
          NUMPXM=NUMPXM+1
          IPXMFN(NUMPXM)(1:128)=ISTRI2(1:128)
          IPXMCM(NUMPXM)(1:128)=ISTRI2(1:128)
          ICURPM=NUMPXM
        ENDIF
      ENDIF
 1161 FORMAT('***** ERROR IN DPREGR: THE SPECIFIED PIXMAP NUMBER (',I5,
     1') IS GREATER THAN ')
 1163 FORMAT('      THE NUMBER OF CURRENTLY DEFINED PIXMAPS (',I5,')')
 1171 FORMAT('***** ERROR IN DPREGR: YOU ASKED FOR (',I5,') PLOTS ',
     1'AGO AND')
 1173 FORMAT('      THERE ARE ONLY (',I5,') PIXMAPS CURRENTLY SAVED.')
 1181 FORMAT('***** ERROR IN DPREGR: NO PIXMAP FILE NAME OR NUMBER ',
     1'WAS SPECIFIED.')
 1183 FORMAT('      HOWEVER, THERE ARE CURRENTLY NO PIXMAPS SAVED.')
C
C               *******************************
C               **  STEP 12--                **
C               **  CALL XRESTG              **
C               *******************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REGR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='REGR'
      CALL DPINFI(ISTRI2,IEXIST,ISUBN0,IBUGS2,ISUBRO,IERROR)
      IF(IEXIST.NE.'YES'.OR.IERROR.EQ.'YES')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1203)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1204)ISTRI2(1:MIN(NCSTR2,80))
        CALL DPWRST('XXX','BUG')
        GOTO9000
      ENDIF
 1203 FORMAT('***** ERROR IN DPREGR--UNABLE TO OPEN THE REQUESTED ',
     1       'PLOT.')
 1204 FORMAT('      THE REQUESTED FILE IS: ',A80)
C
      IF(NCSTR2.GT.127)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
 1209 FORMAT('***** ERROR IN DPREGR--FILE NAME EXCEEDS 127 ',
     1'CHARACTERS.')
      ENDIF
      CTEMP=' '
      IF(ICURPM.LE.9)THEN
        CTEMP(1:4)='  - '
        WRITE(CTEMP(1:1),'(I1)')ICURPM
        NCTEMP=4
      ELSEIF(ICURPM.LE.99)THEN
        CTEMP(1:5)='   - '
        WRITE(CTEMP(1:2),'(I2)')ICURPM
        NCTEMP=5
      ELSEIF(ICURPM.LE.999)THEN
        CTEMP(1:6)='    - '
        WRITE(CTEMP(1:3),'(I3)')ICURPM
        NCTEMP=6
      ENDIF
C
      DO1220I=1,NCSTR2
        NCTEMP=NCTEMP+1
        CTEMP(NCTEMP:NCTEMP)=ISTRI2(I:I)
 1220 CONTINUE
C
C  AUGUST 1997.  GENERALIZE THIS ROUTINE FOR NON-X11 DEVICES.
C  CALL A LOWER LEVEL ROUTINE, MOVE FOLLOWING CODE TO THAT ROUTINE.
C
      ICODE='REST'
      CALL GRSAGR(ICODE,ISTRI2,NCSTR2,CTEMP,NCTEMP)
CCCCC DO1215I=1,NCTEMP
CCCCC   CALL DPCOAN(CTEMP(I:I),IADE2(I))
C1215 CONTINUE
CCCCC DO1220I=1,NCSTR2
CCCCC   CALL DPCOAN(ISTRI2(I:I),IADE(I))
CCCCC   CALL DPCOAN(ISTRI2(I:I),IADE2(I+NCTEMP))
C1220 CONTINUE
CCCCC IADE(NCSTR2+1)=0
CCCCC IADE2(NCSTR2+NCTEMP+1)=0
C
CCCCC IERR=0
CCCCC CALL XRESTG(IADE,IADE2,IERR)
CCCCC IF(IERR.EQ.1)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1251)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1251 FORMAT('***** ERROR IN DPREGR--READING BIT MAP UNSUCCESSFUL.')
CCCCC ELSEIF(IERR.EQ.2)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1261)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1261 FORMAT('***** ERROR IN DPREGR--NO CURRENT PIXMAP TO SAVE.')
CCCCC ELSEIF(IERR.EQ.3)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1271)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1271 FORMAT('***** ERROR IN DPREGR--X11 HAS NOT BEEN OPENED.')
CCCCC ELSEIF(IERR.EQ.4)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1281)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1281 FORMAT('***** ERROR IN DPREGR--X11 NOT INSTALLED ON THIS ',
CCCCC1'IMPLEMENTATION.')
CCCCC ELSEIF(IERR.EQ.5)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1286)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1286 FORMAT('***** ERROR IN DPREGR--UNABLE TO OPEN NEW X11 WINDOW ')
CCCCC ELSE
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1291)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1292)ISTRI2(1:NCSTR2)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1291 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY COPIED FROM FILE ')
C1292 FORMAT('      ',A128)
CCCCC ENDIF
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'REGR')GOTO1299
      WRITE(ICOUT,1293)ISTRI2(1:NCSTR2)
 1293 FORMAT('ISTRI2 = ',A128)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1294)NCSTR2
 1294 FORMAT('NCSTR2 = ',I4)
      CALL DPWRST('XXX','BUG ')
 1299 CONTINUE
C
 5190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'REGR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPREGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IFOUND,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IWIDTH
 9013 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,9014)(IANSLC(I),I=1,IWIDTH)
 9014 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMARG
 9015 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9018
      DO9016I=1,NUMARG
      WRITE(ICOUT,9017)I,IHARG(I)
 9017 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9018 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPREMA(IHARG,NUMARG,
     1IBASLC,
     1IMACSC,IDEFMS,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MACRO SUBSTITUTION CHARACTOR WHICH MAY
C              BE USED TO REPLACE A COMMAND LINE ARGUMENT TO
C              A MACRO.  FOR EXAMPLE
C
C                  CALL SAMPLE.DP BERGER1.DAT Y X
C
C              IN SAMPLE.DP, $1 WILL BE REPLACED BY BERGER1.DAT,
C              $2 WILL BE REPLACED BY Y, AND $3 WILL BE REPLACED
C              BY X.  THIS ROUTINE LETS YOU SPECIFY A CHARACTER
C              OTHER THAN  "$" TO SIGNIFY A COMMAND LINE ARGUMENT.
C              THE SPECIFIED MACRO SUBSTITUTION CHARACTOR WILL BE
C              PLACED IN THE CHARACTER VARIABLE IMACSC.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IBASLC (A CHARACTER VARIABLE--BACKSLASH)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--IMACSC (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/9
C     ORIGINAL VERSION--SEPTEMBER  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*1 IBASLC
      CHARACTER*1 IMACSC
      CHARACTER*1 IDEFMS
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHARG4
      CHARACTER*1 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'REMA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPREMA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)NUMARG
   54   FORMAT('NUMARG = ',I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NUMARG
          WRITE(ICOUT,56)I,IHARG(I)
   56     FORMAT('I,IHARG(I) = ',I8,2X,A4)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1150
      GOTO1110
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFMS
      GOTO1180
C
 1160 CONTINUE
      IHARG4=IHARG(NUMARG)
      IHOLD=IHARG4(1:1)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IMACSC=IHOLD
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1181)IMACSC
 1181   FORMAT('THE MACRO SUBSTITUTION CHARACTOR HAS BEEN SET TO ',
     1         A1)
        CALL DPWRST('XXX','BUG ')
 1189 ENDIF
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'REMA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPREMA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012   FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)IHARG4,IHOLD
 9013   FORMAT('IHARG4,IHOLD = ',A4,2X,A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)IMACSC
 9014   FORMAT('IMACSC = ',A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPREMO(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,DEMOFR,DEMODF,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A COMPLEX REMODULATION PLOT
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           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/6
C     ORIGINAL VERSION--MARCH     1986.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.141592653/
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPRE'
      ISUBN2='MO  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=1
      MINN2=2
C
C               ***********************************************
C               **  TREAT THE COMPLEX REMODULATION CASE      **
C               ***********************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPREMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'REMO'.AND.IHARG(1).EQ.'PLOT')GOTO110
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'COMP'.AND.IHARG(1).EQ.'REMO'.AND.IHARG(2).EQ.'PLOT')
     1GOTO120
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ICASPL='CR'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  120 CONTINUE
      ICASPL='CR'
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               ***********************************************************
C               **  STEP 1--                                             **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,ICOLL,NLEFT
  211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.                   **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPREMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A COMPLEX REMODULATION PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPREMO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  CHECK FOR PROPER NUMBER OF VARIABLES.  **
C               **  FOR A COMPLEX REMODULATION PLOT,       **
C               **  THE PROPER NUMBER OF VARIABLES IS      **
C               **  EXACTLY 1.                             **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.1)GOTO590
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPREMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      (FOR A COMPLEX REMODULATION PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,559)
  559 FORMAT('      MUST BE EXACTLY 1  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  560 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,561)
  561 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)NUMV2
  562 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,564)(IANS(I),I=1,IWIDTH)
  564 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *************************************************
C               **  STEP 6--                                   **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
  660 CONTINUE
      NLOCAL=J
C
C               ***********************************************************
C               **  STEP 7--                                             **
C               **  DETERMINE IF THE ANALYST                             **
C               **  HAS SPECIFIED    THE DEMODULATION FREQUENCY          **
C               **  FOR THE COMPLEX DEMODULATION ANALYSIS.               **
C               **  THE FREQUENCY SETTING IS DEFINED BY PRE-USE          **
C               **  OF THE DEMODULATION FREQUENCY     COMMAND.           **
C               **  IF FOUND, USE THE SPECIFIED VALUE.                   **
C               **  IF NOT FOUND, GENERATE AN ERROR MESSAGE.             **
C               ***********************************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DEMOF2=DEMOFR
      IF(IANGLU.EQ.'DEGR')DEMOF2=DEMOF2*PI/180.0
      IF(IANGLU.EQ.'GRAD')DEMOF2=DEMOF2*PI/200.0
      IF(0.0.LT.DEMOF2.AND.DEMOF2.LT.0.5)GOTO790
C
  740 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,741)
  741 FORMAT('***** ERROR IN DPREMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,742)
  742 FORMAT('       FOR A COMPLEX REMODULATION PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,744)
  744 FORMAT('       THE FREQUENCY AT WHICH THE DEMODULATION/')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,745)
  745 FORMAT('       REMODULATION IS TO BE PERFORMED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,746)
  746 FORMAT('       MUST BE PRE-SPECIFIED BY THE ANALYST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,747)
  747 FORMAT('       AND MUST BE BETWEEN 0 AND 0.5 RADIANS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,748)
  748 FORMAT('       SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,749)DEMOFR,IANGLU
  749 FORMAT('       THE DEMODULATION FREQUENCY = ',E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IANGLU.NE.'RADI')WRITE(ICOUT,750)DEMOF2
  750 FORMAT('       THE DEMODULATION FREQUENCY = ',E15.7,2X,
     1'RADIANS')
      IF(IANGLU.NE.'RADI')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,751)
  751 FORMAT('       TO DEFINE THE DEMODULATION FREQUENCY,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,752)
  752 FORMAT('       THE ANALYST USES THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,753)
  753 FORMAT('       DEMODULATION FREQUENCY     COMMAND, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,754)
  754 FORMAT('            DEMODULATION FREQUENCY 0.3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,755)
  755 FORMAT('            DEMODULATION FREQUENCY 0.155')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  790 CONTINUE
C
C               ****************************************************************
C               **  STEP 8--                                                   *
C               **  COMPUTE THE APPROPRIATE COMPLEX REMODULATION PLOT.         *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                      *
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.                         *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).              *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).              *
C               ****************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPREM2(Y1,NLEFT,ICASPL,DEMOF2,DEMODF,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPREMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)DEMOFR,IANGLU,DEMOF2
 9014 FORMAT('DEMOFR,IANGLU,DEMOF2 = ',E15.7,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPREM2(Y,N,ICASPL,F,DEMODF,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A COMPLEX REMODULATION
C              ON THE DATA IN THE INPUT VECTOR X
C              AT THE INPUT DEMODULATION FREQUENCY = F.
C              THE COMPLEX REMODULATION CONSISTS OF
C              DEMODULATING AT THE SPECIFIED FREQUENCY
C              AND THEN REMODULATING TO FORM A PLOT
C              IN THE ORIGINAL UNITS OF THE DATA WHICH
C              SHOWS THE CONTRIBUTION AT THAT FREQUENCY
C              TO THE ORIGINAL SERIES.  IT IS USEFUL
C              FOR FORMING A BAND-PASS FILTERED SERIES
C              AND (AFTER SUBTRACTION) A REJECTION-PASS
C              FILTERED SERIES.
C
C              THE ALLOWABLE RANGE OF THE INPUT DEMODULATION
C              FREQUENCY F IS 0.0 TO 0.5 (EXCLUSIVELY).
C              THE INPUT DEMODULATION FREQUENCY F IS MEASURED  OF
C              IN UNITS OF CYCLES PER 'DATA POINT' OR,
C              MORE PRECISELY, IN CYCLES PER UNIT TIME WHERE
C              'UNIT TIME' IS DEFINED AS THE
C              ELAPSED TIME BETWEEN ADJACENT OBSERVATIONS.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C                      FREQ   = THE SINGLE PRECISION
C                               DEMODULATION FREQUENCY.
C                               F IS IN UNITS OF CYCLES PER DATA POINT.
C                               F IS BETWEEN 0.0 AND 0.5 (EXCLUSIVELY).
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 5000.
C                 --THE SAMPLE SIZE N MUST BE GREATER
C                   THAN OR EQUAL TO 3.
C                 --THE INPUT FREQUENCY F MUST BE
C                   GREATER THAN OR EQUAL TO 2/(N-2).
C                 --THE INPUT FREQUENCY F MUST BE
C                   SMALLER THAN 0.5.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     COMMENT--IN ORDER THAT THE RESULTS OF THE COMPLEX DEMODULATION
C              BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA
C              IN X SHOULD BE EQUI-SPACED IN TIME
C              (OR WHATEVER VARIABLE CORRESPONDS TO TIME).
C            --IF THE INPUT OBSERVATIONS IN X ARE CONSIDERED
C              TO HAVE BEEN COLLECTED 1 SECOND APART IN TIME,
C              THEN THE DEMODULATION FREQUENCY F
C              WOULD BE IN UNITS OF HERTZ
C              (= CYCLES PER SECOND).
C            --A FREQUENCY OF 0.0 CORRESPONDS TO A CYCLE
C              IN THE DATA OF INFINITE (= 1/(0.0))
C              LENGTH OR PERIOD.
C              A FREQUENCY OF 0.5 CORRESPONDS TO A CYCLE
C              IN THE DATA OF LENGTH = 1/(0.5) = 2 DATA POINTS.
C            --IN EXAMINING THE AMPLITUDE AND PHASE PLOTS,
C              ATTENTION SHOULD BE PAID NOT ONLY TO THE
C              STRUCTURE OF THE PHASE PLOT
C              (NEAR-ZERO SLOPE VERSUS NON-ZERO SLOPE)
C              BUT ALSO TO THE RANGE
C              OF VALUES ON THE VERTICAL AXIS.
C              A PLOT WITH MUCH STRUCTURE BUT
C              WITH A SMALL RANGE ON THE VERTICAL AXIS
C              IS USUALLY MORE INDICATIVE OF A
C              DEFINITE CYCLIC COMPONENT AT THE
C              SPECIFIED INPUT DEMODULATION FREQUENCY,
C              THAN IS A PLOT WITH LESS STRUCTURE BUT
C              A WIDER RANGE ON THE VERTICAL AXIS.
C            --INTERNAL TO THIS SUBROUTINE, 2 MOVING
C              AVERAGES ARE APPLIED, EACH OF LENGTH 1/F.
C              HENCE THE AMPLITUDE AND PHASE PLOTS
C              HAVE N - 2/F VALUES
C              (RATHER THAN N VALUES) ALONG THE
C              HORIZONTAL (TIME) AXIS.
C              IN ORDER THAT THE AMPLITUDE AND PHASE
C              PLOTS BE NON-EMPTY, AN INPUT
C              REQUIREMENT ON F FOR THIS SUBROUTINE
C              IS THAT THE SAMPLE SIZE N
C              AND THE DEMODULATION FREQUENCY F
C              MUST BE SUCH THAT
C              N - 2/F BE GREATER THAN ZERO.
C              FURTHER, SINCE A PLOT WITH BUT
C              1 POINT IS MEANINGLESS
C              AND OUGHT ALSO BE EXCLUDED,
C              THE REQUIREMENT IS EXTENDED
C              SO THAT N - 2/F MUST BE GREATER THAN 1.
C     REFERENCES--GRANGER AND HATANAKA, PAGES 170 TO 189,
C                 ESPECIALLY PAGES 174 AND 175.
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           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/6
C     ORIGINAL VERSION--NOVEMBER  1972.
C     UPDATED         --JANUARY   1989.  PARAMETER STATEMENT MISPLACED (ALAN)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      INCLUDE 'DPCOPA.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-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.141592653/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPRE'
      ISUBN2='2  '
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPREM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,ICASPL
   52 FORMAT('N,ICASPL = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      ILOWER=3
      IUPPER=MAXOBV
      AN=N
      FMIN=2.0/(AN-2.0)
C
C               ********************************************
C               **  STEP 0--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LT.ILOWER.OR.N.GT.IUPPER)GOTO50
      IF(F.LE.FMIN.OR.F.GE.0.5)GOTO60
      HOLD=Y(1)
      DO65I=2,N
      IF(Y(I).NE.HOLD)GOTO95
   65 CONTINUE
      WRITE(ICOUT, 9)HOLD
      CALL DPWRST('XXX','BUG ')
      GOTO9000
   50 WRITE(ICOUT,17)ILOWER,IUPPER
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)N
      CALL DPWRST('XXX','BUG ')
      GOTO9000
   60 WRITE(ICOUT,27)FMIN
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)F
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,28)FMIN,N
      CALL DPWRST('XXX','BUG ')
      GOTO9000
   95 CONTINUE
    9 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME',
     1'NT (A VECTOR) TO THE DPREM2  SUBROUTINE HAS ALL ELEMENTS = ',
     1E15.8)
   17 FORMAT('***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE ',
     1'DPREM2  SUBROUTINE IS OUTSIDE THE ALLOWABLE (',I6,',',I6,') ',
     1'INTERVAL')
   27 FORMAT('***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE ',
     1'DPREM2  SUBROUTINE IS OUTSIDE THE ALLOWABLE (',I6,'0.5) ',
     1'INTERVAL')
   28 FORMAT('                   THE ABOVE LOWER LIMIT (',F10.8,
     1') = 2/(N-2) WHERE N = THE INPUT SAMPLE SIZE = ',I8)
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8)
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
C
C               ******************************
C               **  STEP 1--                **
C               **  FORM THE COSINE SERIES  **
C               ******************************
C
      DO100I=1,N
      AI=I
      Y2(I)=Y(I)*COS(2.0*PI*F*AI)
  100 CONTINUE
C
C     DEFINE THE LENGTH OF THE 2 MOVING AVERAGES
C
      LENMA1=1.0/F
      LENMA2=1.0/F
      ALEN1=LENMA1
      ALEN2=LENMA2
      IMAX1=N-LENMA1
      IMAX2=IMAX1-LENMA2
C
C               ***********************************************************
C               **  STEP 2--                                             **
C               **  FORM THE FIRST MOVING AVERAGE FOR THE COSINE SERIES  **
C               ***********************************************************
C
      DO200I=1,IMAX1
      ISTART=I+1
      IEND=I+LENMA1-1
      IENDP1=I+LENMA1
      SUM=0.0
      DO300J=ISTART,IEND
      SUM=SUM+Y2(J)
  300 CONTINUE
      SUM=SUM+Y2(I)/2.0+Y2(IENDP1)/2.0
      D2(I)=SUM/ALEN1
  200 CONTINUE
C
C               ************************************************************
C               **  STEP 3--                                              **
C               **  FORM THE SECOND MOVING AVERAGE FOR THE COSINE SERIES  **
C               ************************************************************
C
      DO400I=1,IMAX2
      ISTART=I+1
      IEND=I+LENMA2-1
      IENDP1=I+LENMA2
      SUM=0.0
      DO500J=ISTART,IEND
      SUM=SUM+D2(J)
  500 CONTINUE
      SUM=SUM+D2(I)/2.0+D2(IENDP1)/2.0
      Y2(I)=SUM/ALEN2
  400 CONTINUE
C
C               ****************************
C               **  STEP 4--              **
C               **  FORM THE SINE SERIES  **
C               ****************************
C
      DO700I=1,N
      AI=I
      X2(I)=Y(I)*SIN(2.0*PI*F*AI)
  700 CONTINUE
C
C               *********************************************************
C               **  STEP 5--                                           **
C               **  FORM THE FIRST MOVING AVERAGE FOR THE SINE SERIES  **
C               *********************************************************
C
      DO800I=1,IMAX1
      ISTART=I+1
      IEND=I+LENMA1-1
      IENDP1=I+LENMA1
      SUM=0.0
      DO900J=ISTART,IEND
      SUM=SUM+X2(J)
  900 CONTINUE
      SUM=SUM+X2(I)/2.0+X2(IENDP1)/2.0
      D2(I)=SUM/ALEN1
  800 CONTINUE
C
C               **********************************************************
C               **  STEP 6--                                            **
C               **  FORM THE SECOND MOVING AVERAGE FOR THE SINE SERIES  **
C               **********************************************************
C
      DO1000I=1,IMAX2
      ISTART=I+1
      IEND=I+LENMA1-1
      IENDP1=I+LENMA1
      SUM=0.0
      DO1100J=ISTART,IEND
      SUM=SUM+D2(J)
 1100 CONTINUE
      SUM=SUM+D2(I)/2.0+D2(IENDP1)/2.0
      X2(I)=SUM/ALEN2
 1000 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  FORM THE REMODULATED SERIES        **
C               *****************************************
C
 1400 CONTINUE
      IHALF=(LENMA1+LENMA2)/2
      ISTART=IHALF+1
      ISTOP=N-IHALF
C
CCCCC DO1450I=1,IMAX2
      DO1450I=1,N
      IF(I.LT.ISTART)GOTO1410
      IF(I.GT.ISTOP)GOTO1410
      GOTO1420
C
 1410 CONTINUE
      Y2(I)=Y(I)
      X2(I)=I
      D2(I)=1.0
      GOTO1450
C
 1420 CONTINUE
      AI=I
      TERM1=2.0*Y2(I)*SIN(2.0*PI*F*AI)
      TERM2=2.0*X2(I)*COS(2.0*PI*F*AI)
      Y2(I)=TERM1+TERM2
      X2(I)=I
      D2(I)=1.0
      GOTO1450
C
 1450 CONTINUE
CCCCC N2=IMAX2
      N2=N
      NPLOTV=2
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPREM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N,ICASPL
 9012 FORMAT('N,ICASPL = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)LENMA1,LENMA2
 9013 FORMAT('LENMA1,LENMA2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMAX1,IMAX2
 9014 FORMAT('IMAX1,IMAX2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IHALF,ISTART,ISTOP
 9015 FORMAT('IHALF,ISTART,ISTOP = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPREPC(IHARG,IARGT,ARG,NUMARG,DEFRPC,
     1RECIPC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE RECIPE PROBABILITY CONTENT
C              IN THE FLOATING POINT VARIABLE RECIPC.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFRPC (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--RECIPC  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'PROB'.AND.IHARG(2).EQ.'CONT')
     1GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'=')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CONT')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PROB')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'CONT')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 DPREPC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR RECIPE PROBABILITY CONTENT ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      AN EXAMPLE OF THIS COMMAND IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      RECIPE PROBABILITY CONTENT .90 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFRPC
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IF(HOLD.GE.1.0 .AND. HOLD.LT.100.0)HOLD=HOLD/100.
      IF(HOLD.LE.0.0 .OR. HOLD.GE.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1182)
 1182 FORMAT('**** THE RECIPE PROBABILITY CONTENT MUST BE SET BETWEEN',
     1' 0 AND 1 EXCLUSIVE (TYPICALLY BETWEEN .9 AND .99)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1183)HOLD
 1183 FORMAT('     THE VALUE ENTERED WAS ',E15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO1199
      ENDIF
      RECIPC=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)RECIPC
 1181 FORMAT('THE RECIPE PROBABILITY CONTENT HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPREPL(ITEXHO,NUMTEC,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGD2,IERROR)
C
C     PURPOSE--TRANSLATE A STRING AS DICTATED BY THE   VALU()   OPERATOR.
C              THAT IS, REPLACE ALL OCCURRANCES OF  XXXVALU()YYY
C              (WHERE XXX IS AN ARBITRARY STRING, AND
C              YYY IS A DATAPLOT PARAMETER NAME OR A FUNCTION NAME)
C              BY THE NUMERIC VALUE OF THE PARAMETER YYY, OR
C              THE FUNCTIONAL STRING IN THE FUNCTION YYY.
C              (E.G., IF PARAMETER K HAS THE VALUE 7,
C              THEN   YVALU()K   BECOMES   Y7
C              OR     IF THE FUNCTION K HAS THE CONTENTS XYZ,
C              THEN   YVALU()K   BECOMES   YABC  ).
C     NOTE--THIS SUBROUTINE CHANGES THE CONTENTS OF THE INPUT VECTOR ITEXHO()
C           AND THE INPUT VARIABLE NUMTEC.
C     NOTE--THIS SUBROUTINE IS SIMILAR TO (BUT NOT IDENTICAL TO) DPREP2.
C           SUBROUTINE DPREPL TRANSLATES THE VALU() OPERATOR.
C           SUBROUTINE DPREPL TRANSLATES THE \      OPERATOR.
C     NOTE--ALTHOUGH IREPCH IS AN INPUT ARGUMENT TO THIS SUBROUTINE,
C           IT IS NEVER USED HEREIN.
C           IT IS ALLOWED TO REMAIN AS AN INPUT ARGUMENT
C           ONLY TO MAINTAIN CONSISTENCY WITH SUBROUTINE DPREP2
C           (WHICH DOES USE IT).
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH      1983.
C     UPDATED         --DECEMBER  1986. STOP WITH "
C     UPDATED         --DECEMBER  1988. STOP WITH )
C     UPDATED         --DECEMBER  1988. STOP WITH & AND COLLAPSE
C     UPDATED         --MAY       1992. ADD 8 DELIMITERS FOR ^
C     UPDATED         --JULY      1992. ADD . AND ^ AS DELIMITERS
C     UPDATED         --DECEMBER  1993. ALLOW LOWER CASE: valu()
C     UPDATED         --DECEMBER  1993. ALLOW LOWER CASE PAR. NAME
C     UPDATED         --JULY      1995. COMMENT OUT 2 LINES
C     UPDATED         --AUGUST    2002. ADD "?" AS DELIMITER
C     UPDATED         --JUNE      2003. TREAT ANYTHING THAT IS NOT A
C                                       NUMBER OR LETTER OR UNDERSCORE
C                                       AS DELIMITER
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ITEXHO
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISTR
      CHARACTER*4 IH
      CHARACTER*4 IFOUNV
      CHARACTER*4 IFOUNG
      CHARACTER*4 IWORD1
      CHARACTER*4 IWORD2
      CHARACTER*4 IHNAP1
      CHARACTER*4 IHNAP2
      CHARACTER*4 IHNAP3
      CHARACTER*4 IHNAP4
      CHARACTER*1 IH1
      CHARACTER*4 IUS
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
C
      CHARACTER*4 IFUNC
C
      CHARACTER*1 IREPCH
C
      CHARACTER*4 IAMPER
C
C---------------------------------------------------------------------
C
      DIMENSION ITEXHO(*)
CCCCC DIMENSION ISTR(20) JAN 1987--PROBLEMS WITH \ AND LONG TITLES
      DIMENSION ISTR(200)
CCCCC DIMENSION IH(20)   JAN 1987--PROBLEMS WITH \ AND LONG TITLES
      DIMENSION IH(200)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IFUNC(*)
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'
      NUMCHN=0
C
      ILOC1=0
      ILOC2=0
      ILOC3=0
      I2=0
      IHNAP1='-999'
      IHNAP2='-999'
      IUS='-999'
C
      IF(IBUGD2.EQ.'ON')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPREPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)NUMTEC
   53   FORMAT('NUMTEC = ',I5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)(ITEXHO(I),I=1,MIN(100,NUMTEC))
   54   FORMAT('HOLLERITH ITEXHO(1) --',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************************************************
C               **  STEP 10--                                      **
C               **  LOOP THROUGH (AT MOST) 100 PASSES.  EACH PASS  **
C               **  SEARCHES FOR THE NEXT OCCURRANCE OF VALU().  A **
C               **  GIVEN PASS WIPES OUT VALU()XX AND REPLACES IT  **
C               **  WITH THE NUMERIC VALUE OF PARAMETER XX.  NOTE  **
C               **  THAT EACH PASS CHANGES THE CONTENTS OF INOUT   **
C               **  VARIABLE ITEXHO() AND INPUT VALUE NUMTEC.      **
C               *****************************************************
C
      IFOUNG='NO'
      DO1000IPASS=1,100
C
C               ****************************************************
C               **  STEP 11--                                     **
C               **  FOR THIS PASS,                                **
C               **  SEARCH THE STRING FOR THE NEXT OCCURRANCE OF  **
C               **  THE SUBSTRING VALU()                          **
C               **  PROCEED RIGHT TO LEFT (DEC. 1986).            **
C               **  IF FOUND, THEN PROCEED FURTHER.               **
C               **  IF NOT FOUND, THEN EXIT.                      **
C               ****************************************************
C
        IFOUNV='NO'
        IF(NUMTEC.LE.0)GOTO9000
C
        NUMTM5=NUMTEC-5
        IF(NUMTM5.GT.0)THEN
          DO1110IDUMMY=1,NUMTM5
            I=NUMTM5-IDUMMY+1
C
            IP1=I+1
            IP2=I+2
            IP3=I+3
            IP4=I+4
            IP5=I+5
C
            IF(ITEXHO(I).NE.'V'.AND.ITEXHO(I).NE.'v')GOTO1110
            IF(ITEXHO(IP1).NE.'A'.AND.ITEXHO(IP1).NE.'a')GOTO1110
            IF(ITEXHO(IP2).NE.'L'.AND.ITEXHO(IP2).NE.'l')GOTO1110
            IF(ITEXHO(IP3).NE.'U'.AND.ITEXHO(IP3).NE.'u')GOTO1110
            IF(ITEXHO(IP4).NE.'(')GOTO1110
            IF(ITEXHO(IP5).NE.')')GOTO1110
C
            IFOUNV='YES'
            IFOUNG='YES'
            ILOC1=I
            ILOC2=IP5
            GOTO1190
C
 1110     CONTINUE
        ENDIF
        GOTO9000
C
 1190   CONTINUE
C
C               ****************************************************
C               **  STEP 12--                                     **
C               **  EXTRACT THE PARAMETER OR FUNCTION NAME.  THIS **
C               **  WILL BE THE STRING IMMEDIATELY FOLLOWING ()   **
C               **  UNTIL A BLANK IS FOUND                        **
C               **  OR UNTIL A    "   IS FOUND (DEC. 1986)        **
C               **  OR UNTIL A    )   IS FOUND (DEC. 1988)        **
C               **  OR UNTIL A    &   IS FOUND (DEC. 1988)        **
C               ****************************************************
C
 1200   CONTINUE
        DO1210I=1,8
          ISTR(I)=' '
 1210   CONTINUE
C
        IAMPER='NO'
C
        IMIN=ILOC2+1
        IMAX=IMIN+7
        IF(IMAX.GT.NUMTEC)IMAX=NUMTEC
        J=0
C
C  JUNE 2003.  BASICALLY, A DATAPLOT NAME CONSISTS OF NUMBERS OR
C              ALPABETIC CHARACTERS OR UNDERSCORE.  ANYTHING ELSE
C              SHOULD TERMINATE THE NAME.
C
        DO1250I=IMIN,IMAX
          I2=I
          ITEMP=ICHAR(ITEXHO(I)(1:1))
          IF(ITEMP.LT.48 .OR. ITEMP.GT.122 .OR.
     1       (ITEMP.GT.57 .AND. ITEMP.LT.65) .OR.
     1       (ITEMP.GT.90 .AND. ITEMP.LT.97 .AND. ITEMP.NE.95)
     1       )THEN
             ILOC3=I2-1
             IF(ITEMP.EQ.38)IAMPER='YES'
             GOTO1290
          ENDIF
          J=J+1
          ISTR(J)=ITEXHO(I)
 1250   CONTINUE
        ILOC3=I2
C
 1290   CONTINUE
        NUMCHN=J
        IF(IBUGD2.EQ.'ON')THEN
          WRITE(ICOUT,1291)ILOC1,ILOC2,ILOC3,IMIN,IMAX,NUMCHN
 1291     FORMAT('ILOC1,ILOC2,ILOC3,IMIN,IMAX,NUMCHN = ',6I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
C               ****************************************************
C               **  STEP 13--                                     **
C               **  PACK THE PARAMETER/FUNCTION NAME STRING INTO  **
C               **  2 4-BYTE WORDS.                               **
C               ****************************************************
C
        IWORD1='    '
        IWORD2='    '
        NUMASC=4
        IMAX=2*NUMASC
        IF(NUMCHN.LE.0)GOTO1390
        IF(NUMCHN.LT.IMAX)IMAX=NUMCHN
C
        IF(IBUGD2.EQ.'ON')THEN
          WRITE(ICOUT,1301)IMAX
 1301     FORMAT('IMAX = ',I6)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        DO1300I=1,IMAX
          IF(ISTR(I).EQ.' ')GOTO1390
          J=I
          IF(I.GT.NUMASC)J=I-NUMASC
          ISTAR3=NUMBPC*(J-1)
          ISTAR3=IABS(ISTAR3)
          IF(I.LE.NUMASC)THEN
            CALL DPCHEX(0,NUMBPC,ISTR(I),ISTAR3,NUMBPC,IWORD1)
          ELSE
            CALL DPCHEX(0,NUMBPC,ISTR(I),ISTAR3,NUMBPC,IWORD2)
          ENDIF
 1300   CONTINUE
 1390   CONTINUE
        IHNAP1=IWORD1
        IHNAP2=IWORD2
        IHNAP3=IHNAP1
        IHNAP4=IHNAP2
C
        DO1395I=1,4
          IH1=IHNAP3(I:I)
          INH1=ICHAR(IH1)
          IF(97.LE.INH1.AND.INH1.LE.122)IH1=CHAR(INH1-32)
          IHNAP3(I:I)=IH1
          IH1=IHNAP4(I:I)
          INH1=ICHAR(IH1)
          IF(97.LE.INH1.AND.INH1.LE.122)IH1=CHAR(INH1-32)
          IHNAP4(I:I)=IH1
 1395   CONTINUE
C
C               ****************************************
C               **  STEP 15--                         **
C               **  DETERMINE IF THE NAME IS IN THE   **
C               **  INTERNAL DATAPLOT NAME LIST,      **
C               **  AND AS A PARAMETER OR FUNCTION.   **
C               ****************************************
C
        IF(NUMNAM.GE.1)THEN
          DO1500I=1,NUMNAM
            I2=I
            IF(IHNAP1.EQ.IHNAME(I).AND.IHNAP2.EQ.IHNAM2(I))GOTO1550
            IF(IHNAP3.EQ.IHNAME(I).AND.IHNAP4.EQ.IHNAM2(I))GOTO1550
 1500     CONTINUE
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1511)
 1511     FORMAT('***** ERROR IN DPREPL--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1512)
 1512     FORMAT('      THE EXTRACTED NAME FOR TEXT STRING WAS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1513)
 1513     FORMAT('      NOT FOUND IN INTERNAL NAME LIST.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1514)IHNAP1,IHNAP2
 1514     FORMAT('      EXTRACTED NAME = ',A4,A4)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
C
 1550     CONTINUE
          IVAL=IVALUE(I2)
          VAL=VALUE(I2)
          IUS=IUSE(I2)
          IL1=IVSTAR(I2)
          IL2=IVSTOP(I2)
C
          IF(IUS.NE.'P' .AND. IUS.NE.'F')THEN
            WRITE(ICOUT,1561)
 1561       FORMAT('***** ERROR IN DPREPL--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1562)
 1562       FORMAT('      THE EXTRACTED NAME FOR THE TEXT STRING WAS')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1563)
 1563       FORMAT('      FOUND IN THE INTERNAL NAME LIST, BUT NOT AS')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1564)
 1564       FORMAT('      A PARAMETER, A VARIABLE, OR A FUNCTION.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1566)IHNAP1,IHNAP2
 1566       FORMAT('      EXTRACTED NAME = ',A4,A4)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1567)IUS
 1567       FORMAT('      USE = ',A4)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
C
        ENDIF
C
C               ************************************************
C               **  STEP 16--                                 **
C               **  FOR THE CASE WHEN HAVE A PARAMETER NAME,  **
C               **  DETERMINE THE LITERAL STRING ASSOCIATED   **
C               **  WITH THE PARAMETER VALUE.                 **
C               ************************************************
C
        IF(IUS.EQ.'P')THEN
          CALL DPCONH(IVAL,VAL,IH,NH,IBUGD2,IERROR)
        ELSEIF(IUS.EQ.'F')THEN
          CALL DPCOFH(IL1,IL2,IFUNC,NUMCHF,IH,NH,IBUGD2,IERROR)
        ENDIF
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  COLLAPSE THE SUBSTRING VALU() FOLLOWED BY     **
C               **  THE PARAMETER/FUNCTION NAME TO A NULL STRING. **
C               ****************************************************
C
        ILOC1M=ILOC1-1
        ILOC3P=ILOC3+1
        J=ILOC1M
        IF(NUMTEC.GE.ILOC3P)THEN
          DO2100I=ILOC3P,NUMTEC
            J=J+1
            ITEXHO(J)=ITEXHO(I)
 2100     CONTINUE
        ENDIF
        NUMTE2=J
C
C               ****************************************************
C               **  STEP 22--                                     **
C               **  INSERT THE LITERAL VALUE                      **
C               **  AT THE PROPER PLACE IN THE COLLAPSED STRING.  **
C               ****************************************************
C
        J=ILOC1M
        IF(NUMTE2.GE.ILOC1)THEN
          DO2200I=ILOC1,NUMTE2
            IREV=NUMTE2-I+ILOC1
            IREVNH=IREV+NH
            ITEXHO(IREVNH)=ITEXHO(IREV)
 2200     CONTINUE
        ENDIF
C
        IF(NH.GE.1)THEN
          DO2300I=1,NH
            J=ILOC1M+I
            ITEXHO(J)=IH(I)
 2300     CONTINUE
        ENDIF
        NUMTE3=NUMTE2+NH
        NUMTEC=NUMTE3
C
C               ****************************************************
C               **  STEP 24--                                     **
C               **  IF THE TERMINATOR WAS &,                      **
C               **  THEN COLLAPSE & TO A NULL STRING.             **
C               **  (THUS & SERVES AS A USEFUL CONCATONATION      **
C               **  CHARACTER.                                    **
C               **  (DECEMBER 1988)                               **
C               ****************************************************
C
        IF(IAMPER.EQ.'YES')THEN
          ILOC4=ILOC1+NH
          ILOC4M=ILOC4-1
          ILOC4P=ILOC4+1
          J=ILOC4M
          IF(NUMTEC.GE.ILOC4P)THEN
            DO2420I=ILOC4P,NUMTEC
              J=J+1
              ITEXHO(J)=ITEXHO(I)
 2420     CONTINUE
            NUMTEC=J
          ENDIF
        ENDIF
C
 1000 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT      **
C               ****************
C
 9000 CONTINUE
C
      IF(IBUGD2.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPREPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NUMTEC
 9013   FORMAT('NUMTEC = ',I5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)(ITEXHO(I),I=1,MIN(100,NUMTEC))
 9014   FORMAT('HOLLERITH ITEXHO(1) --',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)ILOC1,ILOC2,ILOC3,NUMTEC,NUMTM5
 9015   FORMAT('ILOC1,ILOC2,ILOC3,NUMTEC,NUMTM5 = ',5I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)NUMCHN
 9016   FORMAT('NUMCHN = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9017)(ISTR(I),I=1,MIN(80,NUMCHN))
 9017   FORMAT('(ISTR(I),I=1,NUMCHN) = ',80A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9018)IWORD1,IWORD2,IHNAP1,IHNAP2
 9018   FORMAT('IWORD1,IWORD2,IHNAP1,IHNAP2 = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9022)IAMPER
 9022   FORMAT('IAMPER = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9023)ILOC4M,ILOC4,ILOC4P,NUMTEC
 9023   FORMAT('ILOC4M,ILOC4,ILOC4P,NUMTEC = ',4I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPREP2(ITEXHO,NUMTEC,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVARLB,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IMALEV,
     1IBUGD2,IERROR)
C
C     PURPOSE--TRANSLATE A STRING AS DICTATED BY THE   ^   OPERATOR.
C              THAT IS, REPLACE ALL OCCURRANCES OF  XXX^YYY
C              (WHERE XXX IS AN ARBITRARY STRING, AND
C              YYY IS A DATAPLOT PARAMETER NAME OR A FUNCTION NAME)
C              BY THE NUMERIC VALUE OF THE PARAMETER YYY, OR
C              THE FUNCTIONAL STRING IN THE FUNCTION YYY.
C              (E.G., IF PARAMETER K HAS THE VALUE 7,
C              THEN   Y^K   BECOMES   Y7
C              OR     IF THE FUNCTION K HAS THE CONTENTS XYZ,
C              THEN   Y^K   BECOMES   YABC  ).
C     NOTE--THIS SUBROUTINE CHANGES THE CONTENTS OF THE INPUT VECTOR ITEXHO()
C           AND THE INPUT VARIABLE NUMTEC.
C     NOTE--THIS SUBROUTINE IS SIMILAR TO (BUT NOT IDENTICAL TO) DPREPL.
C           SUBROUTINE DPREP2 TRANSLATES THE ^      OPERATOR.
C           SUBROUTINE DPREPL TRANSLATES THE VALU() OPERATOR.
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/1
C     ORIGINAL VERSION--DECEMBER  1986.
C     UPDATED         --DECEMBER  1986. STOP WITH "
C     UPDATED         --JUNE      1987.
C     UPDATED         --DECEMBER  1988. STOP WITH )
C     UPDATED         --DECEMBER  1988. STOP WITH & AND COLLAPSE
C     UPDATED         --OCTOBER   1991. SIMPLIFY A SECTION (ALAN)
C     UPDATED         --APRIL     1992. FIX ^ LOWER CASE CONVERSION
C     UPDATED         --APRIL     1992. FIX DEBUG STATMENT
C     UPDATED         --MAY       1992. ADD 8 DELIMITERS FOR ^
C     UPDATED         --JULY      1992. ADD . AND ^ AS DELIMITERS
C     UPDATED         --AUGUST    1992. NON-EXISTENT K: ^K ==> BLANK
C     UPDATED         --OCTOBER   1993. TOP WITH (
C     UPDATED         --JANUARY   2000. REPLACE VARIABLE NAME WITH
C                                       VARIABLE LABEL.
C     UPDATED         --AUGUST    2002. ADD "?" AS DELIMITER
C     UPDATED         --JUNE      2003. TREAT ANYTHING THAT IS NOT A
C                                       NUMBER OR LETTER AS DELIMITER
C     UPDATED         --FEBRUARY  2005. CASE OF "&"
C     UPDATED         --SEPTEMBER 2005. SUPPORT ARGUMENTS TO MACROS
C                                       ($1, $2, ETC.)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ITEXHO
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISTR
      CHARACTER*4 IH
      CHARACTER*4 IFOUNV
      CHARACTER*4 IFOUNG
      CHARACTER*4 IWORD1
      CHARACTER*4 IWORD2
      CHARACTER*4 IHNAP1
      CHARACTER*4 IHNAP2
      CHARACTER*4 IUS
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
C
      CHARACTER*40 IVARLB(*)
      CHARACTER*40 ILABT
      CHARACTER*40 ITTEMP
      CHARACTER*4 IFUNC
C
      CHARACTER*1 IREPCH
C
      CHARACTER*4 IJUNK1
      CHARACTER*4 IJUNK2
C
      CHARACTER*4 IAMPER
C
C-------------------------------------------------------------------
C
      DIMENSION ITEXHO(*)
      DIMENSION ISTR(200)
      DIMENSION IH(200)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IFUNC(*)
C
      INCLUDE 'DPCOSU.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'
      NUMCHN=0
C
      ILOC1=0
      ILOC2=0
      ILOC3=0
      I2=0
      IHNAP1='-999'
      IHNAP2='-999'
      IUS='-999'
C
      IF(IBUGD2.EQ.'ON')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPREP2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)NUMTEC
   53   FORMAT('NUMTEC = ',I5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)(ITEXHO(I),I=1,MIN(100,NUMTEC))
   54   FORMAT('HOLLERITH ITEXHO(1) --',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)IREPCH
   55   FORMAT('IREPCH = ',A1)
        CALL DPWRST('XXX','BUG ')
        IF(NUMCHF.GT.0)THEN
          DO58I=1,NUMCHF
            WRITE(ICOUT,59)I,IFUNC(I)
   59       FORMAT('I,IFUNC(I) = ',I8,A1)
            CALL DPWRST('XXX','BUG ')
   58     CONTINUE
        ENDIF
      ENDIF
C
C               ****************************************************
C               **  STEP 10--                                     **
C               **  LOOP THROUGH (AT MOST) 100 PASSES.  EACH PASS **
C               **  SEARCHES FOR THE NEXT OCCURRANCE OF ^.  A     **
C               **  GIVEN PASS WIPES OUT ^XX AND REPLACES IT WITH **
C               **  THE NUMERIC VALUE OF PARAMETER XX OR THE      **
C               **  STRING CONTENTS VALUE OF FUNCTION XX.  NOTE   **
C               **  THAT EACH PASS CHANGES THE CONTENTS OF INPUT  **
C               **  VARIABLE ITEXHO() AND INPUT VALUE NUMTEC.     **
C               ****************************************************
C
      IFOUNG='NO'
      DO1000IPASS=1,100
C
C               ****************************************************
C               **  STEP 11--                                     **
C               **  FOR THIS PASS,                                **
C               **  SEARCH THE STRING FOR THE NEXT OCCURRANCE OF  **
C               **  THE SUBSTRING IN IREPCH (USUALLY ^ )          **
C               **  PROCEED RIGHT TO LEFT (DEC. 1986).            **
C               **  IF FOUND, THEN PROCEED FURTHER.               **
C               **  IF NOT FOUND, THEN EXIT.                      **
C               ****************************************************
C
        IFOUNV='NO'
C
        IF(NUMTEC.GT.0)THEN
          DO1120IDUMMY=1,NUMTEC
            I=NUMTEC-IDUMMY+1
            IF(ITEXHO(I).EQ.IREPCH)THEN
              IFOUNV='YES'
              IFOUNG='YES'
              ILOC1=I
              ILOC2=I
              GOTO1190
            ENDIF
 1120     CONTINUE
          GOTO2500
        ELSE
          GOTO9000
        ENDIF
C
 1190   CONTINUE
C
C               *****************************************************
C               **  STEP 12--                                      **
C               **  EXTRACT THE PARAMETER OR FUNCTION NAME.        **
C               **  THIS WILL BE THE STRING IMMEDIATELY FOLLOWING  **
C               **  ^ UNTIL A BLANK IS FOUND                       **
C               **  OR UNTIL A    "   IS FOUND (DEC. 1986)         **
C               **  OR UNTIL A    )   IS FOUND (DEC. 1988)         **
C               **  OR UNTIL A    &   IS FOUND (DEC. 1988)         **
C               *****************************************************
C
 1200   CONTINUE
        DO1210I=1,8
          ISTR(I)=' '
 1210   CONTINUE
C
        IAMPER='NO'
C
        IMIN=ILOC2+1
        IMAX=IMIN+7
        IF(IMAX.GT.NUMTEC)IMAX=NUMTEC
        J=0
C
C  JUNE 2003.  BASICALLY, A DATAPLOT NAME CONSISTS OF NUMBERS OR
C              ALPABETIC CHARACTERS OR UDERSCORES.  ANYTHING ELSE
C              SHOULD TERMINATE THE NAME.
C
        DO1250I=IMIN,IMAX
          I2=I
          ITEMP=ICHAR(ITEXHO(I)(1:1))
C
          IF(IBUGD2.EQ.'ON')THEN
            WRITE(ICOUT,1251)I,IPASS,ITEXHO(I)
 1251       FORMAT('I,IPASS,ITEXHO(I) = ',2I8,1X,A4)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          IF(ITEMP.LT.48 .OR. ITEMP.GT.122 .OR.
     1       (ITEMP.GT.57 .AND. ITEMP.LT.65) .OR.
     1       (ITEMP.GT.90 .AND. ITEMP.LT.97 .AND. ITEMP.NE.95)
     1       )THEN
             ILOC3=I2-1
             IF(ITEMP.EQ.38)IAMPER='YES'
             GOTO1290
          ENDIF
          J=J+1
          ISTR(J)=ITEXHO(I)
 1250   CONTINUE
        ILOC3=I2
C
 1290   CONTINUE
        NUMCHN=J
        IF(IBUGD2.EQ.'ON')THEN
          WRITE(ICOUT,1291)ILOC1,ILOC2,ILOC3
 1291     FORMAT('ILOC1,ILOC2,ILOC3 = ',3I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1292)IMIN,IMAX,NUMCHN
 1292     FORMAT('IMIN,IMAX,NUMCHN = ',3I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
C               ****************************************************
C               **  STEP 13--                                     **
C               **  PACK THE PARAMETER/FUNCTION NAME STRING INTO  **
C               **  2 4-BYTE WORDS.                               **
C               ****************************************************
C
        IWORD1='    '
        IWORD2='    '
        DO1310I=1,4
          IWORD1(I:I)=ISTR(I)(1:1)
          IWORD2(I:I)=ISTR(I+4)(1:1)
1310    CONTINUE
        IF(IBUGD2.EQ.'ON')THEN
          WRITE(ICOUT,1302)IWORD1,IWORD2
1302      FORMAT('IWORD1,IWORD2=',A4,A4)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IHNAP1=IWORD1
        IHNAP2=IWORD2
C
C               ****************************************************
C               **  STEP 14--                                     **
C               **  CONVERT THE 2 4-BYTE WORDS INTO UPPER CASE.   **
C               **  (JUNE 1987)                                   **
C               ****************************************************
C
        IJUNK1=IHNAP1
        IJUNK2=IHNAP2
        CALL DPUPP4(IJUNK1,IJUNK1,IBUGD2,IERROR)
        CALL DPUPP4(IJUNK2,IJUNK2,IBUGD2,IERROR)
        IHNAP1=IJUNK1
        IHNAP2=IJUNK2
C
C               ****************************************
C               **  STEP 15--                         **
C               **  DETERMINE IF THE NAME IS IN THE   **
C               **  INTERNAL DATAPLOT NAME LIST,      **
C               **  AND AS A PARAMETER OR FUNCTION.   **
C               ****************************************
C
        IF(NUMNAM.GT.0)THEN
          DO1500I=1,NUMNAM
            I2=I
            IF(IHNAP1.EQ.IHNAME(I).AND.IHNAP2.EQ.IHNAM2(I))GOTO1550
 1500     CONTINUE
C
          NH=1
          IH(1)='    '
          GOTO2100
C
 1550     CONTINUE
          IVAL=IVALUE(I2)
          VAL=VALUE(I2)
          IUS=IUSE(I2)
          IL1=IVSTAR(I2)
          IL2=IVSTOP(I2)
C
          IF(IBUGD2.EQ.'ON')THEN
            WRITE(ICOUT,1551)IPASS,IL1,IL2
 1551       FORMAT('IPASS,IL1,IL2 = ',3I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1553)IVAL,VAL
 1553       FORMAT('IVAL,VAL = ',I8,G15.7)
            CALL DPWRST('XXX','BUG ')
            IF(IUS.EQ.'F')THEN
              ITEMP=IL2-IL1+1
              IF(ITEMP.GT.100)THEN
                ITEMP=IL1+99
              ELSE
                ITEMP=IL2
              ENDIF
              WRITE(ICOUT,1555)(IFUNC(KKK),KKK=IL1,ITEMP)
 1555         FORMAT('IFUNC(IL1:IL2) = ',100A1)
              CALL DPWRST('XXX','BUG ')
            ENDIF
          ENDIF
          ILABT=' '
          IF(IVAL.GT.0.AND.IUS.EQ.'V')ILABT(1:40)=IVARLB(IVAL)(1:40)
C
          IF(IUS.NE.'P' .AND. IUS.NE.'F' .AND. IUS.NE.'V')THEN
            WRITE(ICOUT,1561)
 1561       FORMAT('***** ERROR IN DPREP2--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1562)
 1562       FORMAT('      THE EXTRACTED NAME FOR THE TEXT STRING')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1563)
 1563       FORMAT('      WAS FOUND IN INTERNAL NAME LIST, BUT NOT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1564)
 1564       FORMAT('      AS A PARAMETER, A VARIABLE, OR A FUNCTION.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1566)IHNAP1,IHNAP2
 1566       FORMAT('      EXTRACTED NAME = ',A4,A4)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1567)IUS
 1567       FORMAT('      USE = ',A4)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
C
        ENDIF
C
C               ************************************************
C               **  STEP 16--                                 **
C               **  FOR THE CASE WHEN HAVE A PARAMETER NAME,  **
C               **  DETERMINE THE LITERAL STRING ASSOCIATED   **
C               **  WITH THE PARAMETER VALUE.                 **
C               ************************************************
C
        IF(IUS.EQ.'P')THEN
          CALL DPCONH(IVAL,VAL,IH,NH,IBUGD2,IERROR)
        ELSEIF(IUS.EQ.'F')THEN
          CALL DPCOFH(IL1,IL2,IFUNC,NUMCHF,IH,NH,IBUGD2,IERROR)
        ELSEIF(IUS.EQ.'V')THEN
          NH=52
          DO1610I=52,1,-1
            IF(ILABT(I:I).NE.' ')THEN
              NH=I
              GOTO1619
            ENDIF
 1610     CONTINUE
          NH=0
 1619     CONTINUE
          IF(NH.EQ.0)THEN
            DO1620I=1,4
              IH(I)=' '
              IH(I+4)=' '
              IH(I)(1:1)=IHNAP1(I:I)
              IH(I+4)(1:1)=IHNAP2(I:I)
 1620       CONTINUE
            NH=8
            DO1625I=8,1,-1
              IF(IH(I).NE.' ')THEN
                NH=I
                GOTO1629
              ENDIF
 1625       CONTINUE
 1629       CONTINUE
          ELSE
            DO1630I=1,NH
              IH(I)=' '
              IH(I)(1:1)=ILABT(I:I)
 1630       CONTINUE
          ENDIF
        ENDIF
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  COLLAPSE THE SUBSTRING ^ FOLLOWED BY          **
C               **  THE PARAMETER/FUNCTION NAME TO A NULL STRING. **
C               ****************************************************
C
 2100   CONTINUE
        ILOC1M=ILOC1-1
        ILOC3P=ILOC3+1
        J=ILOC1M
        IF(NUMTEC.GE.ILOC3P)THEN
          DO2110I=ILOC3P,NUMTEC
            J=J+1
            ITEXHO(J)=ITEXHO(I)
 2110     CONTINUE
        ENDIF
        NUMTE2=J
C
C               ****************************************************
C               **  STEP 22--                                     **
C               **  INSERT THE LITERAL VALUE                      **
C               **  AT THE PROPER PLACE IN THE COLLAPSED STRING.  **
C               ****************************************************
C
        J=ILOC1M
        IF(NUMTE2.GE.ILOC1)THEN
          DO2200I=ILOC1,NUMTE2
            IREV=NUMTE2-I+ILOC1
            IREVNH=IREV+NH
            ITEXHO(IREVNH)=ITEXHO(IREV)
 2200     CONTINUE
        ENDIF
C
        IF(NH.GE.1)THEN
          DO2300I=1,NH
            J=ILOC1M+I
            ITEXHO(J)=IH(I)
 2300     CONTINUE
        ENDIF
        NUMTE3=NUMTE2+NH
        NUMTEC=NUMTE3
C
C               ****************************************************
C               **  STEP 24--                                     **
C               **  IF THE TERMINATOR WAS &,                      **
C               **  THEN COLLAPSE & TO A NULL STRING.             **
C               **  (THUS & SERVES AS A USEFUL CONCATONATION      **
C               **  CHARACTER.                                    **
C               **  (DECEMBER 1988)                               **
C               ****************************************************
C
        IF(IAMPER.EQ.'YES')THEN
          ILOC4=ILOC1+NH
          ILOC4M=ILOC4-1
          ILOC4P=ILOC4+1
          J=ILOC4M
          IF(NUMTEC.GE.ILOC4P)THEN
            DO2420I=ILOC4P,NUMTEC
              J=J+1
              ITEXHO(J)=ITEXHO(I)
 2420       CONTINUE
            NUMTEC=J
          ENDIF
        ENDIF
C
 1000 CONTINUE
C
C
C               ****************************************************
C               **  STEP 25--                                     **
C               **  NOW CHECK FOR ANY MACRO SUBSTITUTION          **
C               **  CHARACTERS.  THESE ARE IDENTIFIED BY A        **
C               **  $1, $2, ..., $10.  NOTE THAT $0 IS USED TO    **
C               **  DENOTE THE NUMBER OF MACRO ARGUMENTS.         **
C               **  (SEPTEMBER  2005)                             **
C               ****************************************************
C
 2500 CONTINUE
      IF(NUMTEC.GT.0 .AND. IMALEV.GE.1)THEN
        DO2510I=1,NUMTEC-1
          IF(ITEXHO(I).EQ.IMACSC)THEN
            IP1=I+1
            IP2=I+2
            IP3=I+3
            IF(ITEXHO(IP1).EQ.'1' .AND. ITEXHO(IP2).EQ.'0')THEN
              DO2610II=40,1,-1
                IF(IMACAR(1)(II:II).NE.' ')THEN
                  NCH=II
                  DO2613JJ=1,NCH
                    ITTEMP(JJ:JJ)=IMACAR(1)(JJ:JJ)
 2613             CONTINUE
                  GOTO2619
                ENDIF
 2610         CONTINUE
 2619         CONTINUE
              ILOC1=I
              ILOC2=IP2+1
              GOTO2519
            ELSEIF(ITEXHO(IP1).EQ.'0')THEN
              IF(NMACAG.LE.9)THEN
                WRITE(ITTEMP(1:1),'(I1)')NMACAG
                NCH=1
              ELSEIF(NMACAG.LE.99)THEN
                WRITE(ITTEMP(1:2),'(I2)')NMACAG
                NCH=2
              ELSE
                GOTO2510
              ENDIF
              ILOC1=I
              ILOC2=IP1+1
              GOTO2519
            ELSEIF(ITEXHO(IP1).EQ.'1' .OR. ITEXHO(IP1).EQ.'2' .OR.
     1             ITEXHO(IP1).EQ.'3' .OR. ITEXHO(IP1).EQ.'4' .OR.
     1             ITEXHO(IP1).EQ.'4' .OR. ITEXHO(IP1).EQ.'5' .OR.
     1             ITEXHO(IP1).EQ.'6' .OR. ITEXHO(IP1).EQ.'7' .OR.
     1             ITEXHO(IP1).EQ.'8' .OR. ITEXHO(IP1).EQ.'9')THEN
              IF(ITEXHO(IP1).EQ.'1')IITEMP=1
              IF(ITEXHO(IP1).EQ.'2')IITEMP=2
              IF(ITEXHO(IP1).EQ.'3')IITEMP=3
              IF(ITEXHO(IP1).EQ.'4')IITEMP=4
              IF(ITEXHO(IP1).EQ.'5')IITEMP=5
              IF(ITEXHO(IP1).EQ.'6')IITEMP=6
              IF(ITEXHO(IP1).EQ.'7')IITEMP=7
              IF(ITEXHO(IP1).EQ.'8')IITEMP=8
              IF(ITEXHO(IP1).EQ.'9')IITEMP=9
              DO2630II=40,1,-1
                IF(IMACAR(IITEMP)(II:II).NE.' ')THEN
                  NCH=II
                  DO2633JJ=1,NCH
                    ITTEMP(JJ:JJ)=IMACAR(IITEMP)(JJ:JJ)
 2633             CONTINUE
                  GOTO2639
                ENDIF
 2630         CONTINUE
 2639         CONTINUE
              ILOC1=I
              ILOC2=IP1+1
              GOTO2519
            ELSE
              GOTO2510
            ENDIF
          ENDIF
          GOTO2510
C
 2519     CONTINUE
          NUMTE2=0
          DO2720KK=1,ILOC1-1
            NUMTE2=NUMTE2+1
            ISTR(KK)=ITEXHO(KK)
 2720     CONTINUE
          DO2730KK=1,NCH
            NUMTE2=NUMTE2+1
            ISTR(NUMTE2)=ITTEMP(KK:KK)
 2730     CONTINUE
          DO2740KK=ILOC2,NUMTEC
            NUMTE2=NUMTE2+1
            ISTR(NUMTE2)=ITEXHO(KK)
 2740     CONTINUE
          NUMTEC=NUMTE2
          DO2750KK=1,NUMTEC
            ITEXHO(KK)=ISTR(KK)
 2750     CONTINUE
C
 2510   CONTINUE
      ENDIF
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT      **
C               ****************
C
 9000 CONTINUE
C
      IF(IBUGD2.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPREP2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NUMTEC
 9013   FORMAT('NUMTEC = ',I5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)(ITEXHO(I),I=1,MIN(100,NUMTEC))
 9014   FORMAT('HOLLERITH ITEXHO(1) --',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)ILOC1,ILOC2,ILOC3,NUMTEC
 9015   FORMAT('ILOC1,ILOC2,ILOC3,NUMTEC = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)NUMCHN
 9016   FORMAT('NUMCHN = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9017)(ISTR(I),I=1,MIN(80,NUMCHN))
 9017   FORMAT('(ISTR(I),I=1,NUMCHN) = ',80A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9018)IWORD1,IWORD2,IHNAP1,IHNAP2
 9018   FORMAT('IWORD1,IWORD2,IHNAP1,IHNAP2 = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9021)IREPCH
 9021   FORMAT('IREPCH = ',A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9022)IAMPER
 9022   FORMAT('IAMPER = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9023)ILOC4M,ILOC4,ILOC4P,NUMTEC
 9023   FORMAT('ILOC4M,ILOC4,ILOC4P,NUMTEC = ',4I8)
        CALL DPWRST('XXX','BUG ')
        IF(NUMCHF.GT.0)THEN
          DO9028I=1,NUMCHF
            WRITE(ICOUT,9029)I,IFUNC(I)
 9029       FORMAT('I,IFUNC(I) = ',I8,A1)
            CALL DPWRST('XXX','BUG ')
 9028     CONTINUE
        ENDIF
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPREPS(Y,X1,X2,X3,X4,X5,N,NUMVAR,DUM1,DUM2,
     1IREP,REPSS,REPMS,REPSD,REPDF,NUMSET,IBUGA3,IERROR)
C
C     PURPOSE--DETERMINE IF REPLICATION EXISTS AND
C              (IF EXISTENT) COMPUTE THE REPLIATION STANDARD DEVIATION
C              AND REPLICATION DEGREES OF FREEDOM.
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1992.  FIX FORMAT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IREP
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
      DIMENSION X3(*)
      DIMENSION X4(*)
      DIMENSION X5(*)
      DIMENSION DUM1(*)
      DIMENSION DUM2(*)
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='DPRE'
      ISUBN2='PS  '
C
      IERROR='NO'
C
      IREP='NO'
      REPSS=0.0
      REPMS=0.0
      REPSD=0.0
      REPDF=0.0
      NUMSET=0
C
C               **************************************************************
C               **  CHECK FOR REPLICATION AND IF EXISTENT                   **
C               **  COMPUTE A (MODEL-FREE) REPLICATION STANDARD DEVIATION.  **
C               **************************************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPREPS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NUMVAR
   52 FORMAT('N,NUMVAR = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA3
   53 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS FIXED    MARCH 1992
CCCCC WRITE(ICOUT,54)Y(1),X1(1),X2(1),X3(1),X4(I),X5(1)
CCCCC CALL DPWRST('XXX','BUG ')
      IF(NUMVAR.EQ.1)WRITE(ICOUT,54)Y(1),X1(1)
      IF(NUMVAR.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(NUMVAR.EQ.2)WRITE(ICOUT,54)Y(1),X1(1),X2(1)
      IF(NUMVAR.EQ.2)CALL DPWRST('XXX','BUG ')
      IF(NUMVAR.EQ.3)WRITE(ICOUT,54)Y(1),X1(1),X2(1),X3(1)
      IF(NUMVAR.EQ.3)CALL DPWRST('XXX','BUG ')
      IF(NUMVAR.EQ.4)WRITE(ICOUT,54)Y(1),X1(1),X2(1),X3(1),X4(1)
      IF(NUMVAR.EQ.4)CALL DPWRST('XXX','BUG ')
      IF(NUMVAR.EQ.5)WRITE(ICOUT,54)Y(1),X1(1),X2(1),X3(1),X4(1),X5(1)
   54 FORMAT('Y(1),X1(1),X2(1),X3(1),X4(I),X5(1) = ',6E13.5)
      IF(NUMVAR.EQ.5)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)DUM1(1),DUM2(1)
   55 FORMAT('DUM1(1),DUM2(1) = ',2E13.5)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  DETERMINE THE NUMBER OF DISTINCT SUBSETS          **
C               **  FOR VARIABLE 1;                                   **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS             **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE           **
C               **  WITHOUT FURTHER CHECKING OF THE OTHER VARIABLES.  **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMSET=0
      DO4200I=1,N
      IF(NUMSET.EQ.0)GOTO4350
      DO4300J=1,NUMSET
      IF(X1(I).EQ.DUM1(J))GOTO4200
 4300 CONTINUE
 4350 NUMSET=NUMSET+1
      DUM1(NUMSET)=X1(I)
 4200 CONTINUE
      IF(NUMSET.EQ.0)WRITE(ICOUT,4205)
 4205 FORMAT('ERROR IN DPREPS   SUBROUTINE--NUMSET = 0')
      IF(NUMSET.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.0)IERROR='YES'
      IF(NUMSET.EQ.0)GOTO9000
      IF(NUMSET.EQ.N)GOTO4211
      GOTO4219
 4211 CONTINUE
      GOTO9000
 4219 CONTINUE
C
C               ****************************************************************
C               **  STEP 2--                                                  **
C               **  FOR THE CASE WHEN HAVE SOME REPLICATION FOR X1,           **
C               **  AND WHEN THE NUMBER OF VARIABLES IS 1,                    **
C               **  COPY OUT THE Y'S FOR EACH X1 SUBSET INTO THE DUM2 VECTOR  **
C               **  AND ANALYZE IT THEREIN.                                   **
C               ****************************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.GE.2)GOTO4400
      IREP='YES'
      IREPDF=0
      REPSS=0.0
C
      DO4600ISET=1,NUMSET
      NI=0
      DO4700I=1,N
      IF(X1(I).EQ.DUM1(ISET))NI=NI+1
      IF(X1(I).EQ.DUM1(ISET))DUM2(NI)=Y(I)
 4700 CONTINUE
      ANI=NI
      SUM=0.0
      DO5100I=1,NI
      SUM=SUM+DUM2(I)
 5100 CONTINUE
      YMEAN=SUM/ANI
      SUM=0.0
      DO5200I=1,NI
      SUM=SUM+(DUM2(I)-YMEAN)**2
 5200 CONTINUE
      IREPDF=IREPDF+NI-1
      REPSS=REPSS+SUM
 4600 CONTINUE
C
      GOTO4800
 4400 CONTINUE
C
C               ********************************************************
C               **  STEP 3--                                          **
C               **  FOR THE CASE WHEN HAVE SOME REPLICATION FOR X1    **
C               **  AND THE NUMBER OF VARIABLES IS 2 OR MORE,         **
C               **  CARRY OUT A DETAILED EXAMINATION FOR REPLICATION  **
C               **  AND ANALYZE APPROPRIATELY.                        **
C               ********************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREP='YES'
      IREPDF=0
      REPSS=0.0
C
      DO4405I=1,N
      DUM1(I)=-1.0
 4405 CONTINUE
C
      NUMSET=0
      DO4410I=1,N
      IF(DUM1(I).GT.0.0)GOTO4410
      NI=0
      DO4420J=I,N
      IF(X1(J).NE.X1(I))GOTO4420
      IF(NUMVAR.LE.1)GOTO4415
      IF(X2(J).NE.X2(I))GOTO4420
      IF(NUMVAR.LE.2)GOTO4415
      IF(X3(J).NE.X3(I))GOTO4420
      IF(NUMVAR.LE.3)GOTO4415
      IF(X4(J).NE.X4(I))GOTO4420
      IF(NUMVAR.LE.4)GOTO4415
      IF(X5(J).NE.X5(I))GOTO4420
 4415 CONTINUE
      NI=NI+1
      DUM1(J)=1.0
      DUM2(NI)=Y(J)
 4420 CONTINUE
      NUMSET=NUMSET+1
      IF(NI.LE.1)GOTO4410
      ANI=NI
      SUM=0.0
      DO4450L=1,NI
      SUM=SUM+DUM2(L)
 4450 CONTINUE
      YMEAN=SUM/ANI
      SUM=0.0
      DO4460L=1,NI
      SUM=SUM+(DUM2(L)-YMEAN)**2
 4460 CONTINUE
      IREPDF=IREPDF+NI-1
      REPSS=REPSS+SUM
 4410 CONTINUE
C
 4800 CONTINUE
      IF(IREPDF.LE.0)IREP='NO'
      IF(IREPDF.LE.0)GOTO9000
      REPDF=IREPDF
      REPMS=REPSS/REPDF
      IF(REPMS.GT.0.0)REPSD=SQRT(REPMS)
      IF(REPMS.LE.0.0)REPSD=0.0
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 DPREPS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGA3
 9013 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IREP,REPSD,REPDF,NUMSET
 9014 FORMAT('IREP,REPSD,REPDF,NUMSET = ',A4,E15.7,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRES2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A RESISITOR
C              WITH ONE END AT (X1,Y1)
C              AND THE OTHER END AT (X2,Y2).
C     NOTE--THE HEIGHT OF EACH RIPPLE IS PTEXHE.
C           THE WIDTH  OF EACH RIPPLE IS PTEXWI.
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
CCCCC CHARACTER*4 ICOLF
CCCCC CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(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.'RES2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRES2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE RESISTOR           **
C               *********************************
C
      AJY2=0
C
      DELX=X2-X1
      DELY=Y2-Y1
      ALEN=0.0
      TERM=(X2-X1)**2+(Y2-Y1)**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      AJXMIN=PTEXWI
      AJXDEL=PTEXWI
      AJYDEL=PTEXHE
      AJXMAX=ALEN-AJXDEL
C
      XMIN=AJXMIN
      XDEL=AJXDEL
      YDEL=AJYDEL
      XMAX=AJXMAX
C
      K=0
C
      X=0
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=XMIN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      L=0
CCCCC DO1450JX=AJXMIN,AJXMAX,AJXDEL
      AJX=AJXMIN-AJXDEL
 1440 CONTINUE
      AJX=AJX+AJXDEL
      IF(AJX.GT.AJXMAX)GOTO1460
C
      L=L+1
      L01=L-2*(L/2)
C
      AJX1=AJX
      AJX2=AJX+AJXDEL/2.0
      AJX3=AJX+AJXDEL
      AJY1=0.0
      IF(L01.EQ.0)AJY2=AJYDEL/2.0
      IF(L01.EQ.1)AJY2=-AJYDEL/2.0
      AJY3=0
C
      X=AJX1
      Y=AJY1
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=AJX2
      Y=AJY2
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=AJX3
      Y=AJY3
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
 1450 CONTINUE
      GOTO1440
C
 1460 CONTINUE
      X=ALEN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
CCCCC IF(IREFSW(1).EQ.'OFF')GOTO2190
CCCCC IPATT=IREPTY(1)
CCCCC PTHICK=PREPTH(1)
CCCCC PXGAP=PREPSP(1)
CCCCC PYGAP=PREPSP(1)
CCCCC ICOLF=IREFCO(1)
CCCCC ICOLP=IREPCO(1)
CCCCC CALL DPFIRE(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP)
C2190 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.'RES2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRES2--')
      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 DPRES1(IHARG,IARGT,IARG,NUMARG,IDEFSR,
     1IRECSR,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE RECIPE SIMCOV REPLICATES
C              IN THE FLOATING POINT VARIABLE IRECSR.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (A  INTEGER POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFSR (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--IRECSR  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SIMC'.AND.IHARG(2).EQ.'REPL')
     1GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'=')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'REPL')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'REPL')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 DPRES1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR RECIPE SIMCOV REPLICATES ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      AN EXAMPLE OF THIS COMMAND IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      RECIPE SIMCOV REPLICATES 100000 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      IHOLD=IDEFSR
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IF(IHOLD.LE.1000)IHOLD=1000
      IRECSR=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IRECSR
 1181 FORMAT('THE NUMBER OF REPLICATIONS FOR THE SIMCOV ',
     1'COMMAND HAS JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPRESZ(IHARG,IARGT,IARG,NUMARG,IDEFSR,
     1IRECSR,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE RECIPE SIMPVT REPLICATES
C              IN THE FLOATING POINT VARIABLE IRECSR.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (A  INTEGER POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFSR (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--IRECSR  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SIMP'.AND.IHARG(2).EQ.'REPL')
     1GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'=')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIMC')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'REPL')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'REPL')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 DPRESZ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR RECIPE SIMPVT REPLICATES ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      AN EXAMPLE OF THIS COMMAND IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      RECIPE SIMPVT REPLICATES 100000 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      IHOLD=IDEFSR
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IF(IHOLD.LE.1000)IHOLD=1000
      IRECSR=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IRECSR
 1181 FORMAT('THE NUMBER OF REPLICATIONS FOR THE SIMPVT ',
     1'COMMAND HAS JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPRESA(IHARG,NUMARG,IDEFSA,IRECSA,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY WHETHER THE RECIPE COMMAND USES 
C              SATTERTHWAITE APPROXIMATION TO OBTAIN CRITICAL 
C              VALUES OR NOT.
C
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFSA (A  CHARACTER VARIABLE)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--IRECSA (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFSA
      CHARACTER*4 IRECSA
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRESA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFSA
   53 FORMAT('IDEFSA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)THEN
        IHOLD=IDEFSA
      ELSEIF(NUMARG.EQ.2)THEN
        IF(IHARG(1).EQ.'SATT'.AND.IHARG(2).EQ.'APPR')THEN
          IHOLD=IDEFSA
        ELSE
          IHOLD=IDEFSA
          IF(IHARG(2).EQ.'OFF')IHOLD='OFF'
          IF(IHARG(2).EQ.'NO')IHOLD='OFF'
          IF(IHARG(2).EQ.'NONE')IHOLD='OFF'
          IF(IHARG(2).EQ.'FALS')IHOLD='OFF'
          IF(IHARG(2).EQ.'ON')IHOLD='ON'
          IF(IHARG(2).EQ.'YES')IHOLD='ON'
          IF(IHARG(2).EQ.'TRUE')IHOLD='ON'
          IF(IHARG(2).EQ.'DEFA')IHOLD=IDEFSA
        ENDIF
      ELSEIF(NUMARG.EQ.3)THEN
          IHOLD=IDEFSA
          IF(IHARG(3).EQ.'OFF')IHOLD='OFF'
          IF(IHARG(3).EQ.'NO')IHOLD='OFF'
          IF(IHARG(3).EQ.'NONE')IHOLD='OFF'
          IF(IHARG(3).EQ.'FALS')IHOLD='OFF'
          IF(IHARG(3).EQ.'ON')IHOLD='ON'
          IF(IHARG(3).EQ.'YES')IHOLD='ON'
          IF(IHARG(3).EQ.'TRUE')IHOLD='ON'
          IF(IHARG(3).EQ.'DEFA')IHOLD=IDEFSA
      ELSE
        GOTO9000
      ENDIF
C
      IFOUND='YES'
      IRECSA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IRECSA
 1181 FORMAT(
     1'THE RECIPE SATTERTHWAITE APPROXIMATION HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1189 CONTINUE
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRESA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDEFSA
 9013 FORMAT('IDEFSA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IRECSA
 9014 FORMAT('IRECSA = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRESE(IFOUND,IERROR)
C
C     PURPOSE--RESET ALL INTERNAL DATAPLOT SETTINGS
C              (INCLUDING DATA) AS IF ONE HAD SIGNED OFF
C              DATAPLOT AND LOGGED BACK ON.
C     INPUT  ARGUMENTS--NONE
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO')
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND 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           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     UPDATED         --DECEMBER  1988. (REWRITE) RESET DATA, IO, PC, SU
C     UPDATED         --JANUARY   1992. RESET GRAPHICS=RESET PLOT
C     UPDATED         --JANUARY   1992. RESET I/O=RESET IO
C     UPDATED         --AUGUST    1992. SET PRED & RES TO 10000 OBS
C     UPDATED                            (NOT WORKING)
C     UPDATED         --SEPTEMBER 1993. FIX MAJOR SUBTLE BUG IN FIT
C                            CAUSED BE REDEFINITION HEREIN
C                            OF MAXCOL (AND THUS ICOLPR IN DPFIT)
C                            NEVER CHANGE MAX...<ANYTHING>
C                            COMMENT OUT ALL SUCH CHANGES.
C     UPDATED         --SEPTEMBER 1993. RESET CLSB
C     UPDATED         --SEPTEMBER 1993. RESET LIMITS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ITEMEC
      CHARACTER*4 ITEMFE
      CHARACTER*4 ITEMPR
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
CCCCC CHARACTER*4 IDEFGC
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCODB.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOSO.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOTR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODG.INC'
      INCLUDE 'DPCOCO.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
      IFOUND='NO'
      IERROR='NO'
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 DPRESE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,IFOUND,IERROR
   52 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO57
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   57 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **  TREAT THE RESET CASE                        **
C               **************************************************
C
      IFOUND='YES'
C
C               **************************************************
C               **  BRANCH TO THE APPROPRIATE CASE              **
C               **************************************************
C
      IF(NUMARG.LE.0)GOTO5100
      DO1000I=1,NUMARG
C
      IF(IHARG(I).EQ.'DATA')GOTO1100
      IF(IHARG(I).EQ.'DA')GOTO1100
      IF(IHARG(I).EQ.'VARI')GOTO1200
      IF(IHARG(I).EQ.'VA')GOTO1200
      IF(IHARG(I).EQ.'PARA')GOTO1300
      IF(IHARG(I).EQ.'PA')GOTO1300
      IF(IHARG(I).EQ.'FUNC')GOTO1400
      IF(IHARG(I).EQ.'FU')GOTO1400
      IF(IHARG(I).EQ.'INPU')GOTO2100
      IF(IHARG(I).EQ.'IO')GOTO2100
CCCCC THE FOLLOWING LINE WAS ADDED JANUARY 1992
      IF(IHARG(I).EQ.'I/O')GOTO2100
      IF(IHARG(I).EQ.'PLOT')GOTO2200
      IF(IHARG(I).EQ.'GRAP')GOTO2200
CCCCC THE FOLLOWING LINE WAS ADDED JANUARY 1992
      IF(IHARG(I).EQ.'PC')GOTO2200
      IF(IHARG(I).EQ.'CLSB')GOTO2300
      IF(IHARG(I).EQ.'LCSB')GOTO2300
      IF(IHARG(I).EQ.'LIMI')GOTO2400
      IF(IHARG(I).EQ.'SUPP')GOTO3100
      IF(IHARG(I).EQ.'SU')GOTO3100
      IF(IHARG(I).EQ.'ALL')GOTO5100
      GOTO1000
C
C               **************************************************
C               **  STEP 11--                                   **
C               **  RESET DATA (VARIABLES, PARAM, FUNC)         **
C               **************************************************
C
 1100 CONTINUE
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXNK=MAXOBW
      NK=0
      IDEMXN=MAXOBV
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXN=IDEMXN
      N=0
      IDEMXC=MAXOBW/MAXOBV
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT         SEPTEMBER 1993
CCCCC (CAUSED BIG SUBTLE PROBLEMS ELSEWHERE (E.G., FIT)) SEPT. 1993
CCCCC MAXCOL=IDEMXC
      NUMCOL=0
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXCHF=1000
      NUMCHF=0
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXFUN=100
      NUMFUN=0
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXCHM=200
      NUMCHM=0
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXCON=100
      NUMCON=0
C
      DO1110J=1,NUMNAM
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
CCCCC IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.'    ')IN(J)=1
      IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.'    ')GOTO1110
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
CCCCC IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.'    ')IN(J)=1
      IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.'    ')GOTO1110
      IF(IHNAME(J).EQ.'YPLO'.AND.IHNAM2(J).EQ.'T   ')GOTO1110
      IF(IHNAME(J).EQ.'XPLO'.AND.IHNAM2(J).EQ.'T   ')GOTO1110
      IF(IHNAME(J).EQ.'X2PL'.AND.IHNAM2(J).EQ.'OT  ')GOTO1110
      IF(IHNAME(J).EQ.'TAGP'.AND.IHNAM2(J).EQ.'LOT ')GOTO1110
      IF(IHNAME(J).EQ.'INFI'.AND.IHNAM2(J).EQ.'NITY')GOTO1110
      IF(IHNAME(J).EQ.'PI  '.AND.IHNAM2(J).EQ.'    ')GOTO1110
      IF(IUSE(J).EQ.'V')IN(J)=(-1)
      IF(IUSE(J).EQ.'P')IN(J)=(-1)
      IF(IUSE(J).EQ.'F')IN(J)=(-1)
      IF(IUSE(J).EQ.'M')IN(J)=(-1)
 1110 CONTINUE
      CALL DPUPNT(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN,
     1IVSTAR,IVSTOP,MAXNAM,NUMNAM,V,MAXN,MAXCOL,NUMCOL,
     1IBUGS2,IERROR)
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('ALL USER DATA (VARIABLES, PARAMETERS, FUNCTIONS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('AND MATRICES) HAVE JUST BEEN DELETED.')
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1000
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  RESET VARIABLES                             **
C               **************************************************
C
 1200 CONTINUE
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXNK=MAXOBW
      NK=0
      IDEMXN=MAXOBV
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXN=IDEMXN
      N=0
      IDEMXC=MAXOBW/MAXOBV
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC (CAUSED BIG SUBTLE PROBLEMS ELSEWHERE (E.G., FIT)) SEPT. 1993
CCCCC MAXCOL=IDEMXC
      NUMCOL=0
C
      DO1210J=1,NUMNAM
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
CCCCC IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.'    ')IN(J)=1
      IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.'    ')GOTO1210
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
CCCCC IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.'    ')IN(J)=1
      IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.'    ')GOTO1210
      IF(IHNAME(J).EQ.'YPLO'.AND.IHNAM2(J).EQ.'T   ')GOTO1210
      IF(IHNAME(J).EQ.'XPLO'.AND.IHNAM2(J).EQ.'T   ')GOTO1210
      IF(IHNAME(J).EQ.'X2PL'.AND.IHNAM2(J).EQ.'OT  ')GOTO1210
      IF(IHNAME(J).EQ.'TAGP'.AND.IHNAM2(J).EQ.'LOT ')GOTO1210
      IF(IUSE(J).EQ.'V')IN(J)=(-1)
 1210 CONTINUE
      CALL DPUPNT(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN,
     1IVSTAR,IVSTOP,MAXNAM,NUMNAM,V,MAXN,MAXCOL,NUMCOL,
     1IBUGS2,IERROR)
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('ALL USER VARIABLES HAVE JUST BEEN DELETED.')
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
C
      GOTO1000
C
C               **************************************************
C               **  STEP 13--                                   **
C               **  RESET PARAMETERS                            **
C               **************************************************
C
 1300 CONTINUE
      DO1310J=1,NUMNAM
      IF(IHNAME(J).EQ.'INFI'.AND.IHNAM2(J).EQ.'NITY')GOTO1310
      IF(IHNAME(J).EQ.'PI  '.AND.IHNAM2(J).EQ.'    ')GOTO1310
      IF(IUSE(J).EQ.'P')IN(J)=(-1)
 1310 CONTINUE
      CALL DPUPNT(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN,
     1IVSTAR,IVSTOP,MAXNAM,NUMNAM,V,MAXN,MAXCOL,NUMCOL,
     1IBUGS2,IERROR)
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('ALL USER PARAMETERS HAVE JUST BEEN DELETED.')
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1000
C
C               **************************************************
C               **  STEP 14--                                   **
C               **  RESET FUNCTIONS (STRINGS)                   **
C               **************************************************
C
 1400 CONTINUE
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXCHF=1000
      NUMCHF=0
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXFUN=100
      NUMFUN=0
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   SEPTEMBER 1993
CCCCC MAXCHM=200
      NUMCHM=0
C
      DO1410J=1,NUMNAM
      IF(IUSE(J).EQ.'F')IN(J)=(-1)
 1410 CONTINUE
      CALL DPUPNT(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN,
     1IVSTAR,IVSTOP,MAXNAM,NUMNAM,V,MAXN,MAXCOL,NUMCOL,
     1IBUGS2,IERROR)
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('ALL USER FUNCTIONS (= STRINGS) HAVE JUST BEEN ',
     1'DELETED.')
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1000
C
C               **************************************************
C               **  STEP 15--                                   **
C               **  RESET ALL MATRICES                          **
C               **************************************************
C
 1500 CONTINUE
      DO1510J=1,NUMNAM
      IF(IUSE(J).EQ.'M')IN(J)=(-1)
 1510 CONTINUE
      CALL DPUPNT(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN,
     1IVSTAR,IVSTOP,MAXNAM,NUMNAM,V,MAXN,MAXCOL,NUMCOL,
     1IBUGS2,IERROR)
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('ALL USER MATRICES HAVE JUST BEEN DELETED.')
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1000
C
C               **************************************************
C               **  STEP 21--                                   **
C               **  RESET INPUT/OUTPUT                          **
C               **************************************************
C
 2100 CONTINUE
      ISKIP=0
      IFROW1=1
      IFROW2=I1MACH(9)
      IFCOL1=1
      IFCOL2=132
      IF(IFEEDB.EQ.'OFF')GOTO2189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2181)
 2181 FORMAT('ALL USER INPUT/OUPUT SKIP, ROW, AND COLUMN LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2182)
 2182 FORMAT('SETTINGS HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2183)
 2183 FORMAT('TO THEIR SIGN-ON DEFAULT STATUS')
      CALL DPWRST('XXX','BUG ')
 2189 CONTINUE
      GOTO1000
C
C               **************************************************
C               **  STEP 22--                                   **
C               **  RESET PLOT CONTROL                          **
C               **************************************************
C
 2200 CONTINUE
      CALL INITPC(IBUGS2)
C
      IF(IFEEDB.EQ.'OFF')GOTO2289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2281)
 2281 FORMAT('ALL USER PLOT CONTROL (LINE, CHARACTER, FONT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2282)
 2282 FORMAT('SETTINGS HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2283)
 2283 FORMAT('TO THEIR SIGN-ON DEFAULT STATUS')
      CALL DPWRST('XXX','BUG ')
 2289 CONTINUE
      GOTO1000
C
C               **************************************************
C               **  STEP 23--                                   **
C               **  RESET CLSB (CHARACTERS, LINES,              **
C               **  SPIKES, AND BARS)                           **
C               **************************************************
C
 2300 CONTINUE
CCCCC IDEFGC='BLAC'
C
      DO2310J=1,MAXCH2
      ICHAPA(J)='    '
CCCCC ICHAFO(J)='TEKT'
      ICHACA(J)='UPPE'
      ICHAJU(J)='CECE'
      ICHADI(J)='VERT'
      ICHAFI(J)='OFF'
CCCCC ICHACO(J)='BLAC'
      PCHAHE(J)=2.0
      PCHAWI(J)=1.0
      PCHAVG(J)=0.75
      PCHAHG(J)=0.25
CCCCC PCHATH(J)=0.1
      ACHAAN(J)=0.0
      PCHAHO(J)=0.0
      PCHAVO(J)=0.0
 2310 CONTINUE
C
      DO2320J=1,MAXLN
      ILINPA(J)='SOLI'
CCCCC ILINCO(J)='BLAC'
CCCCC PLINTH(J)=0.1
      PLINLE(J)=1.0
      PLINL2(J)=1.0
      PLINL3(J)=1.0
      PLINGA(J)=1.0
      PLING2(J)=1.0
      PLING3(J)=1.0
 2320 CONTINUE
C
      DO2330J=1,MAXSP
      ISPISW(J)='OFF'
      ISPILI(J)='SOLI'
CCCCC ISPICO(J)='BLAC'
      ISPIDI(J)='V'
CCCCC PSPITH(J)=0.1
      ASPIBA(J)=0.0
 2330 CONTINUE
C
      DO2340J=1,MAXBA
      IBARSW(J)='OFF'
      IBABLI(J)='SOLI'
CCCCC IBABCO(J)='BLAC'
      IBAFSW(J)='OFF'
CCCCC IBAFCO(J)=IDEFGC
      IBAPTY(J)='SOLI'
      IBAPLI(J)='SOLI'
CCCCC IBAPCO(J)=IDEFGC
      IBARTY(J)='2'
      IBARDI(J)='V'
      ABARBA(J)=0.0
      ABARWI(J)=CPUMIN
CCCCC PBABTH(J)=0.1
CCCCC PBAPTH(J)=0.1
      PBAPSP(J)=1.0
 2340 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO2389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2381)
 2381 FORMAT('ALL USER CLSB (= CHARACTER, LINE, SPIKE, & BAR)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2382)
 2382 FORMAT('SETTINGS HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2383)
 2383 FORMAT('TO THEIR SIGN-ON DEFAULT STATUS')
      CALL DPWRST('XXX','BUG ')
 2389 CONTINUE
      GOTO1000
C
C               **************************************************
C               **  STEP 24--                                   **
C               **  RESET LIMITS (ON PLOTS)                     ZZ
C               **************************************************
C
 2400 CONTINUE
      IX1MIN='FLOA'
      IX1MAX='FLOA'
      IY1MIN='FLOA'
      IY1MAX='FLOA'
      IZ1MIN='FLOA'
      IZ1MAX='FLOA'
C
      IX2MIN='FLOA'
      IX2MAX='FLOA'
      IY2MIN='FLOA'
      IY2MAX='FLOA'
      IZ2MIN='FLOA'
      IZ2MAX='FLOA'
C
      PDXMIN=CPUMIN
      PDXMAX=CPUMAX
      PDYMIN=CPUMIN
      PDYMAX=CPUMAX
      PDZMIN=CPUMIN
      PDZMAX=CPUMAX
C
      PGXMIN=CPUMIN
      PGXMAX=CPUMAX
      PGYMIN=CPUMIN
      PGYMAX=CPUMAX
      PGZMIN=CPUMIN
      PGZMAX=CPUMAX
C
      GX1MIN=CPUMIN
      GX1MAX=CPUMAX
      GY1MIN=CPUMIN
      GY1MAX=CPUMAX
      GZ1MIN=CPUMIN
      GZ1MAX=CPUMAX
C
      GX2MIN=CPUMIN
      GX2MAX=CPUMAX
      GY2MIN=CPUMIN
      GY2MAX=CPUMAX
      GZ2MIN=CPUMIN
      GZ2MAX=CPUMAX
C
      DX1MIN=CPUMIN
      DX1MAX=CPUMAX
      DY1MIN=CPUMIN
      DY1MAX=CPUMAX
      DZ1MIN=CPUMIN
      DZ1MAX=CPUMAX
C
      DX2MIN=CPUMIN
      DX2MAX=CPUMAX
      DY2MIN=CPUMIN
      DY2MAX=CPUMAX
      DZ2MIN=CPUMIN
      DZ2MAX=CPUMAX
C
      FX1MIN=CPUMIN
      FX1MAX=CPUMAX
      FY1MIN=CPUMIN
      FY1MAX=CPUMAX
      FZ1MIN=CPUMIN
      FZ1MAX=CPUMAX
C
      FX2MIN=CPUMIN
      FX2MAX=CPUMAX
      FY2MIN=CPUMIN
      FY2MAX=CPUMAX
      FZ2MIN=CPUMIN
      FZ2MAX=CPUMAX
C
      IF(IFEEDB.EQ.'OFF')GOTO2489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2481)
 2481 FORMAT('XLIMITS AND YLIMITS FOR PLOTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2482)
 2482 FORMAT('HAVE JUST BEEN SET TO FLOAT WITH THE DATA')
      CALL DPWRST('XXX','BUG ')
 2489 CONTINUE
      GOTO1000
C
C               **************************************************
C               **  STEP 31--                                   **
C               **  RESET SUPPORT                               **
C               **************************************************
C
 3100 CONTINUE
      ITEMEC=IECHO
      ITEMFE=IFEEDB
      ITEMPR=IPRINT
      CALL INITSU(IBUGS2)
C
      IECHO=ITEMEC
      IFEEDB=ITEMFE
      IPRINT=ITEMPR
      IF(IFEEDB.EQ.'OFF')GOTO3189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3181)
 3181 FORMAT('ALL USER SUPPORT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3182)
 3182 FORMAT('SETTINGS HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3183)
 3183 FORMAT('TO THEIR SIGN-ON DEFAULT STATUS')
      CALL DPWRST('XXX','BUG ')
 3189 CONTINUE
      GOTO1000
C
 1000 CONTINUE
      GOTO9000
C
C               **************************************************
C               **  TREAT THE    RESET ALL    CASE              **
C               **  (WILL BE DONE BACK IN THE MAIN ROUNTINE)    **
C               **************************************************
C
 5100 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO5189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5181)
 5181 FORMAT('ALL INTERNAL DATAPLOT SETTINGS HAVE JUST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5182)
 5182 FORMAT('BEEN SET TO THEIR SIGN-ON DEFAULT STATUS')
      CALL DPWRST('XXX','BUG ')
 5189 CONTINUE
      GOTO9000
C
C               ************
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 DPRESE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMARG
 9013 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9017
      DO9015I=1,NUMARG
      WRITE(ICOUT,9016)I,IHARG(I)
 9016 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9017 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRESI(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 RESISTORS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE 2 ENDS
C           OF THE RESISTOR.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN RESISTOR WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN RESISTOR WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN RESISTOR WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND 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           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.'RESI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRESI--')
      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='RESI'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPRESI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A RESISTOR ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      FROM THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      TO THE POINT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      RESISTOR 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      RESISTOR ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPRES2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'RESI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRESI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPREST(IFOUND,IERROR)
C
C     PURPOSE--RESTORE (= READ IN TO MEMORY) ALL INTERNAL DATAPLOT
C              SETTINGS.  THE MASS STORAGE FILE
C              IS DESIGNATED BY THE ANALYST.
C              THIS IS USEFUL WHEN A RUN MUST BE
C              INTERRUPTED (E.G., LUNCH) (SEE THE SAVE COMMAND)
C              AND IT IS DESIRED
C              TO PICK UP THE RUN LATER AT THE POINT
C              OF INTERRUPTION (SEE THE RESTORE COMMAND).
C     NOTE--THE SAVE COMMAND (AND ITS COMPLEMENT, THE RESTORE COMMAND)
C           BOTH USE UNFORMATTED FORTRAN I/O STATEMENTS
C           (FOR SPEED AND EFFICIENCY).
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --JANUARY   1982.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --JUNE      1986.
C     UPDATED         --NOVEMBER  1987.  DIMENSION FOR I1DATA--1100 TO 100
C     UPDATED         --DECEMBER  1987.  DIMENSION FOR V--10000 TO MAXOBW
C     UPDATED         --JANUARY   1989.  SOFT-CODE ALL (ALAN)
C     UPDATED         --OCTOBER   1991.  SUN HAS LIMIT ON # OF WORDS
C                                        FOR UNFORMATTED I/O (2,046)
C     UPDATED         --APRIL     1992.  INCLUDE DPCO3D.INC (ALAN)
C     UPDATED         --APRIL     1992.  PPEDHE TO APEDSZ (ALAN)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*80 ICANS
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCODB.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOSO.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOTR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODG.INC'
      INCLUDE 'DPCOCO.INC'
CCCCC FOLLOWING LINE WAS ADDED  APRIL 1992 (ALAN)
      INCLUDE 'DPCO3D.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='DPRE'
      ISUBN2='ST  '
C
      ISUBRO='-999'
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'REST')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPREST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IWIDTH
   54 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,55)(IANSLC(I),I=1,IWIDTH)
   55 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ISAVNU
   61 FORMAT('ISAVNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)ISAVNA
   62 FORMAT('ISAVNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ISAVST
   63 FORMAT('ISAVST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ISAVFO
   64 FORMAT('ISAVFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)ISAVAC
   65 FORMAT('ISAVAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ISAVFO
   66 FORMAT('ISAVFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ISAVCS
   67 FORMAT('ISAVCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ISAVNU
      IFILE=ISAVNA
      ISTAT=ISAVST
      IFORM=ISAVFO
      IACCES=ISAVAC
      IPROT=ISAVPR
      ICURST=ISAVCS
C
      ISUBN0='REST'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'REST')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               *******************************************
C               **  STEP 12--                            **
C               **  CHECK TO SEE IF SAVE FILE MAY EXIST  **
C               *******************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REST')
     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 DPREST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED RESTORE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE GIVEN BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES SUCH SAVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,ISAVST
 1217 FORMAT('ISTAT,ISAVST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               ****************************
C               **  STEP 13--             **
C               **  EXTRACT THE FILE NAME **
C               **  (THE THIRD WORD)      **
C               ****************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1310I=1,80
      IFILE(I:I)=' '
 1310 CONTINUE
C
      DO1320I=1,80
      ICANS(I:I)=IANSLC(I)
 1320 CONTINUE
C
      ISTART=1
      ISTOP=IWIDTH
      IF(NUMARG.LE.1)
     1CALL DPW280(ICANS,ISTART,ISTOP,ICOL3,IBUGS2,ISUBRO,IERROR)
      IF(NUMARG.GE.2)
     1CALL DPW380(ICANS,ISTART,ISTOP,ICOL3,IBUGS2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      J=0
      IF(ICOL3.GT.IWIDTH)GOTO1339
      DO1330I=ICOL3,IWIDTH
      J=J+1
      IFILE(J:J)=ICANS(I:I)
 1330 CONTINUE
 1339 CONTINUE
C
      CALL DPDB80(IFILE,JMAX,IBUGS2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      NCFILE=JMAX
C
      IF(NCFILE.GE.1)GOTO1349
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1341)
 1341 FORMAT('***** ERROR IN DPREST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1342)
 1342 FORMAT('      A FILE NAME IS REQUIRED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1343)
 1343 FORMAT('      IN THE RESTORE COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1344)
 1344 FORMAT('      (FOR EXAMPLE,    RESTORE MEMORY DPRUN.DAT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1345)
 1345 FORMAT('      BUT NONE WAS GIVEN HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1346)
 1346 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1347)(IANSLC(I),I=1,IWIDTH)
 1347 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,999)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1349 CONTINUE
C
 1390 CONTINUE
C
C               *********************
C               **  STEP 31--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REST')
     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  FROM THE SAVE FILE;
C               ****************************************************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     -----BEGIN READING IN-----------------------
C
C     -----READ IN COMMON FOR STANDARD I/O-----
C
      READ(IOUNIT)IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      READ(IOUNIT)IFEEDB,IPRINT
C
C     -----READ IN COMMON FOR MACHINE CONSTANTS-----
C
      READ(IOUNIT)(I1MACH(I),I=1,16)
      READ(IOUNIT)(R1MACH(I),I=1,5)
      READ(IOUNIT)(D1MACH(I),I=1,5)
C
C     -----READ IN COMMON FOR BUGS-----
C
      READ(IOUNIT)(I1BUG(I),I=1,10)
      READ(IOUNIT)(IH1BUG(I),I=1,100)
C
C     -----READ IN COMMON FOR HOUSEKEEPING-----
C
CCCCC READ(IOUNIT)(I1HOUS(I),I=1,1050)
      READ(IOUNIT)(I1HOUS(I),I=1,5*MAXSTR+50)
C     READ(IOUNIT)(IH1HOU(I),I=1,2320)
      READ(IOUNIT)(IH1HOU(I),I=1,11*MAXSTR+120)
C     READ(IOUNIT)(R1HOUS(I),I=1,400)
      READ(IOUNIT)(R1HOUS(I),I=1,2*MAXSTR)
C
C     -----READ IN COMMON FOR DATA-----
C
C  OCTOBER 1991.  FOLLOWING BLOCK OF CODE HEAVILY MODIFIED TO HANDLE
C  PROBLEM ON SUN.  SUN APPEARS TO LIMIT UNFORMATTED I/O TO 2,046 WORDS.
C  NEED TO BREAK INTO CHUNKS FOR MANY OF THESE WRITE OPERATIONS.
C
      MAXWRD=100000
      IF(IHOST1.EQ.'SUN')MAXWRD=2046
      NLOOP1=(MAXOBV/MAXWRD)+1
      NLOOP2=(MAXPOP/MAXWRD)+1
      NLOOP3=(MAXOBW/MAXWRD)+1
C
CCCCC READ(IOUNIT)(I1DATA(I),I=1,1100)
CCCCC READ(IOUNIT)(I1DATA(I),I=1,MAXOBS+100)
      READ(IOUNIT)(I1DATA(I),I=1,100)
CCCCC READ(IOUNIT)(ISUB(I),I=1,MAXOBV)
      DO9112IK=1,NLOOP1
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXOBV)GOTO9117
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXOBV)JSTOP=MAXOBV
      READ(IOUNIT)(ISUB(I),I=JSTART,JSTOP)
 9112 CONTINUE
 9117 CONTINUE
CCCCC READ(IOUNIT)(IH1DAT(I),I=1,3500)
CCCCC READ(IOUNIT)(IH1DAT(I),I=1,3*MAXF1+3*MAXFN2+MAXF3)
      READ(IOUNIT)(IPARNC(I),I=1,MAXFN2)
      READ(IOUNIT)(IPANC2(I),I=1,MAXFN2)
      READ(IOUNIT)(IPAROP(I),I=1,MAXFN2)
      READ(IOUNIT)(MODEL(I),I=1,MAXF3)
      READ(IOUNIT)(IFUNC(I),I=1,MAXF1)
      READ(IOUNIT)(IFUNC2(I),I=1,MAXF1)
      READ(IOUNIT)(IFUNC3(I),I=1,MAXF1)
      READ(IOUNIT)(PARLIM(I),I=1,100)
CCCCC READ(IOUNIT)(PRED(I),I=1,MAXOBV)
      DO9122IK=1,NLOOP1
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXOBV)GOTO9127
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXOBV)JSTOP=MAXOBV
      READ(IOUNIT)(PRED(I),I=JSTART,JSTOP)
 9122 CONTINUE
 9127 CONTINUE
CCCCC READ(IOUNIT)(RES(I),I=1,MAXOBV)
      DO9132IK=1,NLOOP1
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXOBV)GOTO9137
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXOBV)JSTOP=MAXOBV
      READ(IOUNIT)(RES(I),I=JSTART,JSTOP)
 9132 CONTINUE
 9137 CONTINUE
CCCCC READ(IOUNIT)(Y(I),I=1,MAXPOP)
      DO9142IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9147
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      READ(IOUNIT)(Y(I),I=JSTART,JSTOP)
 9142 CONTINUE
 9147 CONTINUE
CCCCC READ(IOUNIT)(X(I),I=1,MAXPOP)
      DO9152IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9157
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      READ(IOUNIT)(X(I),I=JSTART,JSTOP)
 9152 CONTINUE
 9157 CONTINUE
CCCCC READ(IOUNIT)(X3D(I),I=1,MAXPOP)
      DO9162IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9167
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      READ(IOUNIT)(X3D(I),I=JSTART,JSTOP)
 9162 CONTINUE
 9167 CONTINUE
CCCCC READ(IOUNIT)(D(I),I=1,MAXPOP)
      DO9172IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9177
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      READ(IOUNIT)(D(I),I=JSTART,JSTOP)
 9172 CONTINUE
 9177 CONTINUE
CCCCC READ(IOUNIT)(YPLOT(I),I=1,MAXPOP)
      DO9182IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9187
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      READ(IOUNIT)(YPLOT(I),I=JSTART,JSTOP)
 9182 CONTINUE
 9187 CONTINUE
CCCCC READ(IOUNIT)(XPLOT(I),I=1,MAXPOP)
      DO9192IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9197
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      READ(IOUNIT)(XPLOT(I),I=JSTART,JSTOP)
 9192 CONTINUE
 9197 CONTINUE
CCCCC READ(IOUNIT)(X2PLOT(I),I=1,MAXPOP)
      DO9212IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9217
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      READ(IOUNIT)(X2PLOT(I),I=JSTART,JSTOP)
 9212 CONTINUE
 9217 CONTINUE
CCCCC READ(IOUNIT)(TAGPLO(I),I=1,MAXPOP)
      DO9222IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9227
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      READ(IOUNIT)(TAGPLO(I),I=JSTART,JSTOP)
 9222 CONTINUE
 9227 CONTINUE
CCCCC READ(IOUNIT)(V(I),I=1,MAXOBW)
      DO9232IK=1,NLOOP3
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXOBW)GOTO9237
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXOBW)JSTOP=MAXOBW
      READ(IOUNIT)(V(I),I=JSTART,JSTOP)
 9232 CONTINUE
 9237 CONTINUE
CCCCC READ(IOUNIT)((AMATR1(I,J),I=1,100),J=1,100)
      ITEMP=100*100
      IF(ITEMP.LE.MAXWRD)THEN
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=1,100)
      ELSE
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=1,10)
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=11,20)
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=21,30)
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=31,40)
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=41,50)
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=51,60)
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=61,70)
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=71,80)
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=81,90)
        READ(IOUNIT)((AMATR1(I,J),I=1,100),J=91,100)
      END IF
CCCCC READ(IOUNIT)(R1DATA(I),I=1,10200)
CCCCC READ(IOUNIT)(R1DATA(I),I=1,42200)
CCCCC READ(IOUNIT)(R1DATA(I),I=1,2*MAXOBS+8*MAXPLP+200)
CCCCC READ(IOUNIT)(V(I),I=1,10000)
CCCCC READ(IOUNIT)(V(I),I=1,MAXWS)
C
C     -----READ IN COMMON FOR SUPPORT-----
C
      READ(IOUNIT)(I1SUPP(I),I=1,50)
      READ(IOUNIT)(IH1SUP(I),I=1,70)
      READ(IOUNIT)(R1SUPP(I),I=1,60)
C
C     -----READ IN COMMON FOR SUBFILE I/O (UNIVAC ONLY)-----
C
      READ(IOUNIT)(IBUF(I),I=1,504)
C
C     -----READ IN COMMON FOR DIAGRAMMATIC GRAPHICS-----
C
      READ(IOUNIT)(IH1DIA(I),I=1,40)
      READ(IOUNIT)(R1DIAG(I),I=1,40)
C
C     -----READ IN COMMON FOR COLOR-----
C
      READ(IOUNIT)ICOLOR
      READ(IOUNIT)IPLOTF
C
C     -----READ IN COMMON FOR BUGS AND ERROR-----
C
      READ(IOUNIT)IBUGG4
      READ(IOUNIT)ISUBG4
      READ(IOUNIT)IERRG4
C
C     -----READ IN COMMON FOR HOST-----
C
      READ(IOUNIT)IHOST1
      READ(IOUNIT)IHOST2
      READ(IOUNIT)IHMOD1
      READ(IOUNIT)IHMOD2
      READ(IOUNIT)IOPSY1
      READ(IOUNIT)IOPSY2
      READ(IOUNIT)ICOMPI
      READ(IOUNIT)ISITE
C
C     -----READ IN COMMON FOR TRANSLATOR-----
C
      READ(IOUNIT)ITRANS
      READ(IOUNIT)NCTRA1
      READ(IOUNIT)NCTRA2
      READ(IOUNIT)NUMTRA
      READ(IOUNIT)ICTRA1
      READ(IOUNIT)ICTRA2
C
C     -----READ IN COMMON FOR NON-PRINTING CHARACTERS-----
C
      READ(IOUNIT)INULC
      READ(IOUNIT)ISOHC
      READ(IOUNIT)ISTXC
      READ(IOUNIT)IETXC
      READ(IOUNIT)IEOTC
      READ(IOUNIT)IENQC
      READ(IOUNIT)IACKC
      READ(IOUNIT)IBELC
      READ(IOUNIT)IBSC
      READ(IOUNIT)IHTC
      READ(IOUNIT)ILFC
      READ(IOUNIT)IVTC
      READ(IOUNIT)IFFC
      READ(IOUNIT)ICRC
      READ(IOUNIT)ISOC
      READ(IOUNIT)ISIC
      READ(IOUNIT)IDLEC
      READ(IOUNIT)IDC1C
      READ(IOUNIT)IDC2C
      READ(IOUNIT)IDC3C
      READ(IOUNIT)IDC4C
      READ(IOUNIT)INAKC
      READ(IOUNIT)ISYNC
      READ(IOUNIT)IETBC
      READ(IOUNIT)ICANC
      READ(IOUNIT)IEMC
      READ(IOUNIT)ISUBC
      READ(IOUNIT)IESCC
      READ(IOUNIT)IFSC
      READ(IOUNIT)IGSC
      READ(IOUNIT)IRSC
      READ(IOUNIT)IUSC
C
C     -----READ IN COMMON FOR GRAPHICS-----
C
      READ(IOUNIT)IMANUF
      READ(IOUNIT)IMODEL
      READ(IOUNIT)IMODE2
      READ(IOUNIT)IMODE3
      READ(IOUNIT)IGCODE
      READ(IOUNIT)IGUNIT
      READ(IOUNIT)IGCONT
      READ(IOUNIT)NUMHPP
      READ(IOUNIT)NUMVPP
      READ(IOUNIT)ANUMHP
      READ(IOUNIT)ANUMVP
      READ(IOUNIT)IGCOLO
      READ(IOUNIT)IGBAUD
      READ(IOUNIT)AGERDE
      READ(IOUNIT)AGCODE
      READ(IOUNIT)ISOFT
      READ(IOUNIT)ISOFT2
      READ(IOUNIT)ISOFT3
C
C     -----READ IN COMMON FOR FILE OPERATIONS-----
C
      READ(IOUNIT)(I1FILO(I),I=1,10)
      READ(IOUNIT)(IH1FIL(I),I=1,200)
C
C     -----READ IN COMMON FOR FILE OPERATIONS, PART 2-----
C
      READ(IOUNIT)IMESNU
      READ(IOUNIT)IMESNA
      READ(IOUNIT)IMESST
      READ(IOUNIT)IMESFO
      READ(IOUNIT)IMESAC
      READ(IOUNIT)IMESPR
      READ(IOUNIT)IMESCS
C
      READ(IOUNIT)INEWNU
      READ(IOUNIT)INEWNA
      READ(IOUNIT)INEWST
      READ(IOUNIT)INEWFO
      READ(IOUNIT)INEWAC
      READ(IOUNIT)INEWPR
      READ(IOUNIT)INEWCS
C
      READ(IOUNIT)IMAINU
      READ(IOUNIT)IMAINA
      READ(IOUNIT)IMAIST
      READ(IOUNIT)IMAIFO
      READ(IOUNIT)IMAIAC
      READ(IOUNIT)IMAIPR
      READ(IOUNIT)IMAICS
C
      READ(IOUNIT)IHELNU
      READ(IOUNIT)IHELNA
      READ(IOUNIT)IHELST
      READ(IOUNIT)IHELFO
      READ(IOUNIT)IHELAC
      READ(IOUNIT)IHELPR
      READ(IOUNIT)IHELCS
C
      READ(IOUNIT)IBUGNU
      READ(IOUNIT)IBUGNA
      READ(IOUNIT)IBUGST
      READ(IOUNIT)IBUGFO
      READ(IOUNIT)IBUGAC
      READ(IOUNIT)IBUGPR
      READ(IOUNIT)IBUGCS
C
      READ(IOUNIT)IQUENU
      READ(IOUNIT)IQUENA
      READ(IOUNIT)IQUEST
      READ(IOUNIT)IQUEFO
      READ(IOUNIT)IQUEAC
      READ(IOUNIT)IQUEPR
      READ(IOUNIT)IQUECS
C
      READ(IOUNIT)ILOGNU
      READ(IOUNIT)ILOGNA
      READ(IOUNIT)ILOGST
      READ(IOUNIT)ILOGFO
      READ(IOUNIT)ILOGAC
      READ(IOUNIT)ILOGPR
      READ(IOUNIT)ILOGCS
C
      READ(IOUNIT)IREANU
      READ(IOUNIT)IREANA
      READ(IOUNIT)IREAST
      READ(IOUNIT)IREAFO
      READ(IOUNIT)IREAAC
      READ(IOUNIT)IREAPR
      READ(IOUNIT)IREACS
C
      READ(IOUNIT)IWRINU
      READ(IOUNIT)IWRINA
      READ(IOUNIT)IWRIST
      READ(IOUNIT)IWRIFO
      READ(IOUNIT)IWRIAC
      READ(IOUNIT)IWRIPR
      READ(IOUNIT)IWRICS
C
      READ(IOUNIT)ISAVNU
      READ(IOUNIT)ISAVNA
      READ(IOUNIT)ISAVST
      READ(IOUNIT)ISAVFO
      READ(IOUNIT)ISAVAC
      READ(IOUNIT)ISAVPR
      READ(IOUNIT)ISAVCS
C
      READ(IOUNIT)ILISNU
      READ(IOUNIT)ILISNA
      READ(IOUNIT)ILISST
      READ(IOUNIT)ILISFO
      READ(IOUNIT)ILISAC
      READ(IOUNIT)ILISPR
      READ(IOUNIT)ILISCS
C
      READ(IOUNIT)ICRENU
      READ(IOUNIT)ICRENA
      READ(IOUNIT)ICREST
      READ(IOUNIT)ICREFO
      READ(IOUNIT)ICREAC
      READ(IOUNIT)ICREPR
      READ(IOUNIT)ICRECS
C
      READ(IOUNIT)ISCRNU
      READ(IOUNIT)ISCRNA
      READ(IOUNIT)ISCRST
      READ(IOUNIT)ISCRFO
      READ(IOUNIT)ISCRAC
      READ(IOUNIT)ISCRPR
      READ(IOUNIT)ISCRCS
C
      READ(IOUNIT)IDATNU
      READ(IOUNIT)IDATNA
      READ(IOUNIT)IDATST
      READ(IOUNIT)IDATFO
      READ(IOUNIT)IDATAC
      READ(IOUNIT)IDATPR
      READ(IOUNIT)IDATCS
C
      READ(IOUNIT)IPL1NU
      READ(IOUNIT)IPL1NA
      READ(IOUNIT)IPL1ST
      READ(IOUNIT)IPL1FO
      READ(IOUNIT)IPL1AC
      READ(IOUNIT)IPL1PR
      READ(IOUNIT)IPL1CS
C
      READ(IOUNIT)IPL2NU
      READ(IOUNIT)IPL2NA
      READ(IOUNIT)IPL2ST
      READ(IOUNIT)IPL2FO
      READ(IOUNIT)IPL2AC
      READ(IOUNIT)IPL2PR
      READ(IOUNIT)IPL2CS
C
      READ(IOUNIT)IPRONU
      READ(IOUNIT)IPRONA
      READ(IOUNIT)IPROST
      READ(IOUNIT)IPROFO
      READ(IOUNIT)IPROAC
      READ(IOUNIT)IPROPR
      READ(IOUNIT)IPROCS
C
      READ(IOUNIT)ICONNU
      READ(IOUNIT)ICONNA
      READ(IOUNIT)ICONST
      READ(IOUNIT)ICONFO
      READ(IOUNIT)ICONAC
      READ(IOUNIT)ICONPR
      READ(IOUNIT)ICONCS
C
      READ(IOUNIT)ISACNU
      READ(IOUNIT)ISACNA
      READ(IOUNIT)ISACST
      READ(IOUNIT)ISACFO
      READ(IOUNIT)ISACAC
      READ(IOUNIT)ISACPR
      READ(IOUNIT)ISACCS
C
      READ(IOUNIT)IEX1NU
      READ(IOUNIT)IEX1NA
      READ(IOUNIT)IEX1ST
      READ(IOUNIT)IEX1FO
      READ(IOUNIT)IEX1AC
      READ(IOUNIT)IEX1PR
      READ(IOUNIT)IEX1CS
C
      READ(IOUNIT)IEX2NU
      READ(IOUNIT)IEX2NA
      READ(IOUNIT)IEX2ST
      READ(IOUNIT)IEX2FO
      READ(IOUNIT)IEX2AC
      READ(IOUNIT)IEX2PR
      READ(IOUNIT)IEX2CS
C
      READ(IOUNIT)IEX3NU
      READ(IOUNIT)IEX3NA
      READ(IOUNIT)IEX3ST
      READ(IOUNIT)IEX3FO
      READ(IOUNIT)IEX3AC
      READ(IOUNIT)IEX3PR
      READ(IOUNIT)IEX3CS
C
      READ(IOUNIT)IEX4NU
      READ(IOUNIT)IEX4NA
      READ(IOUNIT)IEX4ST
      READ(IOUNIT)IEX4FO
      READ(IOUNIT)IEX4AC
      READ(IOUNIT)IEX4PR
      READ(IOUNIT)IEX4CS
C
      READ(IOUNIT)IEX5NU
      READ(IOUNIT)IEX5NA
      READ(IOUNIT)IEX5ST
      READ(IOUNIT)IEX5FO
      READ(IOUNIT)IEX5AC
      READ(IOUNIT)IEX5PR
      READ(IOUNIT)IEX5CS
C
      READ(IOUNIT)IFCHAR
C
C     -----READ IN COMMON FOR PLOT CONTROL-----
C
      READ(IOUNIT)(IDMANU(I),I=1,MAXDV)
      READ(IOUNIT)(IDMODE(I),I=1,MAXDV)
      READ(IOUNIT)(IDMOD2(I),I=1,MAXDV)
      READ(IOUNIT)(IDMOD3(I),I=1,MAXDV)
      READ(IOUNIT)(IDPOWE(I),I=1,MAXDV)
      READ(IOUNIT)(IDCONT(I),I=1,MAXDV)
      READ(IOUNIT)(IDCOLO(I),I=1,MAXDV)
      READ(IOUNIT)(IDSCRE(I),I=1,MAXDV)
      READ(IOUNIT)(IDSCRO(I),I=1,MAXDV)
      READ(IOUNIT)(IDPAER(I),I=1,MAXDV)
      READ(IOUNIT)(IDSEGM(I),I=1,MAXDV)
      READ(IOUNIT)(IDSOFT(I),I=1,MAXDV)
      READ(IOUNIT)(IDSOF2(I),I=1,MAXDV)
      READ(IOUNIT)(IDSOF3(I),I=1,MAXDV)
C
      READ(IOUNIT)(IDCODE(I),I=1,MAXDV)
      READ(IOUNIT)(IDUNIT(I),I=1,MAXDV)
      READ(IOUNIT)(IDNHPP(I),I=1,MAXDV)
      READ(IOUNIT)(IDNVPP(I),I=1,MAXDV)
      READ(IOUNIT)(IDBAUD(I),I=1,MAXDV)
      READ(IOUNIT)NUMDEV,MAXDEV
C
      READ(IOUNIT)IERASW,IBELSW,ISORSW,ICOPSW
      READ(IOUNIT)IPENSW
      READ(IOUNIT)IBACCO,IMARCO
      READ(IOUNIT)IDEFXC,IDEFBK,IDEFMC,IDEPEC
      READ(IOUNIT)ISEQSW
      READ(IOUNIT)IFENSW
      READ(IOUNIT)INEGSW
      READ(IOUNIT)IVISSW,IPEDSW,IPEDCO
      READ(IOUNIT)IDEFMA,IDEFMO,IDEFM2,IDEFM3
      READ(IOUNIT)IDEFPO,IDEFCN,IDEFDC
C
      READ(IOUNIT)NUMRIN,NUMCOP
      READ(IOUNIT)NUMSEQ
      READ(IOUNIT)IDEFVP,IDEFHP,IDEFUN
C
      READ(IOUNIT)BAWIDT,BARSPA,DEFBAS
      READ(IOUNIT)AORIXC,AORIYC,AORIZC
      READ(IOUNIT)AEYEXC,AEYEYC,AEYEZC
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992 (ALAN)
CCCCC READ(IOUNIT)PPEDHE
      READ(IOUNIT)APEDSZ
      READ(IOUNIT)DEFSZ,DEFTL
C
      READ(IOUNIT)IGRASW
C
      READ(IOUNIT)PGRAXO,PGRAYO,PGRAXC,PGRAYC,PGRAXN,PGRAYN
      READ(IOUNIT)PMARXC
      READ(IOUNIT)PGRAXF,PGRAYF
      READ(IOUNIT)PCROXC,PCROYC
C
      READ(IOUNIT)IDIASW
C
      READ(IOUNIT)PDIAXC,PDIAYC,PDIAX2,PDIAY2
      READ(IOUNIT)PDIAHE,PDIAWI,PDIAVG,PDIAHG
C
      READ(IOUNIT)PWXMIN,PWXMAX,PWYMIN,PWYMAX
      READ(IOUNIT)WWXMIN,WWXMAX,WWYMIN,WWYMAX
C
      READ(IOUNIT)IX1MIN,IX1MAX,IY1MIN,IY1MAX
      READ(IOUNIT)IX2MIN,IX2MAX,IY2MIN,IY2MAX
C
      READ(IOUNIT)PXMIN,PXMAX,PYMIN,PYMAX
      READ(IOUNIT)PDXMIN,PDXMAX,PDYMIN,PDYMAX
      READ(IOUNIT)PGXMIN,PGXMAX,PGYMIN,PGYMAX
      READ(IOUNIT)GX1MIN,GX1MAX,GY1MIN,GY1MAX
      READ(IOUNIT)GX2MIN,GX2MAX,GY2MIN,GY2MAX
      READ(IOUNIT)DX1MIN,DX1MAX,DY1MIN,DY1MAX
      READ(IOUNIT)DX2MIN,DX2MAX,DY2MIN,DY2MAX
      READ(IOUNIT)FX1MIN,FX1MAX,FY1MIN,FY1MAX
      READ(IOUNIT)FX2MIN,FX2MAX,FY2MIN,FY2MAX
C
      READ(IOUNIT)IX1FSW,IX2FSW,IY1FSW,IY2FSW
      READ(IOUNIT)IX1FPA,IX2FPA,IY1FPA,IY2FPA
      READ(IOUNIT)IX1FCO,IX2FCO,IY1FCO,IY2FCO
C
      READ(IOUNIT)PFRATH
C
      READ(IOUNIT)IX1TSW,IX2TSW,IY1TSW,IY2TSW
      READ(IOUNIT)IX1JSW,IX2JSW,IY1JSW,IY2JSW
      READ(IOUNIT)IX1NSW,IX2NSW,IY1NSW,IY2NSW
      READ(IOUNIT)IX1TSC,IX2TSC,IY1TSC,IY2TSC
      READ(IOUNIT)IX1TJU,IX2TJU,IY1TJU,IY2TJU
      READ(IOUNIT)IX1TCO,IX2TCO,IY1TCO,IY2TCO
C
      READ(IOUNIT)NMJX1T,NMJX2T,NMJY1T,NMJY2T
      READ(IOUNIT)NMNX1T,NMNX2T,NMNY1T,NMNY2T
      READ(IOUNIT)NX1COO,NX2COO,NY1COO,NY2COO
      READ(IOUNIT)NX1CMN,NX2CMN,NY1CMN,NY2CMN
      READ(IOUNIT)MAXTIC
C
      READ(IOUNIT)(PX1COO(I),I=1,MAXTC)
      READ(IOUNIT)(PX2COO(I),I=1,MAXTC)
      READ(IOUNIT)(PY1COO(I),I=1,MAXTC)
      READ(IOUNIT)(PY2COO(I),I=1,MAXTC)
      READ(IOUNIT)(X1COOR(I),I=1,MAXTC)
      READ(IOUNIT)(X2COOR(I),I=1,MAXTC)
      READ(IOUNIT)(Y1COOR(I),I=1,MAXTC)
      READ(IOUNIT)(Y2COOR(I),I=1,MAXTC)
      READ(IOUNIT)(PX1CMN(I),I=1,MAXTC)
      READ(IOUNIT)(PX2CMN(I),I=1,MAXTC)
      READ(IOUNIT)(PY1CMN(I),I=1,MAXTC)
      READ(IOUNIT)(PY2CMN(I),I=1,MAXTC)
      READ(IOUNIT)(X1COMN(I),I=1,MAXTC)
      READ(IOUNIT)(X2COMN(I),I=1,MAXTC)
      READ(IOUNIT)(Y1COMN(I),I=1,MAXTC)
      READ(IOUNIT)(Y2COMN(I),I=1,MAXTC)
      READ(IOUNIT)PX1TLE,PX2TLE,PY1TLE,PY2TLE
      READ(IOUNIT)PTICTH,PMNTFA
C
      READ(IOUNIT)IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW
      READ(IOUNIT)IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO
      READ(IOUNIT)IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA
      READ(IOUNIT)IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU
      READ(IOUNIT)IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI
      READ(IOUNIT)IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI
      READ(IOUNIT)IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO
C
      READ(IOUNIT)IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP
C
      READ(IOUNIT)PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS
      READ(IOUNIT)AX1ZAN,AX2ZAN,AY1ZAN,AY2ZAN
      READ(IOUNIT)PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG
      READ(IOUNIT)PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG
      READ(IOUNIT)PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG
      READ(IOUNIT)PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG
      READ(IOUNIT)PTIZTH
C
      READ(IOUNIT)IVGRSW,IHGRSW
      READ(IOUNIT)IVGRPA,IHGRPA
      READ(IOUNIT)IVGRCO,IHGRCO
C
      READ(IOUNIT)PVGRTH,PHGRTH
C
      READ(IOUNIT)(ITITTE(I),I=1,130)
      READ(IOUNIT)ITITFO,ITITCA,ITITFI,ITITCO
C
      READ(IOUNIT)NCTITL
C
      READ(IOUNIT)PTITHE,PTITWI,PTITVG,PTITHG,PTITTH,PTITDS
C
      READ(IOUNIT)(IX1LTE(I),I=1,MAXCH)
      READ(IOUNIT)IX1LFO,IX1LCA,IX1LFI,IX1LCO
      READ(IOUNIT)(IX2LTE(I),I=1,MAXCH)
      READ(IOUNIT)IX2LFO,IX2LCA,IX2LFI,IX2LCO
      READ(IOUNIT)(IX3LTE(I),I=1,MAXCH)
      READ(IOUNIT)IX3LFO,IX3LCA,IX3LFI,IX3LCO
      READ(IOUNIT)(IY1LTE(I),I=1,MAXCH)
      READ(IOUNIT)IY1LFO,IY1LCA,IY1LFI,IY1LCO
      READ(IOUNIT)(IY2LTE(I),I=1,MAXCH)
      READ(IOUNIT)IY2LFO,IY2LCA,IY2LFI,IY2LCO
C
      READ(IOUNIT)NCX1LA,NCX2LA,NCX3LA,NCY1LA,NCY2LA
C
      READ(IOUNIT)PX1LHE,PX1LWI,PX1LVG,PX1LHG,PX1LTH,PX1LDS
      READ(IOUNIT)PX2LHE,PX2LWI,PX2LVG,PX2LHG,PX2LTH,PX2LDS
      READ(IOUNIT)PX3LHE,PX3LWI,PX3LVG,PX3LHG,PX3LTH,PX3LDS
      READ(IOUNIT)PY1LHE,PY1LWI,PY1LVG,PY1LHG,PY1LTH,PY1LDS
      READ(IOUNIT)PY2LHE,PY2LWI,PY2LVG,PY2LHG,PY2LTH,PY2LDS
C
      READ(IOUNIT)(ILEGTE(I),I=1,MAXLG2)
      READ(IOUNIT)(ILEGFO(I),I=1,MAXLG)
      READ(IOUNIT)(ILEGCA(I),I=1,MAXLG)
      READ(IOUNIT)(ILEGJU(I),I=1,MAXLG)
      READ(IOUNIT)(ILEGDI(I),I=1,MAXLG)
      READ(IOUNIT)(ILEGFI(I),I=1,MAXLG)
      READ(IOUNIT)(ILEGCO(I),I=1,MAXLG)
      READ(IOUNIT)(ILEGNA(I),I=1,MAXLG)
C
      READ(IOUNIT)(ILEGST(I),I=1,MAXLG)
      READ(IOUNIT)(ILEGSP(I),I=1,MAXLG)
      READ(IOUNIT)NCLEG,MXCLEG
      READ(IOUNIT)NUMLEG,MAXLEG
C
      READ(IOUNIT)(PLEGXC(I),I=1,MAXLG)
      READ(IOUNIT)(PLEGYC(I),I=1,MAXLG)
      READ(IOUNIT)(PLEGHE(I),I=1,MAXLG)
      READ(IOUNIT)(PLEGWI(I),I=1,MAXLG)
      READ(IOUNIT)(PLEGVG(I),I=1,MAXLG)
      READ(IOUNIT)(PLEGHG(I),I=1,MAXLG)
      READ(IOUNIT)(PLEGTH(I),I=1,MAXLG)
      READ(IOUNIT)(ALEGAN(I),I=1,MAXLG)
C
      READ(IOUNIT)(IBOBFI(I),I=1,MAXBX)
      READ(IOUNIT)(IBOBCO(I),I=1,MAXBX)
      READ(IOUNIT)(IBOPPA(I),I=1,MAXBX)
      READ(IOUNIT)(IBOPCO(I),I=1,MAXBX)
      READ(IOUNIT)(IBOFPA(I),I=1,MAXBX)
      READ(IOUNIT)(IBOFCO(I),I=1,MAXBX)
C
      READ(IOUNIT)NUMBOX,MAXBOX
C
      READ(IOUNIT)((PBOXXC(I,J),I=1,MAXBX),J=1,2)
      READ(IOUNIT)((PBOXYC(I,J),I=1,MAXBX),J=1,2)
      READ(IOUNIT)(PBOPTH(I),I=1,MAXBX)
      READ(IOUNIT)(PBOPGA(I),I=1,MAXBX)
      READ(IOUNIT)(PBOFTH(I),I=1,MAXBX)
C
      READ(IOUNIT)(IARRPA(I),I=1,MAXAR)
      READ(IOUNIT)(IARRCO(I),I=1,MAXAR)
      READ(IOUNIT)(IARHFI(I),I=1,MAXAR)
C
      READ(IOUNIT)NUMARR,MAXARR
C
      READ(IOUNIT)((PARRXC(I,J),I=1,MAXAR),J=1,2)
      READ(IOUNIT)((PARRYC(I,J),I=1,MAXAR),J=1,2)
      READ(IOUNIT)(PARRTH(I),I=1,MAXAR)
      READ(IOUNIT)(PARHLE(I),I=1,MAXAR)
      READ(IOUNIT)(PARHWI(I),I=1,MAXAR)
C
      READ(IOUNIT)(ISEGPA(I),I=1,MAXSG)
      READ(IOUNIT)(ISEGCO(I),I=1,MAXSG)
C
      READ(IOUNIT)NUMSEG,MAXSEG
C
      READ(IOUNIT)((PSEGXC(I,J),I=1,MAXSG),J=1,2)
      READ(IOUNIT)((PSEGYC(I,J),I=1,MAXSG),J=1,2)
      READ(IOUNIT)(PSEGTH(I),I=1,MAXSG)
C
      READ(IOUNIT)(ILINPA(I),I=1,MAXLN)
      READ(IOUNIT)(ILINCO(I),I=1,MAXLN)
C
      READ(IOUNIT)MAXLIN
C
      READ(IOUNIT)(PLINTH(I),I=1,MAXLN)
      READ(IOUNIT)(PLINLE(I),I=1,MAXLN)
      READ(IOUNIT)(PLINL2(I),I=1,MAXLN)
      READ(IOUNIT)(PLINL3(I),I=1,MAXLN)
      READ(IOUNIT)(PLINGA(I),I=1,MAXLN)
      READ(IOUNIT)(PLING2(I),I=1,MAXLN)
      READ(IOUNIT)(PLING3(I),I=1,MAXLN)
C
      READ(IOUNIT)(ICHAPA(I),I=1,MAXCH2)
      READ(IOUNIT)(ICHAFO(I),I=1,MAXCH2)
      READ(IOUNIT)(ICHACA(I),I=1,MAXCH2)
      READ(IOUNIT)(ICHAJU(I),I=1,MAXCH2)
      READ(IOUNIT)(ICHADI(I),I=1,MAXCH2)
      READ(IOUNIT)(ICHAFI(I),I=1,MAXCH2)
      READ(IOUNIT)(ICHACO(I),I=1,MAXCH2)
C
      READ(IOUNIT)MAXCHA
C
      READ(IOUNIT)(PCHAHE(I),I=1,MAXCH2)
      READ(IOUNIT)(PCHAWI(I),I=1,MAXCH2)
      READ(IOUNIT)(PCHAVG(I),I=1,MAXCH2)
      READ(IOUNIT)(PCHAHG(I),I=1,MAXCH2)
      READ(IOUNIT)(PCHATH(I),I=1,MAXCH2)
      READ(IOUNIT)(ACHAAN(I),I=1,MAXCH2)
C
      READ(IOUNIT)(ITEXTE(I),I=1,MAXCH)
      READ(IOUNIT)ITEXPA,ITEXFO,ITEXCA,ITEXJU,ITEXDI,ITEXAU,ITEXFI,
     1ITEXCO
      READ(IOUNIT)IDEFPA,IDEFFO,IDEFCA,IDEFJU,IDEFDI,IDEFAU,IDEFFI,
     1IDEFCO
      READ(IOUNIT)ITEXCR,ITEXLF
      READ(IOUNIT)IDEFCR,IDEFLF
      READ(IOUNIT)ITEXSY,ITEXSP
      READ(IOUNIT)IDEFSY,IDEFSP
C
      READ(IOUNIT)NCTEXT,MXCTEX
C
      READ(IOUNIT)PTEXHE,PTEXWI,PTEXVG,PTEXHG
      READ(IOUNIT)PTEXTH,PTEXLE,ATEXAN
      READ(IOUNIT)PDEFHE,PDEFWI,PDEFVG,PDEFHG
      READ(IOUNIT)PDEFTH,PDEFLE,ADEFAN
      READ(IOUNIT)PTEXMR
      READ(IOUNIT)PDEFMR
      READ(IOUNIT)PXSTAR,PYSTAR
      READ(IOUNIT)PXEND,PYEND
C
      READ(IOUNIT)(IFILSW(I),I=1,MAXFL)
      READ(IOUNIT)(IFILPA(I),I=1,MAXFL)
      READ(IOUNIT)(IFILCO(I),I=1,MAXFL)
      READ(IOUNIT)IDEFFS
      READ(IOUNIT)IDEFFP
      READ(IOUNIT)IDEFFC
C
      READ(IOUNIT)MAXFIL
C
      READ(IOUNIT)(PFILSP(I),I=1,MAXFL)
      READ(IOUNIT)(PFILTH(I),I=1,MAXFL)
      READ(IOUNIT)(AFILBA(I),I=1,MAXFL)
      READ(IOUNIT)PDEFFG
      READ(IOUNIT)PDEFFT
      READ(IOUNIT)ADEFFB
C
      READ(IOUNIT)(IPATSW(I),I=1,MAXPT)
      READ(IOUNIT)(IPATPA(I),I=1,MAXPT)
      READ(IOUNIT)(IPATLI(I),I=1,MAXPT)
      READ(IOUNIT)(IPATCO(I),I=1,MAXPT)
      READ(IOUNIT)IDEFPS
      READ(IOUNIT)IDEFPP
      READ(IOUNIT)IDEFPL
      READ(IOUNIT)IDEFPC
C
      READ(IOUNIT)MAXPAT
C
      READ(IOUNIT)(PPATHE(I),I=1,MAXPT)
      READ(IOUNIT)(PPATWI(I),I=1,MAXPT)
      READ(IOUNIT)(PPATSP(I),I=1,MAXPT)
      READ(IOUNIT)(PPATTH(I),I=1,MAXPT)
      READ(IOUNIT)PDEFPH
      READ(IOUNIT)PDEFPW
      READ(IOUNIT)PDEFPG
      READ(IOUNIT)PDEFPT
C
      READ(IOUNIT)(ISPISW(I),I=1,MAXSP)
      READ(IOUNIT)(ISPILI(I),I=1,MAXSP)
      READ(IOUNIT)(ISPICO(I),I=1,MAXSP)
      READ(IOUNIT)IDEFSS
      READ(IOUNIT)IDEFSL
      READ(IOUNIT)IDEFSC
C
      READ(IOUNIT)MAXSPI
C
      READ(IOUNIT)(PSPITH(I),I=1,MAXSP)
      READ(IOUNIT)(ASPIBA(I),I=1,MAXSP)
      READ(IOUNIT)PDEFST
      READ(IOUNIT)ADEFSB
C
      READ(IOUNIT)(IBARSW(I),I=1,MAXBA)
      READ(IOUNIT)(IBABLI(I),I=1,MAXBA)
      READ(IOUNIT)(IBABCO(I),I=1,MAXBA)
      READ(IOUNIT)(IBAFSW(I),I=1,MAXBA)
      READ(IOUNIT)(IBAFCO(I),I=1,MAXBA)
      READ(IOUNIT)(IBAPTY(I),I=1,MAXBA)
      READ(IOUNIT)(IBAPLI(I),I=1,MAXBA)
      READ(IOUNIT)(IBAPCO(I),I=1,MAXBA)
      READ(IOUNIT)IDEBSW
      READ(IOUNIT)IDEBBL
      READ(IOUNIT)IDEBBC
      READ(IOUNIT)IDEBFS
      READ(IOUNIT)IDEBFC
      READ(IOUNIT)IDEBPT
      READ(IOUNIT)IDEBPL
      READ(IOUNIT)IDEBPC
C
      READ(IOUNIT)MAXBAR
C
      READ(IOUNIT)(ABARBA(I),I=1,MAXBA)
      READ(IOUNIT)(ABARWI(I),I=1,MAXBA)
      READ(IOUNIT)(PBABTH(I),I=1,MAXBA)
      READ(IOUNIT)(PBAPTH(I),I=1,MAXBA)
      READ(IOUNIT)(PBAPSP(I),I=1,MAXBA)
      READ(IOUNIT)ADEBBA
      READ(IOUNIT)ADEBWI
      READ(IOUNIT)PDEBBT
      READ(IOUNIT)PDEBPT
      READ(IOUNIT)PDEBPS
C
      READ(IOUNIT)(IREGSW(I),I=1,MAXRG)
      READ(IOUNIT)(IREBLI(I),I=1,MAXRG)
      READ(IOUNIT)(IREBCO(I),I=1,MAXRG)
      READ(IOUNIT)(IREFSW(I),I=1,MAXRG)
      READ(IOUNIT)(IREFCO(I),I=1,MAXRG)
      READ(IOUNIT)(IREPTY(I),I=1,MAXRG)
      READ(IOUNIT)(IREPLI(I),I=1,MAXRG)
      READ(IOUNIT)(IREPCO(I),I=1,MAXRG)
      READ(IOUNIT)IDERSW
      READ(IOUNIT)IDERBL
      READ(IOUNIT)IDERBC
      READ(IOUNIT)IDERFS
      READ(IOUNIT)IDERFC
      READ(IOUNIT)IDERPT
      READ(IOUNIT)IDERPL
      READ(IOUNIT)IDERPC
C
      READ(IOUNIT)MAXREG
C
      READ(IOUNIT)(AREGBA(I),I=1,MAXRG)
      READ(IOUNIT)(AREGWI(I),I=1,MAXRG)
      READ(IOUNIT)(PREBTH(I),I=1,MAXRG)
      READ(IOUNIT)(PREPTH(I),I=1,MAXRG)
      READ(IOUNIT)(PREPSP(I),I=1,MAXRG)
      READ(IOUNIT)ADERBA
      READ(IOUNIT)ADERWI
      READ(IOUNIT)PDERBT
      READ(IOUNIT)PDERPT
      READ(IOUNIT)PDERPS
C
      READ(IOUNIT)(IMARSW(I),I=1,MAXMR)
      READ(IOUNIT)(IMABLI(I),I=1,MAXMR)
      READ(IOUNIT)(IMABCO(I),I=1,MAXMR)
      READ(IOUNIT)(IMAFSW(I),I=1,MAXMR)
      READ(IOUNIT)(IMAFCO(I),I=1,MAXMR)
      READ(IOUNIT)(IMAPTY(I),I=1,MAXMR)
      READ(IOUNIT)(IMAPLI(I),I=1,MAXMR)
      READ(IOUNIT)(IMAPCO(I),I=1,MAXMR)
      READ(IOUNIT)IDEMSW
      READ(IOUNIT)IDEMBL
      READ(IOUNIT)IDEMBC
      READ(IOUNIT)IDEMFS
      READ(IOUNIT)IDEMFC
      READ(IOUNIT)IDEMPT
      READ(IOUNIT)IDEMPL
      READ(IOUNIT)IDEMPC
C
      READ(IOUNIT)MAXMAR
C
      READ(IOUNIT)(AMARBA(I),I=1,MAXMR)
      READ(IOUNIT)(AMARWI(I),I=1,MAXMR)
      READ(IOUNIT)(PMABTH(I),I=1,MAXMR)
      READ(IOUNIT)(PMAPTH(I),I=1,MAXMR)
      READ(IOUNIT)(PMAPSP(I),I=1,MAXMR)
      READ(IOUNIT)ADEMBA
      READ(IOUNIT)ADEMWI
      READ(IOUNIT)PDEMBT
      READ(IOUNIT)PDEMPT
      READ(IOUNIT)PDEMPS
C
      READ(IOUNIT)(ITEXSW(I),I=1,MAXTX)
      READ(IOUNIT)(ITEBLI(I),I=1,MAXTX)
      READ(IOUNIT)(ITEBCO(I),I=1,MAXTX)
      READ(IOUNIT)(ITEFSW(I),I=1,MAXTX)
      READ(IOUNIT)(ITEFCO(I),I=1,MAXTX)
      READ(IOUNIT)(ITEPTY(I),I=1,MAXTX)
      READ(IOUNIT)(ITEPLI(I),I=1,MAXTX)
      READ(IOUNIT)(ITEPCO(I),I=1,MAXTX)
      READ(IOUNIT)IDETSW
      READ(IOUNIT)IDETBL
      READ(IOUNIT)IDETBC
      READ(IOUNIT)IDETFS
      READ(IOUNIT)IDETFC
      READ(IOUNIT)IDETPT
      READ(IOUNIT)IDETPL
      READ(IOUNIT)IDETPC
C
      READ(IOUNIT)MAXTEX
C
      READ(IOUNIT)(ATEXBA(I),I=1,MAXTX)
      READ(IOUNIT)(ATEXWI(I),I=1,MAXTX)
      READ(IOUNIT)(PTEBTH(I),I=1,MAXTX)
      READ(IOUNIT)(PTEPTH(I),I=1,MAXTX)
      READ(IOUNIT)(PTEPSP(I),I=1,MAXTX)
      READ(IOUNIT)ADETBA
      READ(IOUNIT)ADETWI
      READ(IOUNIT)PDETBT
      READ(IOUNIT)PDETPT
      READ(IOUNIT)PDETPS
C
C     -----END READING IN-----------------------
C
C               ***************************
C               **  STEP 42--            **
C               **  WRITE OUT A MESSAGE  **
C               ***************************
C
      ISTEPN='42'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IERROR.EQ.'YES')GOTO4290
      IF(IFEEDB.EQ.'OFF')GOTO4290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4211)
 4211 FORMAT('THE RESTORING OF ALL INTERNAL DATAPLOT VARIABLES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4212)
 4212 FORMAT('    PARAMETERS, ETC. HAS JUST BEEN COMPLETED')
      CALL DPWRST('XXX','BUG ')
 4290 CONTINUE
C
C               ***********************
C               **  STEP 51--        **
C               **  CLOSE THE FILE.  **
C               ***********************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'REST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='ON'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'REST')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPREST--')
      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 ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRETA(IBUGS2,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--TREAT THE RETAIN CASE--
C              RETAIN SPECIFIED ELEMENTS OF A VARIABLE
C              AND PACK THESE RETAINED ELEMENTS
C              INTO THE FIRST AVAILABLE LOCATIONS;
C              REDEFINE THE LENGTH OF THE PACKED VARIABLE.
C     INPUT --NECESSARILY A VARIABLE.
C     OUTPUT--NECESSARILY A VARIABLE.
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   2000. SUPPORT FOR VARIABLE LABELS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
      CHARACTER*4 ISTRIN
      CHARACTER*4 ISTRI2
      CHARACTER*4 INEX
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IFOUCO
      CHARACTER*4 IFOULP
      CHARACTER*4 IFOURP
      CHARACTER*4 IFOURN
      CHARACTER*4 IFOUVN
      CHARACTER*4 IVN
      CHARACTER*4 IVN2
      CHARACTER*4 IHVARJ
      CHARACTER*4 IHVRJ2
      CHARACTER*4 IHSET
      CHARACTER*4 IHSET2
      CHARACTER*4 IERRO1
      CHARACTER*4 ITYPCO
      CHARACTER*4 IHOLCO
      CHARACTER*4 IHLCO2
      CHARACTER*4 ITYPLP
      CHARACTER*4 IHOLLP
      CHARACTER*4 IHLLP2
      CHARACTER*4 ITYPRP
      CHARACTER*4 IHOLRP
      CHARACTER*4 IHLRP2
      CHARACTER*4 ITYPRN
      CHARACTER*4 IHOLRN
      CHARACTER*4 IHLRN2
      CHARACTER*4 ITYPVN
      CHARACTER*4 IHOLVN
      CHARACTER*4 IHLVN2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION ILISTV(100)
      DIMENSION TEMP(MAXOBV)
CCCCC FOLLOWING LINES ADDED FEBRUARY, 1994
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),TEMP(1))
CCCCC END CHANGE
C
      DIMENSION IVN(100)
      DIMENSION IVN2(100)
      DIMENSION IRN(100)
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='DPRE'
      ISUBN2='TA  '
C
      IPASS=0
      NUMDEL=0
      ISAVE=0
      IROD1O=0
      IRODNO=0
      IROW1O=0
      IROWNO=0
      ILQP1=0
C
C
      TEMPD=0.0
      VALD1O=0.0
      VALDNO=0.0
      VAL1O=0.0
      VALNO=0.0
C
C               *************************************************
C               **  TREAT THE RETAIN CASE                      **
C               **  RETAIN SPECIFIC ELEMENTS OF A VECTOR       **
C               **  AND PACK THOSE     ELEMENTS                **
C               **  INTO THE FIRST AVAILABLE LOCATIONS.        **
C               *************************************************
C
      IFOUND='YES'
      IERROR='NO'
C
      MAXDEL=100
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
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 DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,IERROR
   52 FORMAT('IBUGS2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXNAM,NUMNAM
   53 FORMAT('MAXNAM,NUMNAM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAXN,MAXCOL,NUMCOL
   54 FORMAT('MAXN,MAXCOL,NUMCOL = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO60I=1,NUMNAM
      WRITE(ICOUT,61)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
   61 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I)
   62 FORMAT('I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I)  = ',
     1I8,2X,A4,A4,6X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO70J=1,NUMCOL
      IJ=MAXN*(J-1)+1
      WRITE(ICOUT,71)J,MAXN,IJ,V(IJ)
   71 FORMAT('J,MAXN,IJ,V(IJ) = ',I8,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
   90 CONTINUE
C               *******************************************************
C               **  STEP 1--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1)GOTO190
      IERROR='YES'
      GOTO8900
  190 CONTINUE
      IFOUND='YES'
C
C               ***********************************************************
C               **  STEP 2--                                             **
C               **  DETERMINE THE SUBCASE BASED ON THE QUALIFIER.        **
C               **  SCAN TO CHECK IF 'SUBSET' OR 'FOR' IS PRESENT.       **
C               **  IF NOT PRESENT, THEN HAVE CASE 1--                   **
C               **  EXAMPLE--RETAIN X(4) Y(1) Z(46)                      **
C               **  IF PRESENT, THEN HAVE CASE 2--                       **
C               **  EXAMPLE--RETAIN X Y Z FOR I = 1 1 10                 **
C               **  DETERMINE THE LOCATION IN THE ARGUMENT LIST          **
C               **  OF 'SUBSET' OR 'FOR'.                                **
C               **  BRANCH TO THE APPROPRIATE SUBCASE                    **
C               **  FULL VERSUS SUBSET/FOR.                              **
C               ***********************************************************
C
      ISTEPN='2'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCQ=1
      ICASEQ='UNKN'
      IF(NUMARG.LE.0)GOTO290
      DO210J=1,NUMARG
      J2=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO220
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO220
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO230
  210 CONTINUE
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      GOTO300
C
  220 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J2
      GOTO7000
C
  230 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J2
      GOTO7000
C
  290 CONTINUE
C
C               ***********************************************************
C               **  STEP 3--                                             **
C               **  FOR THE FULL CASE,                                   **
C               **  EXTRACT EACH VARIABLE NAME AND EACH ARGUMENT VALUE.  **
C               ***********************************************************
C
      ISTEPN='3'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPASS=0
  300 CONTINUE
      IPASS=IPASS+1
C
      IF(1.LE.IPASS.AND.IPASS.LE.MAXDEL)GOTO310
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,301)
  301 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,302)
  302 FORMAT('      THE RETAIN COMMAND REQUIRES THAT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,303)
  303 FORMAT('      THE NUMBER OF VARIABLES WITH ELEMENTS ',
     1'TO BE RETAINED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,304)IPASS
  304 FORMAT('      BE BETWEEN 1 AND ',I8,' (INCLUSIVE);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,305)NUMDEL
  305 FORMAT('      THE SPECIFIED NUMBER WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,306)
  306 FORMAT('      THE INPUT COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,307)(IANS(I),I=1,IWIDTH)
  307 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
  310 CONTINUE
      IF(IPASS.GE.2)ISAVE=IENDRP
C
C               ****************************************************************
C               **  STEP 3.1--
C               **  IF THIS IS THE FIRST PASS ON THIS LINE (AND ONLY FOR PASS 1)
C               **  SEARCH FOR RETAIN (OTHERWISE SKIP THIS STEP)
C               **  SEARCH BETWEEN COLUMN 1 AND THE END OF THE LINE (INCLUSIVE).
C               ****************************************************************
C
      ISTEPN='3.1'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPASS.GE.2)GOTO319
C
      ISTAR1=1
      ISTOP1=IWIDTH
      ISTRIN='RETA'
      ISTRI2='IN  '
      INEX='II'
      CALL DPTY3B(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGS2,
     1             IFOUCO,IBEGCO,IENDCO,
     1             ITYPCO,IHOLCO,IHLCO2,INT1CO,FLOACO,IERRO1)
      IF(IFOUCO.EQ.'YES')GOTO319
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** INTERNAL ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE WORD      RETAIN      NOT FOUND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      ON THE ENTERED INPUT COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
  319 CONTINUE
C
C               ****************************************************************
C               **  STEP 3.2--
C               **  SEARCH FOR LEFT PARENTHESIS;
C               **  IF THIS IS THE FIRST PASS FOR THIS LINE,
C               **  SEARCH BETWEEN    RETAIN     AND      END OF LINE
C               **  (IF NO LEFT PARENTHESIS FOUND AT ALL, JUMP TO 7000).
C               **  IF THIS IS THE SECOND (OR HIGHER) PASS FOR THIS LINE,
C               **  SEARCH BETWEEN    PREVIOUS RIGHT PARENTHESIS AND
C               **  END OF LINE.
C               ****************************************************************
C
      ISTEPN='3.2'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPASS.LE.1)ISTAR1=IENDCO+1
      IF(IPASS.GE.2)ISTAR1=ISAVE+1
      ISTOP1=IWIDTH
      ISTRIN='('
      INEX='II'
      CALL DPTY3B(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGS2,
     1             IFOULP,IBEGLP,IENDLP,
     1             ITYPLP,IHOLLP,IHLLP2,INT1LP,FLOALP,IERRO1)
      IF(IFOULP.EQ.'YES')GOTO338
      IF(IFOULP.EQ.'NO'.AND.IPASS.GE.2)GOTO399
      GOTO7000
  338 CONTINUE
C
C               ****************************************************************
C               **  STEP 3.3--
C               **  SEARCH FOR RIGHT PARENTHESIS;
C               **  SEARCH BETWEEN    LEFT PARENTHESIS     AND    END OF LINE.
C               ****************************************************************
C
      ISTEPN='3.3'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTAR1=IENDLP+1
      ISTOP1=IWIDTH
      ISTRIN=')'
      INEX='II'
      CALL DPTY3B(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGS2,
     1             IFOURP,IBEGRP,IENDRP,
     1             ITYPRP,IHOLRP,IHLRP2,INT1RP,FLOARP,IERRO1)
      IF(IFOURP.EQ.'YES')GOTO358
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,341)
  341 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,342)
  342 FORMAT('      WHEN THE RETAIN COMMAND IS USED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,343)
  343 FORMAT('      WITHOUT A SUBSET QUALIFICATION, OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,344)
  344 FORMAT('      WITHOUT A FOR    QUALIFICATION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,345)
  345 FORMAT('      THEN ONLY INDIVIDUAL ELEMENTS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,346)
  346 FORMAT('      OF A VARIABLE MAY BE RETAINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,347)
  347 FORMAT('      SUCH INDIVIDUAL ELEMENTS ARE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,348)
  348 FORMAT('      SPECIFIED BY A VARIABLE NAME FOLLOWED BY A')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,349)
  349 FORMAT('      PAIR OF PARENTHSES WITH A ROW NUMBER WITHIN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,350)
  350 FORMAT('      HOWEVER, A RIGHT PARENTHESIS IS MISSING HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,351)
  351 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,352)(IANS(I),I=1,IWIDTH)
  352 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
  358 CONTINUE
C
C               ****************************************************************
C               **  STEP 3.4--
C               **  SEARCH FOR ROW NUMBER;
C               **  SEARCH BETWEEN    LEFT PARENTHESIS     AND     RIGHT PARENTH
C               ****************************************************************
C
      ISTEPN='3.4'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTAR1=IENDLP
      ISTOP1=IENDRP
      ISTRIN='(;)'
      INEX='EE'
      CALL DPTY3B(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGS2,
     1             IFOURN,IBEGRN,IENDRN,
     1             ITYPRN,IHOLRN,IHLRN2,INT1RN,FLOARN,IERRO1)
      IF(IFOURN.EQ.'YES')GOTO378
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,361)
  361 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,362)
  362 FORMAT('      WHEN THE RETAIN COMMAND IS USED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,363)
  363 FORMAT('      WITHOUT A SUBSET QUALIFICATION, OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,364)
  364 FORMAT('      WITHOUT A FOR    QUALIFICATION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,365)
  365 FORMAT('      THEN ONLY INDIVIDUAL ELEMENTS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,366)
  366 FORMAT('      OF A VARIABLE MAY BE RETAINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,367)
  367 FORMAT('      SUCH INDIVIDUAL ELEMENTS ARE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,368)
  368 FORMAT('      SPECIFIED BY A VARIABLE NAME FOLLOWED BY A')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,369)
  369 FORMAT('      PAIR OF PARENTHSES WITH A ROW NUMBER WITHIN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,370)
  370 FORMAT('      HOWEVER, A ROW NUMBER IS MISSING HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,371)
  371 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,352)(IANS(I),I=1,IWIDTH)
  372 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
  378 CONTINUE
C
C               ****************************************************************
C               **  STEP 3.5--
C               **  SEARCH FOR VARIABLE NAME;
C               **  IF THIS IS THE FIRST PASS FOR THIS LINE,
C               **  SEARCH BETWEEN    RETAIN     AND      LEFT PARENTHESIS;
C               **  IF THIS IS THE SECOND (OR HIGHER) PASS FOR THIS LINE,
C               **  SEARCH BETWEEN    PREVIOUS RIGHT PARENTHESIS AND
C               **  THE NEXT LEFT PARENTHESIS.
C               ****************************************************************
C
      ISTEPN='3.5'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPASS.LE.1)ISTAR1=IENDCO+1
      IF(IPASS.GE.2)ISTAR1=ISAVE+1
      ISTOP1=IENDLP
      ISTRIN='!;('
      INEX='IE'
      CALL DPTY3B(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGS2,
     1             IFOUVN,IBEGVN,IENDVN,
     1             ITYPVN,IHOLVN,IHLVN2,INT1VN,FLOAVN,IERRO1)
      IF(IFOUVN.EQ.'YES')GOTO398
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,381)
  381 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,382)
  382 FORMAT('      WHEN THE RETAIN COMMAND IS USED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,383)
  383 FORMAT('      WITHOUT A SUBSET QUALIFICATION, OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,384)
  384 FORMAT('      WITHOUT A FOR    QUALIFICATION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,385)
  385 FORMAT('      THEN ONLY INDIVIDUAL ELEMENTS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,386)
  386 FORMAT('      OF A VARIABLE MAY BE RETAINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,387)
  387 FORMAT('      SUCH INDIVIDUAL ELEMENTS ARE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,388)
  388 FORMAT('      SPECIFIED BY A VARIABLE NAME FOLLOWED BY A')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,389)
  389 FORMAT('      PAIR OF PARENTHSES WITH A ROW NUMBER WITHIN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,390)
  390 FORMAT('      HOWEVER, A VARIABLE NAME IS MISSING HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,391)
  391 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,392)(IANS(I),I=1,IWIDTH)
  392 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
  398 CONTINUE
      IVN(IPASS)=IHOLVN
      IVN2(IPASS)=IHLVN2
      IRN(IPASS)=INT1RN
C
      GOTO300
C
  399 CONTINUE
      NUMDEL=IPASS-1
C
C               ***************************************************************
C               **  STEP 4--                                                 **
C               **  FOR THE FULL CASE,                                       **
C               **  CHECK TO MAKE SURE ALL VARIABLES WITH RETENTIONS          **
C               **  ARE, IN FACT, IN THE INTERNAL LIST,                      **
C               **  AND ARE, IN FACT, VARIABLES (AS OPPOSED TO PARAMETERS).  **
C               ***************************************************************
C
  400 CONTINUE
C
      ISTEPN='4'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO420J=1,NUMDEL
      J2=J
      IHVARJ=IVN(J)
      IHVRJ2=IVN2(J)
      DO430I=1,NUMNAM
      I2=I
      IF(IHVARJ.EQ.IHNAME(I).AND.IHVRJ2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO440
      IF(IHVARJ.EQ.IHNAME(I).AND.IHVRJ2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO450
  430 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,431)
  431 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,432)
  432 FORMAT('      A VARIABLE WITH ELEMENTS TO BE RETAINED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,434)
  434 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,435)IHVARJ,IHVRJ2
  435 FORMAT('      THE VARIABLE NAME WAS ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,436)
  436 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,437)(IANS(I),I=1,IWIDTH)
  437 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
  440 CONTINUE
      ILISTV(J2)=I2
      GOTO420
C
  450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,451)
  451 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,452)
  452 FORMAT('      A VARIABLE WITH ELEMENTS TO BE RETAINED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,454)
  454 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,455)
  455 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,456)
  456 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,457)IHVARJ,IHVRJ2
  457 FORMAT('      THE VARIABLE NAME WAS ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,458)
  458 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,459)(IANS(I),I=1,IWIDTH)
  459 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
  420 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  TREAT THE FULL CASE.               **
C               **  CARRY OUT THE RETAINING,            **
C               **  AND THE SUBSEQUENT PACKING,        **
C               **  DO THE LIST UPDATING, AND          **
C               **  PRODUCE SOME INFORMATIVE PRINTING. **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO500J=1,NUMDEL
      IHVARJ=IVN(J)
      IHVRJ2=IVN2(J)
      IROWD=IRN(J)
      ILIST2=ILISTV(J)
      NIVARJ=IN(ILIST2)
      ICOLVJ=IVALUE(ILIST2)
      IMAX=NIVARJ
      IF(1.LE.IROWD.AND.IROWD.LE.IMAX)GOTO539
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,531)
  531 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,532)IROWD
  532 FORMAT('      THE SPECIFIED ROW ELEMENT (= ROW ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,533)IHVARJ,IHVRJ2
  533 FORMAT('      TO BE RETAINED FROM VARIABLE ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,534)
  534 FORMAT('      WAS SMALLER THAN 1, OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,535)IMAX
  535 FORMAT('      WAS LARGER THAN THE CURRENT (= ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,536)
  536 FORMAT('      NUMBER OF ELEMENTS IN THIS VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
  539 CONTINUE
C
      NS2=0
      ND2=0
      DO550I=1,IMAX
      IF(I.NE.IROWD)GOTO560
      GOTO570
C
  560 CONTINUE
      ND2=ND2+1
      IJ=MAXN*(ICOLVJ-1)+I
      IF(ICOLVJ.LE.MAXCOL)TEMPD=V(IJ)
      IF(ICOLVJ.EQ.MAXCP1)TEMPD=PRED(I)
      IF(ICOLVJ.EQ.MAXCP2)TEMPD=RES(I)
      IF(ICOLVJ.EQ.MAXCP3)TEMPD=YPLOT(I)
      IF(ICOLVJ.EQ.MAXCP4)TEMPD=XPLOT(I)
      IF(ICOLVJ.EQ.MAXCP5)TEMPD=X2PLOT(I)
      IF(ICOLVJ.EQ.MAXCP6)TEMPD=TAGPLO(I)
      IF(ND2.EQ.1)IROD1O=I
      IRODNO=I
      IF(ND2.EQ.1)VALD1O=TEMPD
      VALDNO=TEMPD
      GOTO550
C
  570 CONTINUE
      NS2=NS2+1
      IJ=MAXN*(ICOLVJ-1)+I
      IF(ICOLVJ.LE.MAXCOL)TEMP(NS2)=V(IJ)
      IF(ICOLVJ.EQ.MAXCP1)TEMP(NS2)=PRED(I)
      IF(ICOLVJ.EQ.MAXCP2)TEMP(NS2)=RES(I)
      IF(ICOLVJ.EQ.MAXCP3)TEMP(NS2)=YPLOT(I)
      IF(ICOLVJ.EQ.MAXCP4)TEMP(NS2)=XPLOT(I)
      IF(ICOLVJ.EQ.MAXCP5)TEMP(NS2)=X2PLOT(I)
      IF(ICOLVJ.EQ.MAXCP6)TEMP(NS2)=TAGPLO(I)
      IF(NS2.EQ.1)IROW1O=I
      IROWNO=I
      IF(NS2.EQ.1)VAL1O=TEMP(NS2)
      VALNO=TEMP(NS2)
      GOTO550
C
  550 CONTINUE
      NIOLD=NIVARJ
      NINEW=NS2
      IROW1N=1
      IROWNN=NS2
C
      IF(NS2.GE.1)GOTO580
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('***** INTERNAL ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      FOR THE FULL (UNQUALIFIED) CASE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      SINCE THE RESULTING NS2 = 0,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)
  584 FORMAT('      THE NUMBER OF ELEMENTS RETAINED = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)IHVARJ,IHVRJ2,IMAX,IROWD
  585 FORMAT('      IHVARJ, IHVRJ2, IMAX, IROWD = ',2A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,590)
  590 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,591)(IANS(I),I=1,IWIDTH)
  591 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
  580 CONTINUE
      DO600I=1,NS2
      IJ=MAXN*(ICOLVJ-1)+I
      IF(ICOLVJ.LE.MAXCOL)V(IJ)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP1)PRED(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP2)RES(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=TEMP(I)
  600 CONTINUE
C
      DO602J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLVJ)GOTO605
      GOTO602
  605 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLVJ
      VALUE(J4)=ICOLVJ
      IN(J4)=NINEW
      IVSTAR(J4)=MAXN*(ICOLVJ-1)+1
      IVSTOP(J4)=MAXN*(ICOLVJ-1)+NINEW
  602 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,611)IHVARJ,IHVRJ2,NIOLD
  611 FORMAT('VARIABLE ',2A4,'--OLD NUMBER OF ELEMENTS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,612)NINEW
  612 FORMAT('                   NEW NUMBER OF ELEMENTS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,613)VALD1O
  613 FORMAT('                   FIRST VALUE DELETED    = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,614)IROD1O
  614 FORMAT('                         (DELETED FROM ROW ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,615)VALDNO
  615 FORMAT('                   LAST  VALUE DELETED    = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,616)IRODNO
  616 FORMAT('                         (DELETED FROM ROW ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,617)VAL1O
  617 FORMAT('                   FIRST VALUE RETAINED   = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,618)IROW1O,IROW1N
  618 FORMAT('                         (MOVED FROM ROW ',I8,
     1' TO ROW ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,619)VALNO
  619 FORMAT('                   LAST  VALUE RETAINED   = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,620)IROWNO,IROWNN
  620 FORMAT('                         (MOVED FROM ROW ',I8,
     1' TO ROW ',I8,')')
      CALL DPWRST('XXX','BUG ')
  629 CONTINUE
C
  500 CONTINUE
C
      GOTO8900
C
C               ***************************************************************
C               **  STEP 7--                                                 **
C               **  FOR THE SUBSET AND FOR CASES                            **
C               **  (AND WHEN RETAINING ENTIRE VARIABLES),
C               **  CHECK TO MAKE SURE ALL VARIABLES WITH RETENTIONS          **
C               **  ARE, IN FACT, IN THE INTERNAL LIST,                      **
C               **  AND ARE, IN FACT, VARIABLES (AS OPPOSED TO PARAMETERS).  **
C               ***************************************************************
C
 7000 CONTINUE
C
      ISTEPN='7'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMDEL=ILOCQ-1
      IF(1.LE.NUMDEL.AND.NUMDEL.LE.MAXDEL)GOTO7100
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7101)
 7101 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7102)
 7102 FORMAT('      THE RETAIN COMMAND REQUIRES THAT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7103)
 7103 FORMAT('      THE NUMBER OF VARIABLES WITH ELEMENTS ',
     1'TO BE RETAINED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7104)MAXDEL
 7104 FORMAT('      BE BETWEEN 1 AND ',I8,' (INCLUSIVE);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7105)NUMDEL
 7105 FORMAT('      THE SPECIFIED NUMBER WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7106)
 7106 FORMAT('      THE INPUT COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7107)(IANS(I),I=1,IWIDTH)
 7107 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
 7100 CONTINUE
      DO7200J=1,NUMDEL
      J2=J
      IHVARJ=IHARG(J)
      IHVRJ2=IHARG2(J)
      DO7300I=1,NUMNAM
      I2=I
      IF(IHVARJ.EQ.IHNAME(I).AND.IHVRJ2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO7400
      IF(IHVARJ.EQ.IHNAME(I).AND.IHVRJ2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO7500
 7300 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7301)
 7301 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7302)
 7302 FORMAT('      A VARIABLE WITH ELEMENTS TO BE RETAINED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7304)
 7304 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7305)IHVARJ,IHVRJ2
 7305 FORMAT('      THE VARIABLE NAME WAS ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7306)
 7306 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7307)(IANS(I),I=1,IWIDTH)
 7307 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
 7400 CONTINUE
      ILISTV(J2)=I2
      GOTO7200
C
 7500 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7501)
 7501 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7502)
 7502 FORMAT('      A VARIABLE WITH ELEMENTS TO BE RETAINED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7504)
 7504 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7505)
 7505 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7506)
 7506 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7507)IHVARJ,IHVRJ2
 7507 FORMAT('      THE VARIABLE NAME WAS ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7508)
 7508 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7509)(IANS(I),I=1,IWIDTH)
 7509 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
 7200 CONTINUE
C
C               *****************************************
C               **  STEP 8--                           **
C               **  TREAT THE SUBSET AND FOR CASES     **
C               **  AND CERTAIN FULL CASES.            **
C               **  CARRY OUT THE RETAINING,            **
C               **  AND THE SUBSEQUENT PACKING,        **
C               **  DO THE LIST UPDATING, AND          **
C               **  PRODUCE SOME INFORMATIVE PRINTING. **
C               *****************************************
C
      ISTEPN='8'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO8100
      ILQP1=ILOCQ+1
      IF(ILQP1.LE.NUMARG)GOTO8100
      IF(ICASEQ.EQ.'FOR')GOTO8030
      GOTO8010
C
 8010 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)
 8012 FORMAT('      THE WORD    SUBSET    WAS THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8013)
 8013 FORMAT('      FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8014)
 8014 FORMAT('      THE WORD    SUBSET   SHOULD HAVE BEEN FOLLOWED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8015)
 8015 FORMAT('      BY EITHER 2 OR 3 ARGUMENTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8016)
 8016 FORMAT('      THE FIRST ARGUMENT SPECIFIES THE SUBSET ',
     1'VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8017)
 8017 FORMAT('      THE SECOND AND (IF EXISTENT) THIRD ARGUMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8018)
 8018 FORMAT('      SPECIFY THE VALUE OR INTERVAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8019)
 8019 FORMAT('      (OF THE SUBSET VARIABLE) WHICH DEFINES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8020)
 8020 FORMAT('      THE SUBSET OF INTEREST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8021)
 8021 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,8022)(IANS(I),I=1,IWIDTH)
 8022 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
 8030 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8031)
 8031 FORMAT('***** ERROR IN DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8032)
 8032 FORMAT('      THE WORD    FOR    WAS THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8033)
 8033 FORMAT('      FINAL WORD ON THE COMMAND LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8034)
 8034 FORMAT('      THE WORD    FOR    SHOULD HAVE BEEN FOLLOWED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8035)
 8035 FORMAT('      BY EXACTLY 3 OR BY EXACTLY 5    WORDS   --')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8036)
 8036 FORMAT('      1) A DUMMY VARIABLE NAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8037)
 8037 FORMAT('      2) AN EQUAL SIGN;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8038)
 8038 FORMAT('      3) ONE LIMIT (LOWER OR UPPER) ',
     1'FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8039)
 8039 FORMAT('      4) THE INCREMENT FOR THE DUMMY VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9040)
 9040 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,9041)
 9041 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,9042)(IANS(I),I=1,IWIDTH)
 9042 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
 8100 CONTINUE
      IF(ICASEQ.EQ.'FULL')GOTO8130
      IF(ICASEQ.EQ.'FOR')GOTO8120
      IHSET=IHARG(ILQP1)
      IHSET2=IHARG2(ILQP1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO8110
C
 8110 CONTINUE
      NISET=IN(ILOC)
      CALL DPSUBS(NISET,ILOCS,NS,IBUGQ,IERROR)
      NQ=NISET
      GOTO8200
C
 8120 CONTINUE
      NIOLD=MAXN
      CALL DPFOR(NIOLD,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NINEW
      GOTO8200
C
 8130 CONTINUE
      DO8135I=1,MAXN
      ISUB(I)=1
 8135 CONTINUE
      NQ=MAXN
      GOTO8200
C
 8200 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO8300J=1,NUMDEL
      IHVARJ=IHARG(J)
      IHVRJ2=IHARG2(J)
      ILIST2=ILISTV(J)
      NIVARJ=IN(ILIST2)
      ICOLVJ=IVALUE(ILIST2)
      NS2=0
      ND2=0
      IMAX=NQ
      IF(NIVARJ.LT.NQ)IMAX=NIVARJ
      DO8400I=1,IMAX
      IF(ISUB(I).EQ.1)GOTO8450
C
      ND2=ND2+1
      IJ=MAXN*(ICOLVJ-1)+I
      IF(ICOLVJ.LE.MAXCOL)TEMPD=V(IJ)
      IF(ICOLVJ.EQ.MAXCP1)TEMPD=PRED(I)
      IF(ICOLVJ.EQ.MAXCP2)TEMPD=RES(I)
      IF(ICOLVJ.EQ.MAXCP3)TEMPD=YPLOT(I)
      IF(ICOLVJ.EQ.MAXCP4)TEMPD=XPLOT(I)
      IF(ICOLVJ.EQ.MAXCP5)TEMPD=X2PLOT(I)
      IF(ICOLVJ.EQ.MAXCP6)TEMPD=TAGPLO(I)
      IF(ND2.EQ.1)IROD1O=I
      IRODNO=I
      IF(ND2.EQ.1)VALD1O=TEMPD
      VALDNO=TEMPD
      GOTO8400
C
 8450 CONTINUE
      NS2=NS2+1
      IJ=MAXN*(ICOLVJ-1)+I
      IF(ICOLVJ.LE.MAXCOL)TEMP(NS2)=V(IJ)
      IF(ICOLVJ.EQ.MAXCP1)TEMP(NS2)=PRED(I)
      IF(ICOLVJ.EQ.MAXCP2)TEMP(NS2)=RES(I)
      IF(ICOLVJ.EQ.MAXCP3)TEMP(NS2)=YPLOT(I)
      IF(ICOLVJ.EQ.MAXCP4)TEMP(NS2)=XPLOT(I)
      IF(ICOLVJ.EQ.MAXCP5)TEMP(NS2)=X2PLOT(I)
      IF(ICOLVJ.EQ.MAXCP6)TEMP(NS2)=TAGPLO(I)
      IF(NS2.EQ.1)IROW1O=I
      IROWNO=I
      IF(NS2.EQ.1)VAL1O=TEMP(NS2)
      VALNO=TEMP(NS2)
      GOTO8400
C
 8400 CONTINUE
      NIOLD=NIVARJ
      NINEW=NS2
      IROW1N=1
      IROWNN=NS2
C
      IF(ND2.GE.1)GOTO8550
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8501)
C8501 FORMAT('***** NOTE--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8502)
C8502 FORMAT('      NO DELETING/RETAINING WAS CARRIED OUT;')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8503)
C8503 FORMAT('      POSSIBLE CAUSES--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8504)
C8504 FORMAT('      1) A NULL    SUBSET    SPECIFICATION;')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8505)
C8505 FORMAT('      2) A NULL    FOR       SPECIFICATION;')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8506)
C8506 FORMAT('      3) THE ELEMENTS TO BE RETAINED')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8507)
C8507 FORMAT('         DID NOT EXIST. ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8510)
C8510 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IF(IWIDTH.GE.1)WRITE(ICOUT,8511)(IANS(I),I=1,IWIDTH)
C8511 FORMAT('      ',100A1)
CCCCC IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8900
C
 8550 CONTINUE
      DO8500I=1,NS2
      IJ=MAXN*(ICOLVJ-1)+I
      IF(ICOLVJ.LE.MAXCOL)V(IJ)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP1)PRED(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP2)RES(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=TEMP(I)
      IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=TEMP(I)
 8500 CONTINUE
C
      NS2P1=NS2+1
      IF(NS2P1.GT.IMAX)GOTO8569
      DO8560I=NS2P1,IMAX
      IJ=MAXN*(ICOLVJ-1)+I
      IF(ICOLVJ.LE.MAXCOL)V(IJ)=CPUMIN
      IF(ICOLVJ.EQ.MAXCP1)PRED(I)=CPUMIN
      IF(ICOLVJ.EQ.MAXCP2)RES(I)=CPUMIN
      IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=CPUMIN
      IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=CPUMIN
      IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=CPUMIN
      IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=CPUMIN
 8560 CONTINUE
 8569 CONTINUE
C
      DO8600J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLVJ)GOTO8605
      GOTO8600
 8605 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLVJ
      VALUE(J4)=ICOLVJ
      IN(J4)=NINEW
      IVSTAR(J4)=MAXN*(ICOLVJ-1)+1
      IVSTOP(J4)=MAXN*(ICOLVJ-1)+NINEW
 8600 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO8629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8611)IHVARJ,IHVRJ2,NIOLD
 8611 FORMAT('VARIABLE ',2A4,'--OLD NUMBER OF ELEMENTS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8612)NINEW
 8612 FORMAT('                   NEW NUMBER OF ELEMENTS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8613)VALD1O
 8613 FORMAT('                   FIRST VALUE DELETED    = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8614)IROD1O
 8614 FORMAT('                         (DELETED FROM ROW ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8615)VALDNO
 8615 FORMAT('                   LAST  VALUE DELETED    = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8616)IRODNO
 8616 FORMAT('                         (DELETED FROM ROW ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8617)VAL1O
 8617 FORMAT('                   FIRST VALUE RETAINED   = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8618)IROW1O,IROW1N
 8618 FORMAT('                         (MOVED FROM ROW ',I8,
     1' TO ROW ',I8,'  )')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8619)VALNO
 8619 FORMAT('                   LAST  VALUE RETAINED   = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8620)IROWNO,IROWNN
 8620 FORMAT('                         (MOVED FROM ROW ',I8,
     1' TO ROW ',I8,')')
      CALL DPWRST('XXX','BUG ')
 8629 CONTINUE
C
 8300 CONTINUE
C
      GOTO8900
C
C               **********************************
C               **  STEP 9--                    **
C               **  UPDATE INTERNAL DATA ARRAY  **
C               **  (IF NECESSARY)              **
C               **********************************
C
 8900 CONTINUE
C
      ISTEPN='9'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC OCTOBER 1993.  ADD IVALU2 TO ARGUMENT LIST.
CCCCC CALL DPUPDV(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN,
      CALL DPUPDV(IHNAME,IHNAM2,IUSE,IVALUE,IVALU2,VALUE,IN,
     1IVARLB,
     1IVSTAR,IVSTOP,MAXNAM,NUMNAM,V,MAXN,MAXCOL,NUMCOL,
     1IBUGS2,IERROR)
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 DPRETA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IERROR
 9012 FORMAT('IBUGS2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXNAM,NUMNAM
 9013 FORMAT('MAXNAM,NUMNAM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)MAXN,MAXCOL,NUMCOL
 9014 FORMAT('MAXN,MAXCOL,NUMCOL = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,NUMNAM
      WRITE(ICOUT,9021)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
 9021 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I)
 9022 FORMAT('I,IHNAME(I),IHNAM2(I),IN(I),IVSTAR(I),IVSTOP(I)  = ',
     1I8,2X,A4,A4,6X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9030J=1,NUMCOL
      IJ=MAXN*(J-1)+1
      WRITE(ICOUT,9031)J,MAXN,IJ,V(IJ)
 9031 FORMAT('J,MAXN,IJ,V(IJ) = ',I8,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRETN(IHARG,NUMARG,IDEFTN,IRECTN,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY THE NAME OF THE VARIABLE TO PUT
C              THE TOLERANCE LIMIT VALUES CALCULATED FROM
C              A RECIPE FIT/ANOVA COMMAND
C
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFTN (A  CHARACTER VARIABLE)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--IRECTN (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/8
C     ORIGINAL VERSION--AUGUST   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*8 IDEFTN
      CHARACTER*8 IRECTN
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*8 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRETN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFTN
   53 FORMAT('IDEFTN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)THEN
        IHOLD=IDEFTN
      ELSEIF(NUMARG.GE.2)THEN
        IHOLD=IHARG(NUMARG) 
        IF(IHARG(NUMARG).EQ.'OFF')IHOLD=IDEFTN
        IF(IHARG(NUMARG).EQ.'NO')IHOLD=IDEFTN
        IF(IHARG(NUMARG).EQ.'NONE')IHOLD=IDEFTN
        IF(IHARG(NUMARG).EQ.'FALS')IHOLD=IDEFTN
        IF(IHARG(NUMARG).EQ.'ON')IHOLD=IDEFTN
        IF(IHARG(NUMARG).EQ.'YES')IHOLD=IDEFTN
        IF(IHARG(NUMARG).EQ.'TRUE')IHOLD=IDEFTN
        IF(IHARG(NUMARG).EQ.'DEFA')IHOLD=IDEFTN
      ENDIF
C
      IFOUND='YES'
      IRECTN=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IRECTN
 1181 FORMAT(
     1'THE TOLERANCE LIMITS FROM SUBSEQUENT RECIPE FIT/ANOVA COMMANDS',
     1' WILL BE SAVED IN THE VARIABLE ',A8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1189 CONTINUE
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRETN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDEFTN
 9013 FORMAT('IDEFTN = ',A8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IRECTN
 9014 FORMAT('IRECTN = ',A8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRF(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1CLLIMI,CLWIDT,
     1ICONT,NUMHPP,IMANUF,
     1XMATN,YMATN,XMITN,YMITN,
     1ISQUAR,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IX3AUT,ITIAUT,
     1ICAPSW,
     1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IFOUND,IERROR)
C
C     PURPOSE--GENERATE A R-F SPREAD PLOT WHICH CONSISTS OF
C              THE FOLLOWING 2 SIDE-BY-SIDE PLOTS
C                 1) A PLOT OF FITTED VALUES (MINUS MEAN)
C                 2) A PLOT OF THE RESIDUALS
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/9
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES---------------
C
      INCLUDE 'DPCOPA.INC'
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICONT
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
C
      CHARACTER*4 IBUGUG
      CHARACTER*4 IBUGU2
      CHARACTER*4 IBUGU3
      CHARACTER*4 IBUGU4
C
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISQUAR
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
      CHARACTER*4 IREPCH
      CHARACTER*4 IMPSW
C
      CHARACTER*4 IERAS2
      CHARACTER*4 ICOPS2
      CHARACTER*4 ICHAP2
      CHARACTER*4 ILINP2
C
      CHARACTER*4 IFEED9
C
      CHARACTER*4 IANSPP
      CHARACTER*4 IANSRP
C
      CHARACTER*4 IMANUF
C
      CHARACTER*4 IX3AUT
      CHARACTER*4 ITIAUT
C
      CHARACTER*4 IPPTSV
      CHARACTER*4 ITUNSV
      CHARACTER*4 IY1MNS
      CHARACTER*4 IY1MXS
      CHARACTER*4 IY2MNS
      CHARACTER*4 IY2MXS
      CHARACTER*4 IY1SV
      CHARACTER*4 IY2SV
      CHARACTER*4 IY1ZSV
      CHARACTER*4 IY2ZSV
C
      CHARACTER*4 ITITSV(MAXCH)
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C-----------------------------------------------------------------
C
      DIMENSION CLLIMI(*)
      DIMENSION CLWIDT(*)
C
      DIMENSION IANSPP(20)
      DIMENSION IANSRP(20)
C
C-----COMMON------------------------------------------------------
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.INC'
C
      DIMENSION PREDSV(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),PREDSV(1))
C
C-----COMMON VARIABLES (GENERAL)----------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS---------------------------------------------
C
      DATA (IANSPP(I),I=1,18)
     1/'Q   ','U   ','A   ','N   ','T   ','I   ','L   ','E   ',
     1 '    ',
     1 'P   ','L   ','O   ','T   ',
     1 '    ',
     1 'P   ','R   ','E   ','D   '/
      DATA (IANSRP(I),I=1,17)
     1/'Q   ','U   ','A   ','N   ','T   ','I   ','L   ','E   ',
     1 '    ',
     1 'P   ','L   ','O   ','T   ',
     1 '    ',
     1 'R   ','E   ','S   '/
C
C-----START POINT-------------------------------------------------
C
      IFOUND='YES'
      IERROR='NO'
C
      ISUBN1='DPRF'
      ISUBN2='    '
C
      ICASPL='RFPL'
      NDONE=0
      NCPP=18
      NCRP=17
C
C               ******************************************
C               **  TREAT THE RF-PLOT ... ANALYSIS CASE **
C               ******************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO69
      DO61I=1,NUMARG
      WRITE(ICOUT,62)I,IHARG(I),IARGT(I)
   62 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   69 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **   STEP 20--                                  **
C               **   SAVE INITIAL SETTINGS                      **
C               **************************************************
C
      ISTEPN='20'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'4PLO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      PWXMN2=PWXMIN
      PWXMX2=PWXMAX
      PWYMN2=PWYMIN
      PWYMX2=PWYMAX
      IERAS2=IERASW
      ICOPS2=ICOPSW
      ICHAP2=ICHAPA(1)
      ILINP2=ILINPA(1)
      IFEED9=IFEEDB
      DO110I=1,MAXCH
        ITITSV(I)=ITITTE(I)
  110 CONTINUE
      NCTITS=NCTITL
      PTITDZ=PTITDS
      IPPTSV=IPPTBI
      ITUNSV=ITICUN
      PX1TS1=PX1TOL
      PX1TS2=PX1TOR
C
      GY1MNS=GY1MIN
      GY1MXS=GY1MAX
      GY2MNS=GY2MIN
      GY2MXS=GY2MAX
      IY1MNS=IY1MIN
      IY1MXS=IY1MAX
      IY2MNS=IY2MIN
      IY2MXS=IY2MAX
      IY1SV=IY1TSW
      IY2SV=IY2TSW
      IY1ZSV=IY1ZSW
      IY2ZSV=IY2ZSW
C
      PXMNSV=PXMIN
      PXMXSV=PXMAX
C
      IH11='PRED'
      IH12='    '
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      ICOL=IVALUE(ILOCV)
      N1=IN(ILOCV)
C
      DO510I=1,N1
        PREDSV(I)=PRED(I)
  510 CONTINUE
      IWRITE='OFF'
      CALL MEAN(PRED,N1,IWRITE,PMEAN,IBUGG3,IERROR)
      DO520I=1,N1
        PRED(I)=PRED(I)-PMEAN
  520 CONTINUE
C
C               ***************************************************
C               **   STEP 21--                                   **
C               **   GENERATE THE PREDICTED VALUES QUANTILE PLOT **
C               ***************************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'DPRF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      PWXMIN=0.0
      PWXMAX=50.0
      PWYMIN=0.0
      PWYMAX=100.0
      PXMIN=15.0
      PXMAX=100.0
      ICOPSW='OFF'
      IPPTBI='UNBI'
      DO2105I=1,MAXCH
        IX3LTE(I)=' '
        ITITTE(I)='    '
 2105 CONTINUE
      ITITTE(1)='F'
      ITITTE(2)='i'
      ITITTE(3)='t'
      ITITTE(4)='t'
      ITITTE(5)='e'
      ITITTE(6)='d'
      ITITTE(7)=' '
      ITITTE(8)='V'
      ITITTE(9)='a'
      ITITTE(10)='l'
      ITITTE(11)='u'
      ITITTE(12)='e'
      ITITTE(13)='s'
      ITICUN='SCRE'
      NCTITL=13
      PX1TOL=5.0
      PX1TOR=5.0
      IY1TSW='ON'
      IY2TSW='OFF'
      IY1ZSW='ON'
      IY2ZSW='OFF'
      PTITDS=3.0
      NCY1SA=NCY1LA
C
      ICOM='PERC'
      IHARG(1)='POIN'
      IHARG2(1)='T   '
      IHARG(2)='PLOT'
      IHARG2(2)='    '
      IHARG(3)='PRED'
      IHARG2(3)='    '
      NUMARG=3
      CALL DPPERC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO2800
C
      J=0
      DO2111I=1,NCPP
      J=J+1
      IF(IX3AUT.EQ.'ON')IX3LTE(J)=IANSPP(I)
      IF(ITIAUT.EQ.'ON')ITITTE(J)=IANSPP(I)
 2111 CONTINUE
      IF(IX3AUT.EQ.'ON')NCTITL=J
      IF(ITIAUT.EQ.'ON')NCTITL=J
      GOTO2500
C
C               ***************************************************
C               **   STEP 22--                                   **
C               **   GENERATE THE RESIDUAL VALUES QUANTILE PLOT  **
C               ***************************************************
C
 2200 CONTINUE
      ISTEPN='22'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'DPRF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      PWXMIN=50.0
      PWXMAX=100.0
      PWYMIN=0.0
      PWYMAX=100.0
      PXMIN=0.0
      PXMAX=85.0
      ICOPSW='OFF'
      IERASW='OFF'
      DO2210I=1,MAXCH
      IX3LTE(I)=' '
      ITITTE(I)=' '
 2210 CONTINUE
      ITITTE(1)='R'
      ITITTE(2)='e'
      ITITTE(3)='s'
      ITITTE(4)='i'
      ITITTE(5)='d'
      ITITTE(6)='u'
      ITITTE(7)='a'
      ITITTE(8)='l'
      ITITTE(9)=' '
      ITITTE(10)='V'
      ITITTE(11)='a'
      ITITTE(12)='l'
      ITITTE(13)='u'
      ITITTE(14)='e'
      ITITTE(15)='s'
      NCTITL=15
C
      GY1MIN=FY1MNZ
      GY1MAX=FY1MXZ
      GY2MIN=FY2MNZ
      GY2MAX=FY2MXZ
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      IY2MIN='FIXE'
      IY2MAX='FIXE'
      IY1TSW='OFF'
      IY2TSW='ON'
      IY1ZSW='OFF'
      IY2ZSW='ON'
      NCY1LA=0
C
      ICOM='PERC'
      IHARG(1)='POIN'
      IHARG2(1)='T   '
      IHARG(2)='PLOT'
      IHARG2(2)='    '
      IHARG(3)='RES '
      IHARG2(3)='    '
      NUMARG=3
      CALL DPPERC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO2800
C
      J=0
      DO2211I=1,NCRP
      J=J+1
      IF(IX3AUT.EQ.'ON')IX3LTE(J)=IANSRP(I)
      IF(ITIAUT.EQ.'ON')ITITTE(J)=IANSRP(I)
 2211 CONTINUE
      GOTO2500
C
C               **************************************************
C               **   STEP 25--                                  **
C               **   PLOT THE CURRENT PLOT (OUT OF THE 4)       **
C               **************************************************
 2500 CONTINUE
C
      ICONT=IDCONT(1)
      NUMHPP=IDNHPP(1)
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,2507)IMANUF,NUMDEV,IDMANU(1)
 2507 FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IMPARG=2
      CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1XMATN,YMATN,XMITN,YMITN,
     1ISQUAR,
     1IVGMSW,IHGMSW,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1YPLOT,XPLOT,X2PLOT,TAGPLO,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1IMPARG,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1MAXCOL,
     1DSIZE,DSYMB,DCOLOR,DFILL,
     1ICAPSW,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IERROR)
      IF(IERROR.EQ.'NO')IAND1=IAND2
      IF(IERROR.EQ.'YES')GOTO2800
      NDONE=NDONE+1
      IF(NDONE.LE.1)GOTO2200
      GOTO2800
C
C               **************************************************
C               **   STEP 28--                                  **
C               **   REINSTATE INITIAL SETTINGS                 **
C               **************************************************
C
 2800 CONTINUE
      ISTEPN='28'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'4PLO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,2807)IMANUF,NUMDEV,IDMANU(1)
 2807 FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      PWXMIN=PWXMN2
      PWXMAX=PWXMX2
      PWYMIN=PWYMN2
      PWYMAX=PWYMX2
      IERASW=IERAS2
      ICOPSW=ICOPS2
      ICHAPA(1)=ICHAP2
      ILINPA(1)=ILINP2
      IFEEDB=IFEED9
      DO2809I=1,MAXCH
        ITITTE(I)=ITITSV(I)
 2809 CONTINUE
      NCTITL=NCTITS
      PTITDS=PTITDZ
      NCY1LA=NCY1SA
      IPPTBI=IPPTSV
      ITICUN=ITUNSV
      PX1TOL=PX1TS1
      PX1TOR=PX1TS2
C
      GY1MIN=GY1MNS
      GY1MAX=GY1MXS
      GY2MIN=GY2MNS
      GY2MAX=GY2MXS
      IY1MIN=IY1MNS
      IY1MAX=IY1MXS
      IY2MIN=IY2MNS
      IY2MAX=IY2MXS
      IY1TSW=IY1SV
      IY2TSW=IY2SV
      IY1ZSW=IY1ZSV
      IY2ZSW=IY2ZSV
      PXMIN=PXMNSV
      PXMAX=PXMXSV
      DO2820I=1,N1
        PRED(I)=PREDSV(I)
 2820 CONTINUE
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMARG
 9014 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9029
      DO9021I=1,NUMARG
      WRITE(ICOUT,9022)I,IHARG(I),IARGT(I)
 9022 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9029 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRFCO(IHARG,NUMARG,IDERFC,MAXREG,IREFCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE REGION FILL COLORS = THE COLORS
C              OF THE (BACKGROUND) FILL WITHIN THE REGIONS.
C              THESE ARE LOCATED IN THE VECTOR IREFCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDERFC
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IREFCO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDERFC
      CHARACTER*4 IREFCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IREFCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPRF'
      ISUBN2='CO  '
C
      NUMREG=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDERFC
   55 FORMAT('IDERFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IREFCO(1)
   70 FORMAT('IREFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IREFCO(I)
   76 FORMAT('I,IREFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      IREFCO(1)=IDERFC
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-2
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDERFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDERFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERFC
      IREFCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,IREFCO(I)
 1276 FORMAT('THE FILL COLOR OF REGION ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDERFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDERFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERFC
      DO1315I=1,NUMREG
      IREFCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IREFCO(I)
 1316 FORMAT('THE FILL COLOR OF ALL REGIONS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDERFC
 9015 FORMAT('IDERFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IREFCO(1)
 9030 FORMAT('IREFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IREFCO(I)
 9036 FORMAT('I,IREFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRFSW(IHARG,NUMARG,IDERFS,MAXREG,IREFSW,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE REGION FILL SWITCHES = THE ON/OFF SWITCHES
C              OF THE (BACKGROUND) FILL WITHIN THE REGIONS.
C              THESE ARE LOCATED IN THE VECTOR IREFSW(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDERFS
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IREFSW (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDERFS
      CHARACTER*4 IREFSW
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IREFSW(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPRF'
      ISUBN2='SW  '
C
      NUMREG=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDERFS
   55 FORMAT('IDERFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IREFSW(1)
   70 FORMAT('IREFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IREFSW(I)
   76 FORMAT('I,IREFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='ON'
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      IREFSW(1)='ON'
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-2
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERFS
      IREFSW(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,IREFSW(I)
 1276 FORMAT('THE FILL SWITCH FOR REGION ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERFS
      DO1315I=1,NUMREG
      IREFSW(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IREFSW(I)
 1316 FORMAT('THE FILL SWITCH FOR ALL REGIONS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDERFS
 9015 FORMAT('IDERFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IREFSW(1)
 9030 FORMAT('IREFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IREFSW(I)
 9036 FORMAT('I,IREFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRING(IHARG,IARGT,IARG,NUMARG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--RING THE BELL IMMEDIATELY
C              FOR A SPECIFIED NUMBER OF RINGS.
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                 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           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         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C
C-----NON-COMMON VARIABLES----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
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
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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
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
      ISUBN1='DPCO'
      ISUBN2='SC  '
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMRIN=1
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 DPRING--')
      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 ')
      WRITE(ICOUT,55)NUMRIN
   55 FORMAT('NUMRIN = ',I8)
      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.GE.1.AND.IARGT(NUMARG).EQ.'NUMB')GOTO1120
      GOTO1110
C
 1110 CONTINUE
      NUMRIN=1
      GOTO1150
C
 1120 CONTINUE
      NUMRIN=IARG(NUMARG)
      GOTO1150
C
 1150 CONTINUE
      IFOUND='YES'
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 RING BELL CASE          **
C               ****************************************
C
      ISTEPN='2.1'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMRIN.LE.0)GOTO1290
      DO1200I=1,NUMRIN
      IF(IBUGD2.EQ.'ON')WRITE(ICOUT,1205)
 1205 FORMAT('***** THE BELL SHOULD SOUND NOW *****')
      IF(IBUGD2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      CALL GRRIBE
 1200 CONTINUE
 1290 CONTINUE
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 DPRING--')
      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 ')
      WRITE(ICOUT,9015)NUMRIN
 9015 FORMAT('NUMRIN = ',I8)
      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 DPRK(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
CCCCC THE FOLLOWING LINE WAS AUGMENTED   SEPTEMBER 1993
CCCCC1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IERROR)
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,IERROR)
C
C     PURPOSE--TREAT THE LET CASE FOR
C              FINDING THE RUNGE-KUTTA SOLITION
C              OF A DIFFERENTIAL EQUATION
C              (FOR A FULL OR PARTIAL DATA SET)
C     EXAMPLE--LET Y = RUNGE-KUTTA EXP(X-Y) X
C            --LET Y = RUNGE-KUTTA F X
C     NOTE--THIS SUBROUTINE OPERATES ON A FUNCTION AND A VECTOR
C           AND PRODUCES A VECTOR.
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1987.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --APRIL     1992. MANY SMALL CHANGES
C     UPDATED         --SEPTEMBER 1993. ADD INPUT ARGUMENT ISUBRO
C     UPDATED         --SEPTEMBER 1993. ADD ISUBRO TO TRACE STATEMENTS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASL7
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
CCCCC THE FOLLOWING LINE WAS ADDED    SEPTEMBER 1993
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
      CHARACTER*4 IFOUND
C
      CHARACTER*4 NEWNA1
      CHARACTER*4 NEWNA2
      CHARACTER*4 NEWCOL
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IWRITE
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 ITCASE
CCCCC CHARACTER*4 IACASE
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
CCCCC THE FOLLOWING 6 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 IHRI21
CCCCC CHARACTER*4 IHRI22
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
C
      CHARACTER*4 ILEF11
      CHARACTER*4 ILEF12
      CHARACTER*4 ILEF21
      CHARACTER*4 ILEF22
      CHARACTER*4 IHSET
      CHARACTER*4 IHSET2
C
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
C
      CHARACTER*4 NEWNAM
CCCCC THE FOLLOWING 3 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 IHOUT
CCCCC CHARACTER*4 IHOUT2
CCCCC CHARACTER*4 IUOUT
      CHARACTER*4 IDUMV
      CHARACTER*4 IDUMV2
      CHARACTER*4 IHPARN
      CHARACTER*4 IHPAR2
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 IHL
CCCCC CHARACTER*4 IHL2
      CHARACTER*4 IWD1
      CHARACTER*4 IWD2
      CHARACTER*4 IWD12
      CHARACTER*4 IWD22
      CHARACTER*4 ILAB
CCCCC THE FOLLOWING 6 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 IKEY
CCCCC CHARACTER*4 IKEY2
CCCCC CHARACTER*4 INCLUN
CCCCC CHARACTER*4 ICASEL
CCCCC CHARACTER*4 IFOUN1
CCCCC CHARACTER*4 IFOUN2
      CHARACTER*4 IERRO2
CCCCC THE FOLLOWING 4 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 IOLD
CCCCC CHARACTER*4 IOLD2
CCCCC CHARACTER*4 INEW
CCCCC CHARACTER*4 INEW2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IH1
      CHARACTER*4 IH2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IA(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
C
      DIMENSION IDUMV(100)
      DIMENSION IDUMV2(100)
C
      DIMENSION ILAB(10)
CCCCC THE FOLLOWING 4 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC DIMENSION IOLD(10)
CCCCC DIMENSION IOLD2(10)
CCCCC DIMENSION INEW(10)
CCCCC DIMENSION INEW2(10)
C
      DIMENSION AJUNK(MAXOBV)
C
      DIMENSION TEMPX(MAXOBV)
      DIMENSION TEMPY(MAXOBV)
      DIMENSION TEMPYD(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR42),AJUNK(1))
      EQUIVALENCE (G2RBAG(IGAR43),TEMPX(1))
      EQUIVALENCE (G2RBAG(IGAR44),TEMPY(1))
      EQUIVALENCE (G2RBAG(IGAR45),TEMPYD(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPRK'
      ISUBN2='    '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      ILOCMX=0
      NUMLIM=0
      ILOC3=0
      IP=0
      IV=0
      LOCDUM=0
C
      IFOUND='NO'
      IERROR='NO'
C
      NEWNA1='NO'
      NEWNA2='NO'
      NUMVAL=1
C
      ICOLY=(-999)
      ICOLYD=(-999)
C
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
      ICASL7='RK'
C
C               *******************************************
C               **  TREAT THE RUNGE-KUTTA    SUBCASE     **
C               **  OF THE LET COMMAND                   **
C               *******************************************
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'DPRK')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,ISUBRO
   52 FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGCO,IBUGEV
   53 FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGQ
   54 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICASL7
   61 FORMAT('ICASL7 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNA1='NO'
      NEWCOL='NO'
C
      NEWNAM='NO'
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=4
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
C
C
C               ****************************************************************
C               **  STEP 2A--                                                  *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE FIRST  VARIABLE NAME TO LEFT OF = SIGN              *
C               **  ALREADY IN THE NAME LIST?    AS A VARIABLE?                *
C               **  NOTE THAT     ILEF11     IS THE NAME OF THE VARIABLE
C               **  ON THE LEFT.                                               *
C               **  NOTE THAT     ILISL1    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               **  NOTE THAT     ICOLL1    IS THE DATA COLUMN (1 TO 12)
C               **  FOR THE NAME OF THE LEFT.                                  *
C               ****************************************************************
C
      ISTEPN='2A'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILEF11=IHARG(1)
      ILEF12=IHARG2(1)
      DO210I=1,NUMNAM
      I2=I
      IF(ILEF11.EQ.IHNAME(I).AND.ILEF12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO230
      IF(ILEF11.EQ.IHNAME(I).AND.ILEF12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO280
  210 CONTINUE
C
CCCCC NEWNA1='YES'
CCCCC ILISL1=NUMNAM+1
CCCCC IF(ILISL1.GT.MAXNAM)GOTO220
CCCCC GOTO235
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,211)
  211 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,212)
  212 FORMAT('      FOR RUNGE-KUTTA,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,213)
  213 FORMAT('      THE FIRST VARIABLE TO THE LEFT OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,214)ILEF11,ILEF12
  214 FORMAT('      EQUAL SIGN (IN THIS CASE,  ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,215)
  215 FORMAT('      MUST PRE-EXIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,216)
  216 FORMAT('      AND MUST HAVE AS ITS FIRST ELEMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,217)
  217 FORMAT('      YOUR DESIRED INITIAL VALUE.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,221)
  221 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,222)
  222 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,223)MAXNAM
  223 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,224)
  224 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,225)
  225 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,226)
  226 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,227)
  227 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,228)
  228 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  230 CONTINUE
      NUMVAL=1
      ILISL1=I2
      GOTO235
C
  235 CONTINUE
      NIOLD=0
      ICOLL1=NUMCOL+1
      IF(ICOLL1.GT.MAXCOL)GOTO240
      GOTO290
  240 CONTINUE
      WRITE(ICOUT,241)
  241 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,242)
  242 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,243)MAXCOL
  243 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,244)
  244 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,245)
  245 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,246)
  246 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,247)
  247 FORMAT('      AND THEN DELETE SOME COLUMNS.   ')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  280 CONTINUE
      NUMVAL=1
      ILISL1=I2
      ICOLL1=IVALUE(ILISL1)
      NIOLD=IN(ILISL1)
  290 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'DPRK')GOTO299
      WRITE(ICOUT,291)
  291 FORMAT('AT THE END OF STEP 2A--')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC WRITE(ICOUT,292)ILEF11,ILEF12,NEWNA1,NUMNAM,ILISL1,NUMCOL,ICOLL1,NIOLD
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,292)ILEF11,ILEF12,NEWNA1,NUMNAM,ILISL1,NUMCOL,ICOLL1,
     1NIOLD
  292 FORMAT('ILEF11,ILEF12,NEWNA1,NUMNAM,ILISL1,NUMCOL,ICOLL1,',
     1'NIOLD = ',A4,A4,2X,A4,2X,5I8)
      CALL DPWRST('XXX','BUG ')
  299 CONTINUE
C
C               ****************************************************************
C               **  STEP 2B--                                                  *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE SECOND VARIABLE NAME TO LEFT OF = SIGN              *
C               **  ALREADY IN THE NAME LIST?    AS A VARIABLE?                *
C               **  NOTE THAT     ILEF21     IS THE NAME OF THE VARIABLE
C               **  ON THE LEFT.                                               *
C               **  NOTE THAT     ILISL2    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               **  NOTE THAT     ICOLL2    IS THE DATA COLUMN (1 TO 12)
C               **  FOR THE NAME OF THE LEFT.                                  *
C               ****************************************************************
C
      ISTEPN='2B'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IHARG(2).EQ.'=')GOTO399
      ILEF21=IHARG(2)
      ILEF22=IHARG2(2)
      DO310I=1,NUMNAM
      I2=I
      IF(ILEF21.EQ.IHNAME(I).AND.ILEF22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO330
      IF(ILEF21.EQ.IHNAME(I).AND.ILEF22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO380
  310 CONTINUE
C
CCCCC NEWNA2='YES'
CCCCC ILISL2=NUMNAM+1
CCCCC IF(ILISL2.GT.MAXNAM)GOTO320
CCCCC GOTO335
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      FOR RUNGE-KUTTA,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      THE SECOND VARIABLE TO THE LEFT OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)ILEF21,ILEF22
  314 FORMAT('      EQUAL SIGN (IN THIS CASE,  ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)
  315 FORMAT('      MUST PRE-EXIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      AND MUST HAVE AS ITS FIRST ELEMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      YOUR DESIRED INITIAL VALUE.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,333)MAXNAM
  333 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  330 CONTINUE
      NUMVAL=2
      ILISL2=I2
      GOTO335
C
  335 CONTINUE
      NIOLD=0
      ICOLL2=NUMCOL+1
      IF(ICOLL2.GT.MAXCOL)GOTO340
      GOTO390
  340 CONTINUE
      WRITE(ICOUT,341)
  341 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,342)
  342 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,343)MAXCOL
  343 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,344)
  344 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,345)
  345 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,346)
  346 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,347)
  347 FORMAT('      AND THEN DELETE SOME COLUMNS.   ')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  380 CONTINUE
      NUMVAL=2
      ILISL2=I2
      ICOLL2=IVALUE(ILISL2)
CCCCC NIOLD=IN(ILISL2)
  390 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'DPRK')GOTO399
      WRITE(ICOUT,391)
  391 FORMAT('AT THE END OF STEP 2--')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC WRITE(ICOUT,392)ILEF21,ILEF22,NEWNA2,NUMNAM,ILISL2,NUMCOL,ICOLL2,NIOLD
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,392)ILEF21,ILEF22,NEWNA2,NUMNAM,ILISL2,NUMCOL,ICOLL2,
     1NIOLD
  392 FORMAT('ILEF21,ILEF22,NEWNA1,NUMNAM,ILISL2,NUMCOL,ICOLL2,',
     1'NIOLD = ',A4,A4,2X,A4,2X,5I8)
      CALL DPWRST('XXX','BUG ')
  399 CONTINUE
C
C               ****************************************************************
C               **  STEP 4--                                                   *
C               **  FIND    THE VARIABLE ON THE RIGHT-HAND SIDE--              *
C               **  (THIS WILL BE THE VARIABLE OF DIFFERENTIATION AND          *
C               **  HORIZONTAL AXIS VARIABLE.                                  *
C               **  HAS THIS VARIABLE ON THE RIGHT                             *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISR1                                       *
C               **  IS THE LINE IN THE TABLE                                   *
C               **  OF THIS       VARIABLE ON THE RIGHT.                       *
C               **  NOTE THAT     ICOLR1                                       *
 
C               **  IS THE DATA COLUMN (1 TO 10+6)                             *
C               **  OF THIS       VARIABLE ON THE RIGHT.                       *
C               ****************************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 4.1--                            **
C               **  DETERMINE THE LOCATION                **
C               **  OF THE VARIABLE ON THE RIGHT          **
C               ********************************************
C
      ISTEPN='4.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=1
C
      DO1005I=4,NUMARG
      I2=I
      IH1=IHARG(I)
      IH2=IHARG2(I)
      IF(IH1.EQ.'SUBS'.AND.IH2.EQ.'ET  ')GOTO1007
      IF(IH1.EQ.'EXCE'.AND.IH2.EQ.'PT  ')GOTO1007
      IF(IH1.EQ.'FOR '.AND.IH2.EQ.'    ')GOTO1007
 1005 CONTINUE
      ILOCQ=NUMARG+1
      GOTO1009
 1007 CONTINUE
      ILOCQ=I2
      GOTO1009
 1009 CONTINUE
      ILOCR1=ILOCQ-1
      ILOCR2=ILOCR1+1
      ILOCR3=ILOCR1+2
      ILOCR4=ILOCR1+3
CCCCC THE FOLLOWING 2 LINES WERE ADDED   APRIL 1992
      ILOCR5=ILOCR1+4
      ILOCR6=ILOCR1+5
C
C               ***************************************
C               **  STEP 5.1--                       **
C               **  EXAMINE THIS VARIABLE            **
C               **  ON THE RIGHT.                    **
C               ***************************************
C
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      DO1120I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1190
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1140
 1120 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE SPECIFIED DIFFERENTIATION VARIABLE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      ON THE FAR RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)IHRI11,IHRI12
 1127 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1129)(IANS(I),I=1,IWIDTH)
 1129 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 1140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      THE SPECIFIED DIFFERENTIATION VARIABLE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      ON THE FAR RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1145)
 1145 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1146)
 1146 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1147)
 1147 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1148)
 1148 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1149)(IANS(I),I=1,IWIDTH)
 1149 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 1190 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
C               *******************************
C               **  STEP 7--                 **
C               **  DETERMINE THE SUBCASE    **
C               **  AND BRANCH ACCORDINGLY.  **
C               *******************************
C
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ILOCR1.EQ.NUMARG)GOTO8000
      IF(ILOCR1.LT.NUMARG.AND.IHARG(ILOCR2).EQ.'SUBS'.AND.
     1IHARG2(ILOCR2).EQ.'ET  ')GOTO9000
      IF(ILOCR1.LT.NUMARG.AND.IHARG(ILOCR2).EQ.'EXCE'.AND.
     1IHARG2(ILOCR2).EQ.'PT  ')GOTO9000
      IF(ILOCR1.LT.NUMARG.AND.IHARG(ILOCR2).EQ.'FOR '.AND.
     1IHARG2(ILOCR2).EQ.'    ')GOTO10000
      GOTO7080
C
 7080 CONTINUE
      WRITE(ICOUT,7081)
 7081 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7082)
 7082 FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7083)
 7083 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7084)(IANS(I),I=1,IWIDTH)
 7084 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7088)ILOCR1,NUMVAR
 7088 FORMAT('ILOCR1,NUMVAR = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
C               ************************************************
C               **  STEP 8--                                  **
C               **  TREAT THE FULL VARIABLE CASE.             **
C               **  THEN JUMP TO STEP NUMBER 10 BELOW         **
C               **  FOR THE LIST UPDATING AND                 **
C               **  FOR SOME INFORMATIVE PRINTING.            **
C               ************************************************
C
C
 8000 CONTINUE
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1WRITE(ICOUT,8011)NINEW,NIRIG1
 8011 FORMAT('NINEW,NIRIG1 = ',2I8)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      ICASEQ='FULL'
      NIOLD=NIRIG1
CCCCC IF(NUMVAR.GE.2.AND.NIRIG2.GT.NIOLD)NIOLD=NIRIG2
      IF(NUMVAR.GE.2.AND.NIRIG1.GT.NIOLD)NIOLD=NIRIG1
C     MORE HERE FOR NUMVAR = 3 ????? APRIL 1987
      NINEW=NIOLD
      DO8100I=1,NINEW
      ISUB(I)=1
 8100 CONTINUE
      GOTO11000
C
C               ****************************************************************
C               **  STEP 9--                                                   *
C               **  TREAT THE PARTIAL VARIABLE SUBSET CASE.                    *
C               **  JUMP TO STEP NUMBER 11 BELOW                               *
C               **  FOR THE ACTUAL MATHEMATICAL OPERATION,                    *
C               **  FOR THE LIST UPDATING, AND                                 *
C               **  FOR SOME INFORMATIVE PRINTING.                             *
C               ****************************************************************
C
 9000 CONTINUE
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='SUBS'
      IF(NUMVAR.EQ.1)ILOCSV=ILOCR3
      IF(NUMVAR.EQ.2)ILOCSV=ILOCR4
      IF(NUMVAR.EQ.3)ILOCSV=ILOCR5
      IF(NUMVAR.EQ.4)ILOCSV=ILOCR6
      IHSET=IHARG(ILOCSV)
      IHSET2=IHARG2(ILOCSV)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      NIOLD=IN(ILOC)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
CCCCC NINEW=NS
      NINEW=NIOLD
      GOTO11000
C
C               ****************************************************************
C               **  STEP 10--                                                  *
C               **  TREAT THE PARTIAL VARIABLE FOR CASE.                       *
C               **  JUMP TO STEP NUMBER 11 BELOW                               *
C               **  FOR THE ACTUAL MATHEMATICAL OPERATION,                    *
C               **  FOR THE LIST UPDATING, AND                                 *
C               **  FOR SOME INFORMATIVE PRINTING.                             *
C               ****************************************************************
C
10000 CONTINUE
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FOR'
      CALL DPFOR(NIOLD,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIFOR=NINEW
      GOTO11000
C
C               *******************************************
C               **  STEP 11.1--                          **
C               **  FILL TEMPORARY VARIBLES.             **
C               **  EXTRACT AND EXAMINE THE FUNCTION.    **
C               **  CARRY OUT THE                        **
C               **  RUNGE-KUTTA CALCULATIONS,            **
C               **  THE LIST UPDATING, AND               **
C               **  GENERATE THE INFORMATIVE PRINTING    **
C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
C               *******************************************
C
11000 CONTINUE
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NITEMX=NINEW
      NS1=0
      NS2=0
      NS3=0
      NS4=0
 
CCCCC IMAX=NINEW
CCCCC IF(ICASEQ.EQ.'FOR'.AND.IMAX.GT.NIFOR)IMAX=NIFOR
CCCCC DO11100I=1,IMAX
C
      DO11100I=1,NINEW
      IJ=MAXN*(ICOLR1-1)+I
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1WRITE(ICOUT,11101)I,NS1,NINEW,ISUB(I),IJ,V(IJ)
11101 FORMAT('I,NS1,NINEW,ISUB(I),IJ,V(IJ) = ',5I8,F12.5)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(ISUB(I).EQ.0)GOTO11100
C
      IF(I.GT.NIRIG1)GOTO11190
      NS1=NS1+1
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)TEMPX(NS1)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)TEMPX(NS1)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)TEMPX(NS1)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)TEMPX(NS1)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)TEMPX(NS1)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)TEMPX(NS1)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)TEMPX(NS1)=TAGPLO(I)
C
      IJ=MAXN*(ICOLL1-1)+I
      IF(ICOLL1.LE.MAXCOL)TEMPY(NS1)=V(IJ)
      IF(ICOLL1.EQ.MAXCP1)TEMPY(NS1)=PRED(I)
      IF(ICOLL1.EQ.MAXCP2)TEMPY(NS1)=RES(I)
      IF(ICOLL1.EQ.MAXCP3)TEMPY(NS1)=YPLOT(I)
      IF(ICOLL1.EQ.MAXCP4)TEMPY(NS1)=XPLOT(I)
      IF(ICOLL1.EQ.MAXCP5)TEMPY(NS1)=X2PLOT(I)
      IF(ICOLL1.EQ.MAXCP6)TEMPY(NS1)=TAGPLO(I)
C
      IF(NUMVAL.LE.1)GOTO11100
      IJ=MAXN*(ICOLL2-1)+I
      IF(ICOLL2.LE.MAXCOL)TEMPYD(NS1)=V(IJ)
      IF(ICOLL2.EQ.MAXCP1)TEMPYD(NS1)=PRED(I)
      IF(ICOLL2.EQ.MAXCP2)TEMPYD(NS1)=RES(I)
      IF(ICOLL2.EQ.MAXCP3)TEMPYD(NS1)=YPLOT(I)
      IF(ICOLL2.EQ.MAXCP4)TEMPYD(NS1)=XPLOT(I)
      IF(ICOLL2.EQ.MAXCP5)TEMPYD(NS1)=X2PLOT(I)
      IF(ICOLL2.EQ.MAXCP6)TEMPYD(NS1)=TAGPLO(I)
C
11100 CONTINUE
C
11190 CONTINUE
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1WRITE(ICOUT,11191)ICOLL1,ICOLL2,ICOLR1,NS1,NUMVAL
11191 FORMAT('ICOLL1,ICOLL2,ICOLR1,NS1,NUMVAL = ',5I8)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1WRITE(ICOUT,11192)NINEW,ICASL7,ICASEQ
11192 FORMAT('NINEW,ICASL7,ICASEQ = ',I8,2X,A4,2X,A4)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IWRITE='ON'
      IF(IPRINT.EQ.'OFF')IWRITE='OFF'
      IF(IFEEDB.EQ.'OFF')IWRITE='OFF'
C
C               ***************************************************************
C               **  STEP 11.2--                                              **
C               **  EXTRACT THE RIGHT-SIDE FUNCTIONAL
C               **  EXPRESSION FROM THE INPUT COMMAND LINE                   **
C               **  (STARTING WITH THE FIRST NON-BLANK LOCATION AFTER THE    **
C               **  WORD    KUTTA     AND ENDING WITH THE NEXT TO THE LAST   **
C               **  WORD.                                                    **
C               **  PLACE THE FUNCTION IN IFUNC2(.)  .                       **
C               ***************************************************************
C
      ISTEPN='11.2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.5)GOTO11210
C
      IWD1=IHARG(4)
      IWD12=IHARG2(4)
      IF(NUMVAL.GE.2)IWD1=IHARG(5)
      IF(NUMVAL.GE.2)IWD12=IHARG2(5)
      IWD2=IHARG(ILOCR1)
      IWD22=IHARG2(ILOCR1)
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      IF(IFOUND.EQ.'YES')GOTO11290
C
11210 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11211)
11211 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11212)
11212 FORMAT('      INVALID COMMAND FORM FOR RUNGE-KUTTA.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11213)
11213 FORMAT('      GENERAL FORM FOR FIRST ORDER--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11214)
11214 FORMAT('         LET Y = RUNGE-KUTTA F X')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11215)
11215 FORMAT('      GENERAL FORM FOR SECOND ORDER--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11216)
11216 FORMAT('         LET Y YP = RUNGE-KUTTA F X')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11217)
11217 FORMAT('      WHERE F IS A FUNCTION OF X, Y, AND YP.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11218)
11218 FORMAT('      (AND YP = Y PRIME = DERIVATIVE OF Y WRT X)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11219)
11219 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,11220)(IANS(I),I=1,IWIDTH)
11220 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
11290 CONTINUE
C
C               ***********************************************************
C               **  STEP 11.3--                                          **
C               **  DETERMINE IF THE EXPRESSION HAS ANY FUNCTION NAMES   **
C               **  INBEDDED.  IF SO, REPLACE THE FUNCTION NAMES         **
C               **  BY EACH FUNCTION'S DEFINITION.  DO SO REPEATEDLY     **
C               **  UNTIL ALL FUNCTION REFERENCES HAVE BEEN ANNIHILATED  **
C               **  AND THE EXPRESSION IS LEFT ONLY WITH                 **
C               **  CONSTANTS, PARAMETERS, AND VARIABLES--NO FUNCTIONS.  **
C               **  PLACE THE RESULTING FUNCTIONAL EXPRESSION INTO IFUNC3(.) **
C               ***********************************************************
C
      ISTEPN='11.3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'DPRK')GOTO11390
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='INPU'
      ILAB(2)='T FU'
      ILAB(3)='NCTI'
      ILAB(4)='ON  '
      ILAB(5)='    '
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      WRITE(ICOUT,11311)IDUMV(1),IDUMV2(1)
11311 FORMAT('DIFFERENTIATION  = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
C
11390 CONTINUE
C
C               ************************************************************
C               **  STEP 11.4--                                           **
C               **  DETERMINE THE DUMMY VARIABLE IN THE DIFFERENTIATION.  **
C               ************************************************************
C
      ISTEPN='11.4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IDUMV(1)=IHRI11
      IDUMV2(1)=IHRI12
      IDUMV(2)=ILEF11
      IDUMV2(2)=ILEF12
      NUMDV=2
      IF(NUMVAL.GE.2)IDUMV(3)=ILEF21
      IF(NUMVAL.GE.2)IDUMV2(3)=ILEF22
      IF(NUMVAL.GE.2)NUMDV=3
C
C               **********************************************************
C               **  STEP 11.5--                                         **
C               **  MAKE A NON-CALCULATING PASS AT THE FUNCTION         **
C               **  SO AS TO EXTRACT ALL PARAMETER AND VARIABLE NAMES.  **
C               **********************************************************
C
      ISTEPN='11.5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPASS=1
      CALL COMPIM(IFUNC3,N3,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,AJUNK,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
C
C               ********************************************
C               **  STEP 11.6--                           **
C               **  TREAT THE SPECIAL CASE WHERE          **
C               **  THE HORIZONTAL AXIS AND/OR THE        **
C               **  VERTICAL AXIS VARIABLE DOES NOT       **
C               **  EXPLICITLY APPEAR IN THE FUNCTON;     **
C               **  IN SUCH CASE, AUGMENT THE PARAMETER   **
C               **  LIST WITH THE 1 (OR 2) VARIABLES.     **
C               ********************************************
C
      ISTEPN='11.6'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMPV.LE.0)GOTO11611
      DO11610I=1,NUMPV
      I2=I
      IF(IHRI11.EQ.IPARN(I).AND.IHRI12.EQ.IPARN2(I))GOTO11619
11610 CONTINUE
11611 CONTINUE
      NUMPV=NUMPV+1
      IPARN(NUMPV)=IHRI11
      IPARN2(NUMPV)=IHRI12
11619 CONTINUE
C
      IF(NUMPV.LE.0)GOTO11621
      DO11620I=1,NUMPV
      I2=I
      IF(ILEF11.EQ.IPARN(I).AND.ILEF12.EQ.IPARN2(I))GOTO11629
11620 CONTINUE
11621 CONTINUE
      NUMPV=NUMPV+1
      IPARN(NUMPV)=ILEF11
      IPARN2(NUMPV)=ILEF12
11629 CONTINUE
C
      IF(NUMVAL.LE.1)GOTO11639
      IF(NUMPV.LE.0)GOTO11631
      DO11630I=1,NUMPV
      I2=I
      IF(ILEF21.EQ.IPARN(I).AND.ILEF22.EQ.IPARN2(I))GOTO11639
11630 CONTINUE
11631 CONTINUE
      NUMPV=NUMPV+1
      IPARN(NUMPV)=ILEF21
      IPARN2(NUMPV)=ILEF22
11639 CONTINUE
C
C               ***********************************************
C               **  STEP 11.7--                              **
C               **  CHECK THAT ALL PARAMETERS                **
C               **  IN THE FUNCTION ARE ALREADY PRESENT      **
C               **  IN THE AVAILABLE NAME LIST IHNAME(.).    **
C               ***********************************************
C
      ISTEPN='11.7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IP=0
      IV=0
      IF(NUMPV.LE.0)GOTO11750
      DO11700J=1,NUMPV
      IHPARN=IPARN(J)
      IHPAR2=IPARN2(J)
      IF(IHPARN.EQ.IDUMV(3).AND.IHPAR2.EQ.IDUMV2(3))GOTO11730
      IF(IHPARN.EQ.IDUMV(2).AND.IHPAR2.EQ.IDUMV2(2))GOTO11730
      IF(IHPARN.EQ.IDUMV(1).AND.IHPAR2.EQ.IDUMV2(1))GOTO11730
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHPARN,IHPAR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IF(IERRO2.EQ.'YES')GOTO11710
      GOTO11720
C
11710 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11711)
11711 FORMAT('***** ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11712)
11712 FORMAT('      A PARAMETER/FUNCTION HAS BEEN ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11713)
11713 FORMAT('      IN THE FUNCTION TO BE RUNGE-KUTTA SOLVED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11714)
11714 FORMAT('      WHICH HAS NOT YET BEEN DEFINED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11715)
11715 FORMAT('      THE UNKNOWN PARAMETER/FUNCTION = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11716)
11716 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,11717)(IANS(I),I=1,IWIDTH)
11717 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
11720 CONTINUE
      IP=IP+1
      PARAM(J)=VALUE(ILOCP)
      GOTO11700
C
11730 CONTINUE
      IV=IV+1
      LOCDUM=J
11700 CONTINUE
11750 CONTINUE
C
C               ********************************************
C               **  STEP 11.8--                           **
C               **  DETERMINE WHERE IN THE PARAM(.) LIST  **
C               **  THE HORIZ. AXIS VARIABLE LAY,         **
C               **  THE VERT. AXIS VARIABLE LAY,          **
C               **  AND (IF AN ORDER 2 EQUATION) WHERE    **
C               **  THE DERIVATIVE AXIS VARIABLE LAY.     **
C               ********************************************
C
      ISTEPN='11.8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCHV=(-999)
      IF(NUMPV.LE.0)GOTO11811
      DO11810I=1,NUMPV
      I2=I
      IF(IHRI11.EQ.IPARN(I).AND.IHRI12.EQ.IPARN2(I))GOTO11815
11810 CONTINUE
11811 CONTINUE
      WRITE(ICOUT,11812)
11812 FORMAT('***** INTERNAL ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11813)IHRI11,IHRI12
11813 FORMAT('       ',A4,A4,' NOT FOUND IN COMPIM PARAMETER LIST')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
11815 CONTINUE
      ILOCHV=I2
C
      ILOCVV=(-999)
      IF(NUMPV.LE.0)GOTO11821
      DO11820I=1,NUMPV
      I2=I
      IF(ILEF11.EQ.IPARN(I).AND.ILEF12.EQ.IPARN2(I))GOTO11825
11820 CONTINUE
11821 CONTINUE
      WRITE(ICOUT,11822)
11822 FORMAT('***** INTERNAL ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11823)ILEF11,ILEF12
11823 FORMAT('       ',A4,A4,' NOT FOUND IN COMPIM PARAMETER LIST')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
11825 CONTINUE
      ILOCVV=I2
C
      ILOCDV=(-999)
      IF(NUMVAL.LE.1)GOTO11839
      IF(NUMPV.LE.0)GOTO11831
      DO11830I=1,NUMPV
      I2=I
      IF(ILEF21.EQ.IPARN(I).AND.ILEF22.EQ.IPARN2(I))GOTO11835
11830 CONTINUE
11831 CONTINUE
      WRITE(ICOUT,11832)
11832 FORMAT('***** INTERNAL ERROR IN DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11833)ILEF21,ILEF22
11833 FORMAT('       ',A4,A4,' NOT FOUND IN COMPIM PARAMETER LIST')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
11835 CONTINUE
      ILOCDV=I2
11839 CONTINUE
C
C               ******************************************
C               **  STEP 11.9--                         **
C               **  COMPUTE THE RUNGE-KUTTA SOLUTION    **
C               ******************************************
C
      ISTEPN='11.9'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'DPRK')GOTO11919
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11911)
11911 FORMAT('***** FROM DPRK, IMMEDIATELY BEFORE CALLING ',
     1'DPRK2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11912)N3,NUMPV
11912 FORMAT('N3,NUMPV = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,11913)NUMDV,XMIN,XMAX,XINT
CXXXX FORMAT('NUMDV,XMIN,XMAX,XINT = ',I8,3E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11913)NUMDV
11913 FORMAT('NUMDV = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO11914I=1,NUMDV
      WRITE(ICOUT,11915)I,IDUMV(I),IDUMV2(I)
11915 FORMAT('I,IDUMV(I),IDUMV2(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
11914 CONTINUE
      WRITE(ICOUT,11916)IBUGA3,IBUGCO,IBUGEV,ISUBRO
11916 FORMAT('IBUGA3,IBUGCO,IBUGEV,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1WRITE(ICOUT,11917)ICOLL1,ICOLL2,ICOLR1,NS1,NUMVAL
11917 FORMAT('ICOLL1,ICOLL2,ICOLR1,NS1,NUMVAL = ',5I8)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      WRITE(ICOUT,11918)NINEW,ICASL7,ICASEQ
11918 FORMAT('NINEW,ICASL7,ICASEQ = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
11919 CONTINUE
      IWRITE='ON'
      IF(IPRINT.EQ.'OFF')IWRITE='OFF'
      IF(IFEEDB.EQ.'OFF')IWRITE='OFF'
C
      CALL DPRK2(TEMPX,TEMPY,TEMPYD,NS1,ILOCHV,ILOCVV,ILOCDV,NUMVAL,
     1IFUNC3,N3,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IDUMV,IDUMV2,NUMDV,
     1IBUGA3,IBUGCO,IBUGEV,ISUBRO,IERROR)
C
      IFOUND='YES'
C
C               *******************************************
C               **  STEP 12--                            **
C               **  COPY THE OUTPUT VARIABLE             **
C               **  TO THE PROPER WORKSHEET COLUMN       **
C               *******************************************
C
      IF(ICASEQ.EQ.'FULL')GOTO12100
      IF(ICASEQ.EQ.'SUBS')GOTO12300
      IF(ICASEQ.EQ.'FOR')GOTO12500
C
C               *******************************************
C               **  STEP 12.1--                          **
C               **  TREAT THE FULL CASE.                 **
C               *******************************************
C
12100 CONTINUE
      ISTEPN='12.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NSX=0
      IF(NITEMX.LE.0)IROW1=0
      IF(NITEMX.LE.0)IROWN=0
      IF(NITEMX.LE.0)GOTO12190
      DO12110I=1,NITEMX
      NSX=I
C
      IJ=MAXN*(ICOLL1-1)+I
      IF(ICOLL1.LE.MAXCOL)V(IJ)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP1)PRED(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP2)RES(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP3)YPLOT(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP4)XPLOT(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP5)X2PLOT(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP6)TAGPLO(I)=TEMPY(NSX)
C
      IF(NUMVAL.LE.1)GOTO12110
      IJ=MAXN*(ICOLL2-1)+I
      IF(ICOLL2.LE.MAXCOL)V(IJ)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP1)PRED(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP2)RES(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP3)YPLOT(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP4)XPLOT(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP5)X2PLOT(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP6)TAGPLO(I)=TEMPYD(NSX)
C
12110 CONTINUE
12190 CONTINUE
C
      IF(NITEMX.GE.1)IROW1=1
      IF(NITEMX.GE.1)IROWN=NITEMX
      IN(ILISL1)=NITEMX
CCCCC IN(ICOLL1)=NITEMX
      IF(NUMVAL.EQ.2)IN(ILISL2)=NITEMX
C
      DO12210J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL1)GOTO12215
      GOTO12210
12215 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL1
      VALUE(J4)=ICOLL1
      IN(J4)=NITEMX
12210 CONTINUE
C
      IF(NUMVAL.LE.1)GOTO12229
      DO12220J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL2)GOTO12225
      GOTO12220
12225 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL2
      VALUE(J4)=ICOLL2
      IN(J4)=NITEMX
12220 CONTINUE
12229 CONTINUE
C
      GOTO13000
C
C               *******************************************
C               **  STEP 12.2--                          **
C               **  TREAT THE SUBSET CASE.               **
C               *******************************************
C
12300 CONTINUE
      ISTEPN='12.2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NSX=0
      IF(NITEMX.LE.0)IROW1=0
      IF(NITEMX.LE.0)IROWN=0
      IF(NITEMX.LE.0)GOTO12390
      DO12310I=1,NITEMX
      IF(ISUB(I).EQ.0)GOTO12310
      NSX=NSX+1
C
      IJ=MAXN*(ICOLL1-1)+I
      IF(ICOLL1.LE.MAXCOL)V(IJ)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP1)PRED(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP2)RES(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP3)YPLOT(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP4)XPLOT(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP5)X2PLOT(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP6)TAGPLO(I)=TEMPY(NSX)
      IF(NSX.EQ.1)IROW1=I
      IROWN=I
C
      IF(NUMVAL.LE.1)GOTO12310
      IJ=MAXN*(ICOLL2-1)+I
      IF(ICOLL2.LE.MAXCOL)V(IJ)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP1)PRED(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP2)RES(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP3)YPLOT(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP4)XPLOT(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP5)X2PLOT(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP6)TAGPLO(I)=TEMPYD(NSX)
C
12310 CONTINUE
12390 CONTINUE
C
      IN(ILISL1)=NITEMX
CCCCC IN(ICOLL1)=NITEMX
      IF(NUMVAL.EQ.2)IN(ILISL2)=NITEMX
C
      DO12410J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL1)GOTO12415
      GOTO12410
12415 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL1
      VALUE(J4)=ICOLL1
      IN(J4)=NITEMX
12410 CONTINUE
C
      IF(NUMVAL.LE.1)GOTO12429
      DO12420J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL2)GOTO12425
      GOTO12420
12425 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL2
      VALUE(J4)=ICOLL2
      IN(J4)=NITEMX
12420 CONTINUE
12429 CONTINUE
C
      GOTO13000
C
C               *******************************************
C               **  STEP 12.3--                          **
C               **  TREAT THE FOR CASE.                  **
C               *******************************************
C
12500 CONTINUE
      ISTEPN='12.3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NSX=0
      IF(NITEMX.LE.0)IROW1=0
      IF(NITEMX.LE.0)IROWN=0
      IF(NITEMX.LE.0)GOTO12590
      DO12510I=1,NITEMX
      IF(I.GT.NIFOR)GOTO12550
      IF(ISUB(I).EQ.0)GOTO12510
      NSX=NSX+1
      IJ=MAXN*(ICOLL1-1)+I
      IF(ICOLL1.LE.MAXCOL)V(IJ)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP1)PRED(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP2)RES(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP3)YPLOT(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP4)XPLOT(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP5)X2PLOT(I)=TEMPY(NSX)
      IF(ICOLL1.EQ.MAXCP6)TAGPLO(I)=TEMPY(NSX)
      IF(NSX.EQ.1)IROW1=I
      IROWN=I
C
      IF(NUMVAL.LE.1)GOTO12510
      IJ=MAXN*(ICOLL2-1)+I
      IF(ICOLL2.LE.MAXCOL)V(IJ)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP1)PRED(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP2)RES(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP3)YPLOT(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP4)XPLOT(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP5)X2PLOT(I)=TEMPYD(NSX)
      IF(ICOLL2.EQ.MAXCP6)TAGPLO(I)=TEMPYD(NSX)
C
12510 CONTINUE
12590 CONTINUE
12550 CONTINUE
C
      IN(ILISL1)=NITEMX
CCCCC IN(ICOLL1)=NITEMX
      IF(NUMVAL.EQ.2)IN(ILISL2)=NITEMX
C
      DO12610J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL1)GOTO12615
      GOTO12610
12615 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL1
      VALUE(J4)=ICOLL1
      IN(J4)=NITEMX
12610 CONTINUE
C
      IF(NUMVAL.LE.1)GOTO12629
      DO12620J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL2)GOTO12625
      GOTO12620
12625 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL2
      VALUE(J4)=ICOLL2
      IN(J4)=NITEMX
12620 CONTINUE
12629 CONTINUE
C
      GOTO13000
C
C               *******************************************
C               **  STEP 13--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING    **
C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
C               *******************************************
C
13000 CONTINUE
      ISTEPN='12'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DPRK')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHNAME(ILISL1)=ILEF11
      IHNAM2(ILISL1)=ILEF12
      IUSE(ILISL1)='V'
      IVALUE(ILISL1)=ICOLL1
      VALUE(ILISL1)=ICOLL1
CCCCC IUSE(ICOLL1)='V'
CCCCC IVALUE(ICOLL1)=ICOLL1
CCCCC VALUE(ICOLL1)=ICOLL1
      IF(NEWNA1.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNA1.EQ.'YES')NUMCOL=NUMCOL+1
C
      IF(NUMVAL.LE.1)GOTO13009
      IHNAME(ILISL2)=ILEF21
      IHNAM2(ILISL2)=ILEF22
      IUSE(ILISL2)='V'
      IVALUE(ILISL2)=ICOLL2
      VALUE(ILISL2)=ICOLL2
CCCCC IUSE(ICOLL2)='V'
CCCCC IVALUE(ICOLL2)=ICOLL2
CCCCC VALUE(ICOLL2)=ICOLL2
      IF(NEWNA2.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNA2.EQ.'YES')NUMCOL=NUMCOL+1
13009 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO13090
      IF(IFEEDB.EQ.'OFF')GOTO13090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,13011)ILEF11,ILEF12,NSX
13011 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL1-1)+IROW1
      IF(ICOLL1.LE.MAXCOL)WRITE(ICOUT,13021)ILEF11,ILEF12,V(IJ),IROW1
      IF(ICOLL1.LE.MAXCOL)CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 4 LINES WERE FIXED   APRIL 1992
CCCCC IF(ICOLL1.EQ.MAXCP1)WRITE(ICOUT,13021)ILEF11,ILEF12,PRED(IROW1),IROW1
CCCCC IF(ICOLL1.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
CCCCC IF(ICOLL1.EQ.MAXCP2)WRITE(ICOUT,13021)ILEF11,ILEF12,RES(IROW1),IROW1
CCCCC IF(ICOLL1.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
CCCCC IF(ICOLL1.EQ.MAXCP3)WRITE(ICOUT,13021)ILEF11,ILEF12,YPLOT(IROW1),IROW1
CCCCC IF(ICOLL1.EQ.MAXCP3)CALL DPWRST('XXX','BUG ')
CCCCC IF(ICOLL1.EQ.MAXCP4)WRITE(ICOUT,13021)ILEF11,ILEF12,XPLOT(IROW1),IROW1
CCCCC IF(ICOLL1.EQ.MAXCP4)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP1)WRITE(ICOUT,13021)ILEF11,ILEF12,PRED(IROW1),
     1IROW1
13021 FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL1.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP2)WRITE(ICOUT,13021)ILEF11,ILEF12,RES(IROW1),
     1IROW1
      IF(ICOLL1.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP3)WRITE(ICOUT,13021)ILEF11,ILEF12,YPLOT(IROW1),
     1IROW1
      IF(ICOLL1.EQ.MAXCP3)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP4)WRITE(ICOUT,13021)ILEF11,ILEF12,XPLOT(IROW1),
     1IROW1
      IF(ICOLL1.EQ.MAXCP4)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP5)WRITE(ICOUT,13021)ILEF11,ILEF12,X2PLOT(IROW1),
     1IROW1
      IF(ICOLL1.EQ.MAXCP5)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP6)WRITE(ICOUT,13021)ILEF11,ILEF12,TAGPLO(IROW1),
     1IROW1
      IF(ICOLL1.EQ.MAXCP6)CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL1-1)+IROWN
      IF(ICOLL1.LE.MAXCOL.AND.
     1NSX.NE.1)WRITE(ICOUT,13031)NSX,ILEF11,ILEF12,V(IJ),IROWN
13031 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL1.LE.MAXCOL.AND.
     1NSX.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP1.AND.
     1NSX.NE.1)WRITE(ICOUT,13031)NSX,ILEF11,ILEF12,PRED(IROWN),IROWN
      IF(ICOLL1.EQ.MAXCP1.AND.
     1NSX.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP2.AND.
     1NSX.NE.1)WRITE(ICOUT,13031)NSX,ILEF11,ILEF12,RES(IROWN),IROWN
      IF(ICOLL1.EQ.MAXCP2.AND.
     1NSX.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP3.AND.
     1NSX.NE.1)WRITE(ICOUT,13031)NSX,ILEF11,ILEF12,YPLOT(IROWN),IROWN
      IF(ICOLL1.EQ.MAXCP3.AND.
     1NSX.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP4.AND.
     1NSX.NE.1)WRITE(ICOUT,13031)NSX,ILEF11,ILEF12,XPLOT(IROWN),IROWN
      IF(ICOLL1.EQ.MAXCP4.AND.
     1NSX.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP5.AND.
     1NSX.NE.1)WRITE(ICOUT,13031)NSX,ILEF11,ILEF12,X2PLOT(IROWN),IROWN
      IF(ICOLL1.EQ.MAXCP5.AND.
     1NSX.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL1.EQ.MAXCP6.AND.
     1NSX.NE.1)WRITE(ICOUT,13031)NSX,ILEF11,ILEF12,TAGPLO(IROWN),IROWN
      IF(ICOLL1.EQ.MAXCP6.AND.
     1NSX.NE.1)CALL DPWRST('XXX','BUG ')
      IF(NSX.NE.1)GOTO13039
      WRITE(ICOUT,13032)
13032 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,13033)
13033 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
13039 CONTINUE
C
      IF(NUMVAL.LE.1)GOTO13079
      WRITE(ICOUT,13051)ILEF21,ILEF22,NSX
13051 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL2-1)+IROW1
      IF(ICOLL2.LE.MAXCOL)THEN
         WRITE(ICOUT,13061)ILEF21,ILEF22,V(IJ),IROW1
13061    FORMAT('THE FIRST           COMPUTED VALUE OF ',
     1   A4,A4,' = ',E15.7,'   (ROW ',I6,')')
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL2.EQ.MAXCP1)THEN
         WRITE(ICOUT,13061)ILEF21,ILEF22,PRED(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL2.EQ.MAXCP2)THEN
         WRITE(ICOUT,13061)ILEF21,ILEF22,RES(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL2.EQ.MAXCP3)THEN
         WRITE(ICOUT,13061)ILEF21,ILEF22,YPLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL2.EQ.MAXCP4)THEN
         WRITE(ICOUT,13061)ILEF21,ILEF22,XPLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL2.EQ.MAXCP5)THEN
         WRITE(ICOUT,13061)ILEF21,ILEF22,X2PLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL2.EQ.MAXCP6)THEN
         WRITE(ICOUT,13061)ILEF21,ILEF22,TAGPLO(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IJ=MAXN*(ICOLL2-1)+IROWN
      IF(NSX.NE.1)THEN
         IF(ICOLL2.LE.MAXCOL)THEN
            WRITE(ICOUT,13071)NSX,ILEF21,ILEF22,V(IJ),IROWN
13071       FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',
     1      A4,A4,' = ',E15.7,'   (ROW ',I6,')')
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL2.EQ.MAXCP1)THEN
            WRITE(ICOUT,13071)NSX,ILEF21,ILEF22,PRED(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL2.EQ.MAXCP2)THEN
            WRITE(ICOUT,13071)NSX,ILEF21,ILEF22,RES(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL2.EQ.MAXCP3)THEN
            WRITE(ICOUT,13071)NSX,ILEF21,ILEF22,YPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL2.EQ.MAXCP4)THEN
            WRITE(ICOUT,13071)NSX,ILEF21,ILEF22,XPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL2.EQ.MAXCP5)THEN
            WRITE(ICOUT,13071)NSX,ILEF21,ILEF22,X2PLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL2.EQ.MAXCP6)THEN
            WRITE(ICOUT,13071)NSX,ILEF21,ILEF12,TAGPLO(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ENDIF
      ENDIF
      IF(NSX.NE.1)GOTO13079
      WRITE(ICOUT,13072)
13072 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,13073)
13073 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
13079 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
13090 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
19000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'DPRK')GOTO19090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19011)
19011 FORMAT('***** AT THE END       OF DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19012)IFOUND,IERROR
19012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19013)IBUGA3,IBUGQ,ISUBRO
19013 FORMAT('IBUGA3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19014)ICASL7,IWRITE
19014 FORMAT('ICASL7,IWRITE = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19015)NSX,NITEMX
19015 FORMAT('NSX,NITEMX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19021)ILEF11,ILEF12,ILISL1,ICOLL1
19021 FORMAT('ILEF11,ILEF12,ILISL1,ICOLL1 = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19022)ILEF21,ILEF22,ILISL2,ICOLL2
19022 FORMAT('ILEF21,ILEF22,ILISL2,ICOLL2 = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19023)NUMVAL,NEWNA1,NEWNA2,NUMVAR
19023 FORMAT('NUMVAL,NEWNA1,NEWNA2,NUMVAR = ',I8,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 4 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,19024)ILISR1,ILISR2,ILISR3,ILISR4
CXXXX FORMAT('ILISR1,ILISR2,ILISR3,ILISR4 = ',4I8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,19025)ICOLR1,ICOLR2,ICOLR3,ICOLR4
CXXXX FORMAT('ICOLR1,ICOLR2,ICOLR3,ICOLR4 = ',4I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19024)ILISR1
19024 FORMAT('ILISR1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19025)ICOLR1
19025 FORMAT('ICOLR1 = ',I8)
      CALL DPWRST('XXX','BUG ')
C
CCCCC THE FOLLOWING LINE WAS FIXED  APRIL 1992
CCCCC WRITE(ICOUT,19011)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19041)
19041 FORMAT('***** AT THE END       OF DPRK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19042)IFOUND,IERROR
19042 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19043)IBUGA3,IBUGQ
19043 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19044)ICASL7,IWRITE
19044 FORMAT('ICASL7,IWRITE = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19045)NSX,NITEMX
19045 FORMAT('NSX,NITEMX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19051)ILEF11,ILEF12,ILISL1,ICOLL1
19051 FORMAT('ILEF11,ILEF12,ILISL1,ICOLL1 = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19052)ILEF21,ILEF22,ILISL2,ICOLL2
19052 FORMAT('ILEF21,ILEF22,ILISL2,ICOLL2 = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19053)NUMVAL,NEWNA1,NEWNA2,NUMVAR
19053 FORMAT('NUMVAL,NEWNA1,NEWNA2,NUMVAR = ',I8,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 4 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,19054)ILISR1,ILISR2,ILISR3,ILISR4
CXXXX FORMAT('ILISR1,ILISR2,ILISR3,ILISR4 = ',4I8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,19055)ICOLR1,ICOLR2,ICOLR3,ICOLR4
CXXXX FORMAT('ICOLR1,ICOLR2,ICOLR3,ICOLR4 = ',4I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19054)ILISR1
19054 FORMAT('ILISR1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19055)ICOLR1
19055 FORMAT('ICOLR1 = ',I8)
      CALL DPWRST('XXX','BUG ')
19090 CONTINUE
C
      RETURN
      END
 
      SUBROUTINE DPRK2(X,Y,YD,N,ILOCHV,ILOCVV,ILOCDV,IORDER,
     1MODEL,NUMCHA,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IVARN,IVARN2,NUMVAR,
     1IBUGA3,IBUGCO,IBUGEV,ISUBRO,IERROR)
C
C*****COPIED OVER ON TUESDAY NIGHT OCT 13, 1987 AFTER DISAPPEARANCE OF DPRK.FOR
C     AND STRANGE PRIVILEDGE MESSAGES ABOUT DPRK2.FOR
 
C     PURPOSE--COMPUTE THE RUNGE-KUTA SOLUTIONS
C              OF A FIRST- OR SECOND-ORDER DIFFERENTIAL EQUATION
C              OVER THE RANGE OF VALUES OF THE VARIABLE X.
C     NOTE--FOR FIRST-ORDER EQUATIONS,
C           X(1) AND Y(1) ARE THE INITIAL VALUES
C           FOR THE DIFFERENTIAL EQUATION--
C           THEY MUST PRE-EXIST.
C         --FOR SECOND-ORDER EQUATIONS,
C           X(1), Y(1), AND YD(1) ARE THE INITIAL VALUES
C           FOR THE DIFFERENTIAL EQUATION--
C           THEY MUST PRE-EXIST.
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/10
C     ORIGINAL VERSION--SEPTEMBER  1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 MODEL
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IVARN
      CHARACTER*4 IVARN2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
CCCCC CHARACTER*4 IH
CCCCC CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(*)
      DIMENSION YD(*)
C
      DIMENSION MODEL(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
      DIMENSION IVARN(*)
      DIMENSION IVARN2(*)
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
CCCCC DIMENSION ILOCV(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='DPRK'
      ISUBN2='2   '
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'PRK2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRK2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGCO,IBUGEV,ISUBRO
   52 FORMAT('IBUGA3,IBUGCO,IBUGEV,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IORDER
   53 FORMAT('IORDER = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)Y(1),YD(1)
   56 FORMAT('Y(1),YD(1) = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      DO57I=1,N
      WRITE(ICOUT,58)X(I)
   58 FORMAT('X(I) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
   57 CONTINUE
      WRITE(ICOUT,59)ILOCHV,ILOCVV,ILOCDV
   59 FORMAT('ILOCHV,ILOCVV,ILOCDV = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)NUMCHA,NUMPV,NUMVAR
   63 FORMAT('NUMCHA,NUMPV,NUMVAR, = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)(MODEL(J),J=1,NUMCHA)
   64 FORMAT('MODEL(I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMPV
      WRITE(ICOUT,66)I,PARAM(I),IPARN(I),IPARN2(I)
   66 FORMAT('I,PARAM(I),IPARN(I),IPARN2(I) = ',I8,E15.7,A4,A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,67)IANGLU
   67 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO70I=1,NUMVAR
      WRITE(ICOUT,71)I,IVARN(I),IVARN2(I)
   71 FORMAT('I, IVARN(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  BRANCH TO THE PROPER CASE                   **
C               **************************************************
C
      IF(IORDER.EQ.1)GOTO1100
      GOTO2100
C
C               **************************************************
C               **  STEP 11--                                   **
C               **  FOR THIS FIRST ORDER CASE,                  **
C               **  WRITE OUT  PRELIMINARY SUMMARY INFORMATION  **
C               **************************************************
C
 1100 CONTINUE
      IF(IPRINT.EQ.'OFF')GOTO1109
      IF(IFEEDB.EQ.'OFF')GOTO1109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1101)
 1101 FORMAT('RUNGE-KUTTA DIFFERENTIAL EQUATION SOLUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)(MODEL(I),I=1,NUMCHA)
 1102 FORMAT('      FUNCTION--',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)IPARN(ILOCHV),IPARN2(ILOCHV),X(1)
 1103 FORMAT('      INITAL VALUE FOR ',A4,A4,' = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1104)IPARN(ILOCVV),IPARN2(ILOCVV),Y(1)
 1104 FORMAT('      INITAL VALUE FOR ',A4,A4,' = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1105)IPARN(ILOCHV),IPARN2(ILOCHV)
 1105 FORMAT('TOTAL LENGTH OF VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1106)N
 1106 FORMAT('(INCLUDING INITIAL VALUE IN ELEMENT 1) = ',I8)
      CALL DPWRST('XXX','BUG ')
 1109 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  FOR THIS FIRST ORDER CASE,               **
C               **  STEP THROUGH THE   VALUES OF THE         **
C               **  HORIZONTAL AXIS VARIABLE                 **
C               **  (THE VARIABLE OF DIFFERENTIATION)        **
C               **  AND COMPUTE THE RUNGE-KUTTA SOLUTIONS    **
C               ***********************************************
C
      DO1200I=2,N
C
      IM1=I-1
      X0=X(IM1)
      Y0=Y(IM1)
      H=X(I)-X(IM1)
C
C     STEP 11.1--
C
      XARG=X0
      YARG=Y0
CCCCC CALL FUNC(XARG,YARG,FOUT)
CCCCC AK1=H*FOUT
      PARAM(ILOCHV)=XARG
      PARAM(ILOCVV)=YARG
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FOUT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AK1=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,1211)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK1
 1211 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK1 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 11.2--
C
      XARG=X0+H/2.0
      YARG=Y0+AK1/2.0
CCCCC CALL FUNC(XARG,YARG,FOUT)
CCCCC AK2=H*FOUT
      PARAM(ILOCHV)=XARG
      PARAM(ILOCVV)=YARG
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FOUT,
     1IBUGCO,IBUGEV,IERROR)
      AK2=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,1212)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK2
 1212 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK2 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 11.3--
C
      XARG=X0+H/2.0
      YARG=Y0+AK2/2.0
CCCCC CALL FUNC(XARG,YARG,FOUT)
CCCCC AK3=H*FOUT
      PARAM(ILOCHV)=XARG
      PARAM(ILOCVV)=YARG
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FOUT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AK3=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,1213)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK3
 1213 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK3 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 11.4--
C
      XARG=X0+H
      YARG=Y0+AK3
CCCCC CALL FUNC(XARG,YARG,FOUT)
CCCCC AK4=H*FOUT
      PARAM(ILOCHV)=XARG
      PARAM(ILOCVV)=YARG
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FOUT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AK4=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,1214)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK4
 1214 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK4 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
      YNEXT=Y0+(AK1/6.0)+(AK2/3.0)+(AK3/3.0)+(AK4/6.0)
C
      Y(I)=YNEXT
C
 1200 CONTINUE
C
      GOTO9000
C
C               **************************************************
C               **  STEP 21--                                   **
C               **  FOR THIS SECOND ORDER CASE,                 **
C               **  WRITE OUT  PRELIMINARY SUMMARY INFORMATION  **
C               **************************************************
C
 2100 CONTINUE
      IF(IPRINT.EQ.'OFF')GOTO2109
      IF(IFEEDB.EQ.'OFF')GOTO2109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2101)
 2101 FORMAT('RUNGE-KUTTA DIFFERENTIAL EQUATION SOLUTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2102)(MODEL(I),I=1,NUMCHA)
 2102 FORMAT('      FUNCTION--',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2103)IPARN(ILOCHV),IPARN2(ILOCHV),X(1)
 2103 FORMAT('      INITAL VALUE FOR ',A4,A4,' = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2104)IPARN(ILOCVV),IPARN2(ILOCVV),Y(1)
 2104 FORMAT('      INITAL VALUE FOR ',A4,A4,' = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2105)IPARN(ILOCDV),IPARN2(ILOCDV),YD(1)
 2105 FORMAT('      INITAL VALUE FOR ',A4,A4,' = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2106)IPARN(ILOCHV),IPARN2(ILOCHV)
 2106 FORMAT('TOTAL LENGTH OF VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2107)N
 2107 FORMAT('(INCLUDING INITIAL VALUE IN ELEMENT 1) = ',I8)
      CALL DPWRST('XXX','BUG ')
 2109 CONTINUE
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  FOR THIS SECOND ORDER CASE,              **
C               **  STEP THROUGH THE   VALUES OF THE         **
C               **  HORIZONTAL AXIS VARIABLE                 **
C               **  (THE VARIABLE OF DIFFERENTIATION)        **
C               **  AND COMPUTE THE RUNGE-KUTTA SOLUTIONS    **
C               ***********************************************
C
      DO2200I=2,N
C
      IM1=I-1
      X0=X(IM1)
      Y0=Y(IM1)
      YD0=YD(IM1)
      H=X(I)-X(IM1)
C
C     STEP 22.1--
C
      XARG=X0
      YARG=Y0
      YDARG=YD0
CCCCC FOUT=YDARG
CCCCC AK1=H*FOUT
      FOUT=YDARG
      AK1=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,2211)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK1
 2211 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK1 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 22.2--
C
      XARG=X0
      YARG=Y0
      YDARG=YD0
CCCCC CALL FUNC(XARG,YARG,YDARG,FOUT)
CCCCC AK1=H*FOUT
      PARAM(ILOCHV)=XARG
      PARAM(ILOCVV)=YARG
      PARAM(ILOCDV)=YDARG
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FOUT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AL1=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,2212)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AL1
 2212 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AL1 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 22.3--
C
      XARG=X0+H/2.0
      YARG=Y0+AK1/2.0
      YDARG=YD0+AL1/2.0
CCCCC FOUT=YDARG
CCCCC AK2=H*FOUT
      FOUT=YDARG
      AK2=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,2213)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK2
 2213 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK2 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 22.4--
C
      XARG=X0+H/2.0
      YARG=Y0+AK1/2.0
      YDARG=YD0+AL1/2.0
CCCCC CALL FUNC(XARG,YARG,YDARG,FOUT)
CCCCC AK2=H*FOUT
      PARAM(ILOCHV)=XARG
      PARAM(ILOCVV)=YARG
      PARAM(ILOCDV)=YDARG
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FOUT,
     1IBUGCO,IBUGEV,IERROR)
      AL2=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,2214)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AL2
 2214 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AL2 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 22.5--
C
      XARG=X0+H/2.0
      YARG=Y0+AK2/2.0
      YDARG=YD0+AL2/2.0
CCCCC FOUT=YDARG
CCCCC AK3=H*FOUT
      FOUT=YDARG
      AK3=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,2215)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK3
 2215 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK3 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 22.6--
C
      XARG=X0+H/2.0
      YARG=Y0+AK2/2.0
      YDARG=YD0+AL2/2.0
CCCCC CALL FUNC(XARG,YARG,YDARG,FOUT)
CCCCC AK3=H*FOUT
      PARAM(ILOCHV)=XARG
      PARAM(ILOCVV)=YARG
      PARAM(ILOCDV)=YDARG
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FOUT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AL3=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,2216)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AL3
 2216 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AL3 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 22.7--
C
      XARG=X0+H
      YARG=Y0+AK3
      YDARG=YD0+AL3
CCCCC FOUT=YDARG
CCCCC AK4=H*FOUT
      FOUT=YDARG
      AK4=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,2217)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK4
 2217 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AK4 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
C     STEP 22.8--
C
      XARG=X0+H
      YARG=Y0+AK3
      YDARG=YD0+AL3
CCCCC CALL FUNC(XARG,YARG,YDARG,FOUT)
CCCCC AK4=H*FOUT
      PARAM(ILOCHV)=XARG
      PARAM(ILOCVV)=YARG
      PARAM(ILOCDV)=YDARG
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FOUT,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AL4=H*FOUT
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1WRITE(ICOUT,2218)PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AL4
 2218 FORMAT('PARAM(ILOCHV),PARAM(ILOCVV),FOUT,AL4 = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PRK2')
     1CALL DPWRST('XXX','BUG ')
C
      YNEXT=Y0+(AK1/6.0)+(AK2/3.0)+(AK3/3.0)+(AK4/6.0)
      YDNEXT=YD0+(AL1/6.0)+(AL2/3.0)+(AL3/3.0)+(AL4/6.0)
C
      Y(I)=YNEXT
      YD(I)=YDNEXT
C
 2200 CONTINUE
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'PRK2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRK2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,IBUGCO,IBUGEV,ISUBRO
 9012 FORMAT('IBUGA3,IBUGCO,IBUGEV,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IORDER
 9013 FORMAT('IORDER = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO9029
      DO9020I=1,N
      IF(IORDER.EQ.1)WRITE(ICOUT,9021)I,X(I),Y(I)
 9021 FORMAT('I,X(I),Y(I) = ',I8,3E15.7)
      IF(IORDER.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IORDER.EQ.2)WRITE(ICOUT,9022)I,X(I),Y(I),YD(I)
 9022 FORMAT('I,X(I),Y(I),YD(I) = ',I8,3E15.7)
      IF(IORDER.EQ.2)CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9031)ILOCHV,ILOCVV,ILOCDV
 9031 FORMAT('ILOCHV,ILOCVV,ILOCDV = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)NUMCHA,NUMPV,NUMVAR
 9033 FORMAT('NUMCHA,NUMPV,NUMVAR, = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)(MODEL(J),J=1,NUMCHA)
 9034 FORMAT('MODEL(I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,NUMPV
      WRITE(ICOUT,9036)I,PARAM(I),IPARN(I),IPARN2(I)
 9036 FORMAT('I,PARAM(I),IPARN(I),IPARN2(I) = ',I8,E15.7,A4,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
      WRITE(ICOUT,9037)IANGLU
 9037 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9040I=1,NUMVAR
      WRITE(ICOUT,9041)I,IVARN(I),IVARN2(I)
 9041 FORMAT('I, IVARN(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
 9040 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
