      SUBROUTINE INITMC(IBUGIN)
C
C     PURPOSE--DEFINE MACHINE CONSTANTS (INTEGER, REAL, AND
C              DOUBLE PRECISION) FOR A PARTICULAR COMPUTER,
C     NOTE--THIS SUBROUTINE DOES NOT ADHERE TO 1966 ANSI STANDARD
C           OR THE 1977 ANSI STANDARD
C           BECAUSE IT USES OCTAL CONSTANTS.
C     NOTE--TO ALTER THIS SUBROUTINE FOR A PARTICULAR ENVIRONMENT,
C     THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY
C     REMOVING THE C FROM COLUMN 1.
C     NOTE--FOR IMPLEMENTATION CONVIENENCE, THE COMMENT LINES THAT
C     NEED TO BE DEACTIVATED ARE CODED AS "CXXXX" WHERE XXXX DEFINES
C     A PARTICULAR MACHINE.  THIS MEANS A SINGLE GLOBAL REPLACE CAN
C     BE USED TO UNCOMMENT THE APPROPRIATE LINES FOR A PARTICULAR
C     MACHINE (E.G., CHANGE '     ' TO '    ').
C     THE FOLLOWING CODES ARE USED:
C     APPO - APOLLO
C     BURR - BURROUGHS 1700
C     BUR2 - BURROUGHS 5700
C     BUR3 - BURROUGHS 6700
C     NVE  - CDC USING NOS/VE
C     205  - CDC 205 USING VSOS
C     CRAY - CRAY
C     DG   - DATA GENERAL ECLIPSE
C     HARR - HARRIS 220
C     HONE - HONEYWELL 600/6000
C     HP1  - HP 2100 FTN4
C     HP2  - HP 2100 FTN4
C     HP9  - HP 9000 (UNIX)
C     IBM  - IBM 370
C     PDP1 - PDP-10 (KA PROCESSOR)
C     PDP2 - PDP-10 (KI PROCESSOR)
C     PDP3 - PDP-11 (32 BIT)
C     PDP4 - PDP-11 (16 BIT)
C     PRIM - PRIME
C     UNIV - UNIVAC WITH FTN (I.E., 77 COMPILER)
C     UNI2 - UNIVAC WITH FOR (I.E., 66 COMPILER, NO LONGER SUPPORTED)
C     IBM- - IBM-PC USING 16 BIT DOS, 8087 CO-PROCESSOR
C     OS2  - IBM-PC USING OS/2 (32 BIT 386 USING OTG COMPILER)
C     MACI - MACINTOSH
C     SUN  - SUN (UNIX, CAN BE USED BY OTHER UNIX MACHINES, E.G. THE
C            SILICON GRAPHICS IRIS AND THE HP-9000).
C     CON1 - CONVEX (NATIVE MODE, WITHOUT -R8 OPTION)
C     CON2 - CONVEX (NATIVE MODE, WITH -R8 OPTION)
C     CON3 - CONVEX (IEEE MODE, WITHOUT -R8 OPTION)
C     CON4 - CONVEX (IEEE MODE, WITH -R8 OPTION)
C
C     NOTE--THIS SUBROUTINE IS IDENTICAL TO THE DPMACH SUBROUTINE.
C
C               **************************************************
C               **  DESCRIPTION OF INTEGER MACHINE CONSTANTS    **
C               **************************************************
C
C     TO DESCRIBE I/O UNIT NUMBERS--
C
C       I1MACH( 1) = THE STANDARD INPUT UNIT.
C       I1MACH( 2) = THE STANDARD OUTPUT UNIT.
C       I1MACH( 3) = THE STANDARD PUNCH UNIT.
C       I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT.
C
C     TO DESCRIBE WORDS--
C
C       I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT.
C       I1MACH( 6) = THE NUMBER OF CHARACTERS PER INTEGER STORAGE UNIT.
C
C     TO DESCRIBE INTEGERS--
C
C       ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, BASE-A FORM
C                  SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
C                  WHERE 0 .LE. X(I) .LT. A FOR I=0,...,S-1.
C
C       I1MACH( 7) = A, THE BASE.
C       I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS.
C       I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE.
C
C     TO DESCIBE FLOATING-POINT NUMBERS--
C
C       ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT,
C       BASE-B FORM
C                  SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
C                  WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T,
C                  0 .LT. X(1), AND EMIN .LE. E .LE. EMAX.
C
C       I1MACH(10) = B, THE BASE.
C
C     TO DESCIBE SINGLE-PRECISION--
C
C       I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS.
C       I1MACH(12) = EMIN, THE SMALLEST EXPONENT E.
C       I1MACH(13) = EMAX, THE LARGEST EXPONENT E.
C
C     TO DESCRIBE DOUBLE-PRECISION--
C
C       I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS.
C       I1MACH(15) = EMIN, THE SMALLEST EXPONENT E.
C       I1MACH(16) = EMAX, THE LARGEST EXPONENT E.
C
C     THE VALUES OF
C     I1MACH(1) TO I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY
C     WITH THE LOCAL OPERATING SYSTEM.
C
C               *************************************************************
C               **  DESCRIPTION OF REAL (FLOATING POINT) MACHINE CONSTANTS  *
C               *************************************************************
C
C     R1MACH(1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
C     R1MACH(2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
C     R1MACH(3) = B**(-T), THE SMALLEST RELATIVE SPACING.
C     R1MACH(4) = B**(1-T), THE LARGEST RELATIVE SPACING.
C     R1MACH(5) = LOG10(B)
C
C     WHERE POSSIBLE, OCTAL OR HEXADECIMAL CONSTANTS HAVE BEEN USED
C     TO SPECIFY THE CONSTANTS EXACTLY WHICH HAS IN SOME CASES
C     REQUIRED THE USE OF EQUIVALENT INTEGER ARRAYS.
C
C               *********************************************************
C               **  DESCRIPTION OF DOUBLE PRECISION MACHINE CONSTANTS  **
C               *********************************************************
C
C     D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
C     D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
C     D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.
C     D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.
C     D1MACH( 5) = LOG10(B)
C
C     WHERE POSSIBLE, OCTAL OR HEXADECIMAL CONSTANTS HAVE BEEN USED
C     TO SPECIFY THE CONSTANTS EXACTLY WHICH HAS IN SOME CASES
C     REQUIRED THE USE OF EQUIVALENT INTEGER ARRAYS.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--THIS SUBROUTINE IS A MODIFICATION OF CODE
C           PROVIDED IN THE FOLLOWING ARTICLE--
C           CACM, 19XX.
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--SEPTEMBER 1980
C     UPDATED         --JULY      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JULY      1986 (IBM-PC AND MACINTOSH)
C     UPDATED         --OCTOBER   1986 (SUN)
C     UPDATED         --FEBRUARY  1988.  DIFFERENT GRAPHICS & ALPHA I/O (ALAN)
C     UPDATED         --FEBRUARY  1988.  UPDATED CYBER CONSTANTS (ALAN)
C     UPDATED         --JUNE      1989.  IBM-PC OS/2 & COMPAQ 386 CONSTANTS
C     UPDATED         --JUNE      1989.  INTEGER*2 (COMPAQ ERROR MESSAGE)
C     UPDATED         --JUNE      1990.  CODED COMMENTS FOR EASY "GLOBAL" EDIT
C                                        MOVE DATA AFTER EXECUTABLE
C     UPDATED         --AUGUST    1990.  (CONVEX, 4 DIFFERENT MODES, FROM CMLIB)
C     UPDATED         --APRIL     1992.  SAVE STATEMENTS
C     UPDATED         --APRIL     1992.  IHMOD1='386 '
C     UPDATED         --APRIL     1992.  ICOMPI='OTG '
C     UPDATED         --MAY       1992.  D.P. OVERFLOW PROBLEMS
C     UPDATED         --OCTOBER   1994.  FIX IBM-PC CONSTANTS
C     UPDATED         --OCTOBER   1996.  MS-FORTAN SUPPORT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC FOLLOWING LINES FOR MICROSOFT FORTRAN VERSION
      USE DFLIB
      USE DFWIN
CCCCC USE IFPORT
CCCCC USE IFQWIN
      TYPE (FONTINFO) MSFONT
      TYPE (QWINFO)  WINFO
      LOGICAL MODESTATUS
      TYPE (WINDOWCONFIG)   DPSCREEN
      CHARACTER*4 QWSCRN
      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
      LOGICAL(4) RESZZ
      INTERFACE
        LOGICAL(4) FUNCTION INITIALSETTINGS
        END FUNCTION
      END INTERFACE
      EXTERNAL IQWNHE
      EXTERNAL IQWNBR
CCCCC EXTERNAL IQWNAB
C
      CHARACTER*4 IBUGIN
C
      INCLUDE 'DPCODV.INC'
C
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION D2MACH(5)
C
CCCCC THE FOLLOWING 10 LINES WERE INSERTED JUNE 1989
CCCCC TO CORRECT NELSON HSU COMPAQ 389     JUNE 1989
CCCCC COMPILER ERROR MESSAGE.              JUNE 1989
CCCCC THESE 10 LINES MUST BE UNCOMMENTED OUT
CCCCC FOR IBM-PC, COMPAQ 386, ETC. COMPUTERS.
C
CCCCC INTEGER*2 ISMALL
CCCCC INTEGER*2 ILARGE
CCCCC INTEGER*2 IRIGHT
CCCCC INTEGER*2 IDIVER
CCCCC INTEGER*2 ILOG10
CCCCC INTEGER*2 JSMALL
CCCCC INTEGER*2 JLARGE
CCCCC INTEGER*2 JRIGHT
CCCCC INTEGER*2 JDIVER
CCCCC INTEGER*2 JLOG10
C
CCCCC THE FOLLOWING 12 LINES WERE ADDED  APRIL 1992
      SAVE R2MACH
      SAVE ISMALL
      SAVE ILARGE
      SAVE IRIGHT
      SAVE IDIVER
      SAVE ILOG10
C
      SAVE D2MACH
      SAVE JSMALL
      SAVE JLARGE
      SAVE JRIGHT
      SAVE JDIVER
      SAVE JLOG10
C
      DIMENSION ISMALL(2)
      DIMENSION ILARGE(2)
      DIMENSION IRIGHT(2)
      DIMENSION IDIVER(2)
      DIMENSION ILOG10(2)
C
      DIMENSION JSMALL(4)
      DIMENSION JLARGE(4)
      DIMENSION JRIGHT(4)
      DIMENSION JDIVER(4)
      DIMENSION JLOG10(4)
C
      DIMENSION I2MACH(16)
C
      DIMENSION R2MACH(5)
C
      EQUIVALENCE (R2MACH(1),ISMALL(1))
      EQUIVALENCE (R2MACH(2),ILARGE(1))
      EQUIVALENCE (R2MACH(3),IRIGHT(1))
      EQUIVALENCE (R2MACH(4),IDIVER(1))
      EQUIVALENCE (R2MACH(5),ILOG10(1))
C
      EQUIVALENCE (D2MACH(1),JSMALL(1))
      EQUIVALENCE (D2MACH(2),JLARGE(1))
      EQUIVALENCE (D2MACH(3),JRIGHT(1))
      EQUIVALENCE (D2MACH(4),JDIVER(1))
      EQUIVALENCE (D2MACH(5),JLOG10(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOHO.INC'
CCCCC THE FOLLOWING LINE WAS INSERTED FOR GR & ALPHA UNITS  FEBRUARY 1989
      INCLUDE 'DPCOGR.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  DEFINE RGB TABLES FOR QUICKWIN
      INCLUDE 'DPCOCT.INC'
C
C---------------------------------------------------------------------
C -----DATA STATEMENTS---------------------------------------------
CC
CC              ************************************************
CC              **  MACHINE CONSTANTS FOR THE APOLLO          **
C               **  MY THANKS TO NORM SHELLEY FOR THIS CONTRIBUTION   **
C               **  (JANUARY, 1985).                                  **
CC              **  THESE VALUES ARE TENTATIVE AND HAVE NOT BEEN CHECKED. **
CC              ************************************************
CC
CC
CAPPO DATA I2MACH( 1) /    5 /
CAPPO DATA I2MACH( 2) /    6 /
CAPPO DATA I2MACH( 3) /    7 /
CAPPO DATA I2MACH( 4) /    6 /
CAPPO DATA I2MACH( 5) /   32 /
CAPPO DATA I2MACH( 6) /    4 /
CAPPO DATA I2MACH( 7) /    2 /
CAPPO DATA I2MACH( 8) /   31 /
CAPPO DATA I2MACH( 9) / 2147483647 /
CAPPO DATA I2MACH(10) /    2 /
CC    DOES APOLLO NORMALIZE THEIR FRACTION LIKE A    VAX?
CC    IF SO, CHANGE THE FOLLOWING 23 TO 24
CC    ASK APOLLO HOW THEY DO THEIR NUMBERS
CAPPO DATA I2MACH(11) /   23 /
CAPPO DATA I2MACH(12) / -128 /
CAPPO DATA I2MACH(13) /  127 /
CAPPO DATA I2MACH(14) /   52 /
CAPPO DATA I2MACH(15) / -1024/
CAPPO DATA I2MACH(16) /  1023/
CC
CC    AM GOING TO USE HP-9000 NUMBERS FOR NOW AND ON MY OWN
CC    (THAT IS 2**-23 AND 2**22)
CC    FOR THE NUMBERS BELOW,
CAPPO DATA R2MACH(1) / 1.175495E-38 /
CAPPO DATA R2MACH(2) / 3.402823E38 /
CAPPO DATA R2MACH(3) / 1.1920928955078E-7 /
CAPPO DATA R2MACH(4) / 2.3841857910156E-7 /
CAPPO DATA R2MACH(5) / 0.3010300 /
CC
CC    AM GOING TO USE HP-9000 NUMBERS FOR NOW AND ON MY OWN
CC    (THAT IS 2**-23 AND 2**22)
CC    FOR THE NUMBERS BELOW,
CAPPO DATA D2MACH(1) / 2.22507385850721D-308 /
CAPPO DATA D2MACH(2) / 1.79769313486231D308 /
CAPPO DATA D2MACH(3) / 1.1102230246252D-16 /
CAPPO DATA D2MACH(4) / 2.2204460492503D-16 /
CAPPO DATA D2MACH(5) / 0.3010299956639812 /
CC
CAPPO IHOST1='APOL'
CAPPO IHOST2='    '
CAPPO IHMOD1='DOMA'
CAPPO IHMOD2='    '
CAPPO IOPSY1='AEGI'
CAPPO IOPSY2='    '
CAPPO ICOMPI='FTN '
CAPPO ISITE='    '
CC
CC              ********************************************************
CC              **  MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM.  **
CC              ********************************************************
CC
CBURR IHOST1='BURR'
CBURR IHOST2='    '
CBURR IHMOD1='1700'
CBURR IHMOD2='    '
CBURR IOPSY1='    '
CBURR IOPSY2='    '
CBURR ICOMPI='    '
CBURR ISITE='    '
CC
CBURR DATA I2MACH( 1) /    7 /
CBURR DATA I2MACH( 2) /    2 /
CBURR DATA I2MACH( 3) /    2 /
CBURR DATA I2MACH( 4) /    2 /
CBURR DATA I2MACH( 5) /   36 /
CBURR DATA I2MACH( 6) /    4 /
CBURR DATA I2MACH( 7) /    2 /
CBURR DATA I2MACH( 8) /   33 /
CBURR DATA I2MACH( 9) / Z1FFFFFFFF /
CBURR DATA I2MACH(10) /    2 /
CBURR DATA I2MACH(11) /   24 /
CBURR DATA I2MACH(12) / -256 /
CBURR DATA I2MACH(13) /  255 /
CBURR DATA I2MACH(14) /   60 /
CBURR DATA I2MACH(15) / -256 /
CBURR DATA I2MACH(16) /  255 /
CC
CBURR DATA R2MACH(1) / Z400800000 /
CBURR DATA R2MACH(2) / Z5FFFFFFFF /
CBURR DATA R2MACH(3) / Z4E9800000 /
CBURR DATA R2MACH(4) / Z4EA800000 /
CBURR DATA R2MACH(5) / Z500E730E8 /
CC
CBURR DATA JSMALL(1) / ZC00800000 /
CBURR DATA JSMALL(2) / Z000000000 /
CBURR DATA JLARGE(1) / ZDFFFFFFFF /
CBURR DATA JLARGE(2) / ZFFFFFFFFF /
CBURR DATA JRIGHT(1) / ZC 5800000 /
CBURR DATA JRIGHT(2) / Z000000000 /
CBURR DATA JDIVER(1) / ZC 6800000 /
CBURR DATA JDIVER(2) / Z000000000 /
CBURR DATA JLOG10(1) / ZD00E730E7 /
CBURR DATA JLOG10(2) / ZC77800DC0 /
CC
CBURR IHOST1='BURR'
CBURR IHOST2='    '
CBURR IHMOD1='1700'
CBURR IHMOD2='    '
CBURR IOPSY1='    '
CBURR IOPSY2='    '
CBURR ICOMPI='    '
CBURR ISITE='    '
CC
CC              ********************************************************
CC              **  MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM.  **
CC              ********************************************************
CC
CBUR2 DATA I2MACH( 1) /   5 /
CBUR2 DATA I2MACH( 2) /   6 /
CBUR2 DATA I2MACH( 3) /   7 /
CBUR2 DATA I2MACH( 4) /   6 /
CBUR2 DATA I2MACH( 5) /  48 /
CBUR2 DATA I2MACH( 6) /   6 /
CBUR2 DATA I2MACH( 7) /   2 /
CBUR2 DATA I2MACH( 8) /  39 /
CBUR2 DATA I2MACH( 9) / O0007777777777777 /
CBUR2 DATA I2MACH(10) /   8 /
CBUR2 DATA I2MACH(11) /  13 /
CBUR2 DATA I2MACH(12) / -50 /
CBUR2 DATA I2MACH(13) /  76 /
CBUR2 DATA I2MACH(14) /  26 /
CBUR2 DATA I2MACH(15) / -50 /
CBUR2 DATA I2MACH(16) /  76 /
CC
CBUR2 DATA R2MACH(1) / O1771000000000000 /
CBUR2 DATA R2MACH(2) / O0777777777777777 /
CBUR2 DATA R2MACH(3) / O1311000000000000 /
CBUR2 DATA R2MACH(4) / O1301000000000000 /
CBUR2 DATA R2MACH(5) / O1157163034761675 /
CC
CBUR2 DATA JSMALL(1) / O1771000000000000 /
CBUR2 DATA JSMALL(2) / O0000000000000000 /
CBUR2 DATA JLARGE(1) / O0777777777777777 /
CBUR2 DATA JLARGE(2) / O0007777777777777 /
CBUR2 DATA JRIGHT(1) / O1461000000000000 /
CBUR2 DATA JRIGHT(2) / O0000000000000000 /
CBUR2 DATA JDIVER(1) / O1451000000000000 /
CBUR2 DATA JDIVER(2) / O0000000000000000 /
CBUR2 DATA JLOG10(1) / O1157163034761674 /
CBUR2 DATA JLOG10(2) / O0006677466732724 /
CC
CBUR2 IHOST1='BURR'
CBUR2 IHOST2='    '
CBUR2 IHMOD1='5700'
CBUR2 IHMOD2='    '
CBUR2 IOPSY1='    '
CBUR2 IOPSY2='    '
CBUR2 ICOMPI='    '
CBUR2 ISITE='    '
CC
CC              **************************************************************
CC              **  MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS.  **
CC              **************************************************************
CC
CBUR3 DATA I2MACH( 1) /   5 /
CBUR3 DATA I2MACH( 2) /   6 /
CBUR3 DATA I2MACH( 3) /   7 /
CBUR3 DATA I2MACH( 4) /   6 /
CBUR3 DATA I2MACH( 5) /  48 /
CBUR3 DATA I2MACH( 6) /   6 /
CBUR3 DATA I2MACH( 7) /   2 /
CBUR3 DATA I2MACH( 8) /  39 /
CBUR3 DATA I2MACH( 9) / O0007777777777777 /
CBUR3 DATA I2MACH(10) /   8 /
CBUR3 DATA I2MACH(11) /  13 /
CBUR3 DATA I2MACH(12) / -50 /
CBUR3 DATA I2MACH(13) /  76 /
CBUR3 DATA I2MACH(14) /  26 /
CBUR3 DATA I2MACH(15) / -32754 /
CBUR3 DATA I2MACH(16) /  32780 /
CC
CBUR3 DATA R2MACH(1) / O1771000000000000 /
CBUR3 DATA R2MACH(2) / O0777777777777777 /
CBUR3 DATA R2MACH(3) / O1311000000000000 /
CBUR3 DATA R2MACH(4) / O1301000000000000 /
CBUR3 DATA R2MACH(5) / O1157163034761675 /
CC
CBUR3 DATA JSMALL(1) / O1771000000000000 /
CBUR3 DATA JSMALL(2) / O7770000000000000 /
CBUR3 DATA JLARGE(1) / O0777777777777777 /
CBUR3 DATA JLARGE(2) / O7777777777777777 /
CBUR3 DATA JRIGHT(1) / O1461000000000000 /
CBUR3 DATA JRIGHT(2) / O0000000000000000 /
CBUR3 DATA JDIVER(1) / O1451000000000000 /
CBUR3 DATA JDIVER(2) / O0000000000000000 /
CBUR3 DATA JLOG10(1) / O1157163034761674 /
CBUR3 DATA JLOG10(2) / O0006677466732724 /
CC
CBUR3 IHOST1='BURR'
CBUR3 IHOST2='    '
CBUR3 IHMOD1='6700'
CBUR3 IHMOD2='    '
CBUR3 IOPSY1='    '
CBUR3 IOPSY2='    '
CBUR3 ICOMPI='    '
CBUR3 ISITE='    '
CC
CC              *******************************************************
CC              **  MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES.  **
CC              *******************************************************
CC
C
C     MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE
C     FROM SANDIA LABS
C
C
CNVE   DATA I2MACH( 1) /     5 /
CNVE   DATA I2MACH( 2) /     6 /
CNVE   DATA I2MACH( 3) /     7 /
CNVE   DATA I2MACH( 4) /     6 /
CNVE   DATA I2MACH( 5) /    64 /
CNVE   DATA I2MACH( 6) /     8 /
CNVE   DATA I2MACH( 7) /     2 /
CNVE   DATA I2MACH( 8) /    63 /
CNVE   DATA I2MACH( 9) / 9223372036854775807 /
CNVE   DATA I2MACH(10) /     2 /
CNVE   DATA I2MACH(11) /    47 /
CNVE   DATA I2MACH(12) / -4095 /
CNVE   DATA I2MACH(13) /  4094 /
CNVE   DATA I2MACH(14) /    94 /
CNVE   DATA I2MACH(15) / -4095 /
CNVE   DATA I2MACH(16) /  4094 /
CC
CNVE   DATA R2MACH(1) / Z"3001800000000000" /
CNVE   DATA R2MACH(2) / Z"4FFEFFFFFFFFFFFE" /
CNVE   DATA R2MACH(3) / Z"3FD2800000000000" /
CNVE   DATA R2MACH(4) / Z"3FD3800000000000" /
CNVE   DATA R2MACH(5) / Z"3FFF9A209A84FBCF" /
CC
CNVE   DATA JSMALL(1) / Z"3001800000000000" /
CNVE   DATA JSMALL(2) / Z"3001000000000000" /
CNVE   DATA JLARGE(1) / Z"4FFEFFFFFFFFFFFE" /
CNVE   DATA JLARGE(2) / Z"4FFE000000000000" /
CNVE   DATA JRIGHT(1) / Z"3FD2800000000000" /
CNVE   DATA JRIGHT(2) / Z"3FD2000000000000" /
CNVE   DATA JDIVER(1) / Z"3FD3800000000000" /
CNVE   DATA JDIVER(2) / Z"3FD3000000000000" /
CNVE   DATA JLOG10(1) / Z"3FFF9A209A84FBCF" /
CNVE   DATA JLOG10(2) / Z"3FFFF7988F8959AC" /
CC
CNVE   IHOST1='NVE '
CNVE   IHOST2='    '
CNVE   IHMOD1='855 '
CNVE   IHMOD2='    '
CNVE   IOPSY1='NVE '
CNVE   IOPSY2='    '
CNVE   ICOMPI='FTN5'
CNVE   ISITE='NBS '
CC
CC  NOTE: 5/88.  FOR LEVEL 1.3.1, NEED TO SPECIFY "$LOCAL" AS THE CATALOG
CC        FOR THE INPUT AND OUTPUT FILES.  (UNITS 4, 5, 6, AND 7 ARE USED
CC        FOR TERMINAL I/O.  OTHERWISE, WILL USE THE DEFAULT CATALOG.
CC        4 - GRAPHICS INPUT
CC        5 - ALPHANUMERIC INPUT
CC        6 - GRAPHICS OUTPUT
CC        7 - ALPHANUMERIC OUTPUT.
CC        NOS/VE REQUIRES DIFFERENT UNITS FOR GRAPHICS AND ALPHANUMERIC
CC        I/O SINCE GRAPHICS I/O MUST BE IN "TRANSPARENT" MODE.
CC        NOTE THAT THE PROCEDURE ON NOS/VE THAT EXECUTES DATAPLOT WILL
CC        HANDLE CONNECTING THESE UNITS TO THE TERMINAL.
CC
CNVE  CALL SCLCMD('CREATE_VARIABLE N=STV_ZZZZZZ KIND=STATUS')
CNVE  CALL SCLCMD('DETACH_FILE $LOCAL.TAPE4 STATUS=STV_ZZZZZZ')
CNVE  CALL SCLCMD('DETACH_FILE $LOCAL.TAPE5 STATUS=STV_ZZZZZZ')
CNVE  CALL SCLCMD('DETACH_FILE $LOCAL.TAPE6 STATUS=STV_ZZZZZZ')
CNVE  CALL SCLCMD('DETACH_FILE $LOCAL.TAPE7 STATUS=STV_ZZZZZZ')
CNVE  CALL SCLCMD('REQUEST_TERMINAL $LOCAL.TAPE6 IEM=TRANSPARENT
CNVE * STATUS=STV_ZZZZZZ ')
CNVE  CALL SCLCMD('REQUEST_TERMINAL $LOCAL.TAPE4 IEM=TRANSPARENT '//
CNVE * 'TCM=F TTC=$CHAR(255) TFC=$CHAR(13) BKA=2 IOM=S TLM=N TTM=N '//
CNVE * 'STATUS=STV_ZZZZZZ')
CNVE  OPEN(UNIT=4,FILE='$LOCAL.TAPE4')
CNVE  OPEN(UNIT=5,FILE='$INPUT')
CNVE  OPEN(UNIT=6,FILE='$LOCAL.TAPE6')
CNVE  OPEN(UNIT=7,FILE='$OUTPUT')
CNVE  CALL SCLCMD('DELETE_VARIABLE STV_ZZZZZZ')
CC
CC
CC              *********************************************************
CC              **  MACHINE CONSTANTS FOR THE CDC CYBER 200 SERIES.    **
CC              **  (WITH THANKS TO MARY BETH ALGEO, NBS  AUG., 1986   **
CC              *********************************************************
CC
CC
C205  DATA I2MACH( 1) /    5 /
C205  DATA I2MACH( 2) /    6 /
C205  DATA I2MACH( 3) /    7 /
C205  DATA I2MACH( 4) /    6 /
C205  DATA I2MACH( 5) /   64 /
C205  DATA I2MACH( 6) /    8 /
C205  DATA I2MACH( 7) /    2 /
C205  DATA I2MACH( 8) /   47 /
C205  DATA I2MACH( 9) / X'00007FFFFFFFFFFF' /
C205  DATA I2MACH(10) /    2 /
C205  DATA I2MACH(11) /   47 /
C205  DATA I2MACH(12) / -28625 /
C205  DATA I2MACH(13) /  28718 /
C205  DATA I2MACH(14) /   94 /
C205  DATA I2MACH(15) / -28625 /
C205  DATA I2MACH(16) /  28718 /
CC
C205  DATA R2MACH(1) / X'9000400000000000' /
C205  DATA R2MACH(2) / X'6FFF7FFFFFFFFFFF' /
C205  DATA R2MACH(3) / X'FFA3400000000000' /
C205  DATA R2MACH(4) / X'FFA4400000000000' /
C205  DATA R2MACH(5) / X'FFD04D104D427DE8' /
CC
C205  DATA JSMALL(1) / X'9000400000000000' /
C205  DATA JSMALL(2) / X'8FD1000000000000' /
C205  DATA JLARGE(1) / X'6FFF7FFFFFFFFFFF' /
C205  DATA JLARGE(2) / X'6FD07FFFFFFFFFFF' /
C205  DATA JRIGHT(1) / X'FF74400000000000' /
C205  DATA JRIGHT(2) / X'FF45000000000000' /
C205  DATA JDIVER(1) / X'FF75400000000000' /
C205  DATA JDIVER(2) / X'FF46000000000000' /
C205  DATA JLOG10(1) / X'FFD04D104D427DE7' /
C205  DATA JLOG10(2) / X'FFA17DE623E2566A' /
CC
C205  IHOST1='205 '
C205  IHOST2='    '
C205  IHMOD1='205 '
C205  IHMOD2='    '
C205  IOPSY1='VSOS'
C205  IOPSY2='2.2 '
C205  ICOMPI='    '
C205  ISITE='    '
CC              ****************************************
CC              **  MACHINE CONSTANTS FOR THE CRAY 1  **
CC              ****************************************
CC
CC
CCRAY DATA I2MACH( 1) /   100 /
CCRAY DATA I2MACH( 2) /   101 /
CCRAY DATA I2MACH( 3) /   102 /
CCRAY DATA I2MACH( 4) /   101 /
CCRAY DATA I2MACH( 5) /    64 /
CCRAY DATA I2MACH( 6) /     8 /
CCRAY DATA I2MACH( 7) /     2 /
CCRAY DATA I2MACH( 8) /    63 /
CCRAY DATA I2MACH( 9) /  777777777777777777777B /
CCRAY DATA I2MACH(10) /     2 /
CCRAY DATA I2MACH(11) /    48 /
CCRAY DATA I2MACH(12) / -8192 /
CCRAY DATA I2MACH(13) /  8191 /
CCRAY DATA I2MACH(14) /    96 /
CCRAY DATA I2MACH(15) / -8192 /
CCRAY DATA I2MACH(16) /  8191 /
CC
CCRAY DATA R2MACH(1) / 200004000000000000000B /
CCRAY DATA R2MACH(2) / 577777777777777777777B /
CCRAY DATA R2MACH(3) / 377214000000000000000B /
CCRAY DATA R2MACH(4) / 377224000000000000000B /
CCRAY DATA R2MACH(5) / 377774642023241175720B /
CC
CCRAY DATA JSMALL(1) / 200004000000000000000B /
CCRAY DATA JSMALL(2) / 00000000000000000000B /
CCRAY DATA JLARGE(1) / 577777777777777777777B /
CCRAY DATA JLARGE(2) / 000007777777777777777B /
CCRAY DATA JRIGHT(1) / 377214000000000000000B /
CCRAY DATA JRIGHT(2) / 000000000000000000000B /
CCRAY DATA JDIVER(1) / 377224000000000000000B /
CCRAY DATA JDIVER(2) / 000000000000000000000B /
CCRAY DATA JLOG10(1) / 377774642023241175717B /
CCRAY DATA JLOG10(2) / 000007571421742254654B /
CC
CCRAY IHOST1='CRAY'
CCRAY IHOST2='    '
CCRAY IHMOD1='1'
CCRAY IHMOD2='    '
CCRAY IOPSY1='    '
CCRAY IOPSY2='    '
CCRAY ICOMPI='    '
CCRAY ISITE='    '
CC              ************************************************************
CC              **  MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200  **
CC              ************************************************************
CC
CDG   DATA I2MACH( 1) /   11 /
CDG   DATA I2MACH( 2) /   12 /
CDG   DATA I2MACH( 3) /    8 /
CDG   DATA I2MACH( 4) /   10 /
CDG   DATA I2MACH( 5) /   16 /
CDG   DATA I2MACH( 6) /    2 /
CDG   DATA I2MACH( 7) /    2 /
CDG   DATA I2MACH( 8) /   15 /
CDG   DATA I2MACH( 9) /32767 /
CDG   DATA I2MACH(10) /   16 /
CDG   DATA I2MACH(11) /    6 /
CDG   DATA I2MACH(12) /  -64 /
CDG   DATA I2MACH(13) /   63 /
CDG   DATA I2MACH(14) /   14 /
CDG   DATA I2MACH(15) /  -64 /
CDG   DATA I2MACH(16) /   63 /
CC
CDG   NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD -
CDG   STATIC R2MACH(5)
CC
CDG   DATA ISMALL/20K,0/,ILARGE/77777K,177777K/
CDG   DATA IRIGHT/35420K,0/,IDIVER/36020K,0/
CDG   DATA ILOG10/40423K,42023K/
CC
CDG   NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD -
CDG   STATIC D2MACH(5)
CC
CDG   DATA JSMALL/20K,3*0/,JLARGE/77777K,3*177777K/
CDG   DATA JRIGHT/31420K,3*0/,JDIVER/32020K,3*0/
CDG   DATA JLOG10/40423K,42023K,50237K,74776K/
CC
CDG   IHOST1='DG'
CDG   IHOST2='    '
CDG   IHMOD1='ECLI'
CDG   IHMOD2='200'
CDG   IOPSY1='    '
CDG   IOPSY2='    '
CDG   ICOMPI='    '
CDG   ISITE='    '
CC
CC              ********************************************
CC              **  MACHINE CONSTANTS FOR THE HARRIS 220  **
CC              ********************************************
CC
CHARR DATA I2MACH( 1) /       5 /
CHARR DATA I2MACH( 2) /       6 /
CHARR DATA I2MACH( 3) /       0 /
CHARR DATA I2MACH( 4) /       6 /
CHARR DATA I2MACH( 5) /      24 /
CHARR DATA I2MACH( 6) /       3 /
CHARR DATA I2MACH( 7) /       2 /
CHARR DATA I2MACH( 8) /      23 /
CHARR DATA I2MACH( 9) / 8388607 /
CHARR DATA I2MACH(10) /       2 /
CHARR DATA I2MACH(11) /      23 /
CHARR DATA I2MACH(12) /    -127 /
CHARR DATA I2MACH(13) /     127 /
CHARR DATA I2MACH(14) /      38 /
CHARR DATA I2MACH(15) /    -127 /
CHARR DATA I2MACH(16) /     127 /
CC
CHARR DATA ISMALL(1),ISMALL(2) / '20000000, '00000201 /
CHARR DATA ILARGE(1),ILARGE(2) / '37777777, '00000177 /
CHARR DATA IRIGHT(1),IRIGHT(2) / '20000000, '00000352 /
CHARR DATA IDIVER(1),IDIVER(2) / '20000000, '00000353 /
CHARR DATA ILOG10(1),ILOG10(2) / '23210115, '00000377 /
CC
CHARR DATA JSMALL(1),JSMALL(2) / '20000000, '00000201 /
CHARR DATA JLARGE(1),JLARGE(2) / '37777777, '37777577 /
CHARR DATA JRIGHT(1),JRIGHT(2) / '20000000, '00000333 /
CHARR DATA JDIVER(1),JDIVER(2) / '20000000, '00000334 /
CHARR DATA JLOG10(1),JLOG10(2) / '23210115, '10237777 /
CC
CHARR IHOST1='HARR'
CHARR IHOST2='    '
CHARR IHMOD1='220'
CHARR IHMOD2='    '
CHARR IOPSY1='    '
CHARR IOPSY2='    '
CHARR ICOMPI='    '
CHARR ISITE='    '
CC
CC              ************************************************************
CC              **  MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES.  **
CC              ************************************************************
CC
CHONE DATA I2MACH( 1) /    5 /
CHONE DATA I2MACH( 2) /    6 /
CHONE DATA I2MACH( 3) /   43 /
CHONE DATA I2MACH( 4) /    6 /
CHONE DATA I2MACH( 5) /   36 /
CHONE DATA I2MACH( 6) /    6 /
CHONE DATA I2MACH( 7) /    2 /
CHONE DATA I2MACH( 8) /   35 /
CHONE DATA I2MACH( 9) / O377777777777 /
CHONE DATA I2MACH(10) /    2 /
CHONE DATA I2MACH(11) /   27 /
CHONE DATA I2MACH(12) / -127 /
CHONE DATA I2MACH(13) /  127 /
CHONE DATA I2MACH(14) /   63 /
CHONE DATA I2MACH(15) / -127 /
CHONE DATA I2MACH(16) /  127 /
CC
CHONE DATA R2MACH(1) / O402400000000 /
CHONE DATA R2MACH(2) / O376777777777 /
CHONE DATA R2MACH(3) / O714400000000 /
CHONE DATA R2MACH(4) / O716400000000 /
CHONE DATA R2MACH(5) / O776464202324 /
CC
CHONE DATA JSMALL(1),JSMALL(2) / O402400000000, O000000000000 /
CHONE DATA JLARGE(1),JLARGE(2) / O376777777777, O777777777777 /
CHONE DATA JRIGHT(1),JRIGHT(2) / O604400000000, O000000000000 /
CHONE DATA JDIVER(1),JDIVER(2) / O606400000000, O000000000000 /
CHONE DATA JLOG10(1),JLOG10(2) / O776464202324, O117571775714 /
CC
CHONE IHOST1='HONE'
CHONE IHOST2='    '
CHONE IHMOD1='6000'
CHONE IHMOD2='    '
CHONE IOPSY1='    '
CHONE IOPSY2='    '
CHONE ICOMPI='    '
CHONE ISITE='    '
CC
CC              ************************************************
CC              **  MACHINE CONSTANTS FOR THE HP 2100         **
CC              **  3 WORD DOUBLE PRECISION OPTION WITH FTN4  **
CC              ************************************************
CC
CHP1  DATA I1MACH( 1) /    5 /
CHP1  DATA I1MACH( 2) /    6 /
CHP1  DATA I1MACH( 3) /    4 /
CHP1  DATA I1MACH( 4) /    1 /
CHP1  DATA I1MACH( 5) /   16 /
CHP1  DATA I1MACH( 6) /    2 /
CHP1  DATA I1MACH( 7) /    2 /
CHP1  DATA I1MACH( 8) /   15 /
CHP1  DATA I1MACH( 9) / 32767 /
CHP1  DATA I1MACH(10) /    2 /
CHP1  DATA I1MACH(11) /   23 /
CHP1  DATA I1MACH(12) / -128 /
CHP1  DATA I1MACH(13) /  127 /
CHP1  DATA I1MACH(14) /   39 /
CHP1  DATA I1MACH(15) / -128 /
CHP1  DATA I1MACH(16) /  127 /
CC
CHP1  DATA ISMALL(1), ISMALL(2) / 40000B,       1 /
CHP1  DATA ILARGE(1), ILARGE(2) / 77777B, 177776B /
CHP1  DATA IRIGHT(1), IRIGHT(2) / 40000B,    325B /
CHP1  DATA IDIVER(1), IDIVER(2) / 40000B,    327B /
CHP1  DATA ILOG10(1), ILOG10(2) / 46420B,  46777B /
CC
CHP1  DATA JSMALL(1), JSMALL(2), JSMALL(3) / 40000B,       0,       1 /
CHP1  DATA JLARGE(1), JLARGE(2), JLARGE(3) / 77777B, 177777B, 177776B /
CHP1  DATA JRIGHT(1), JRIGHT(2), JRIGHT(3) / 40000B,       0,    265B /
CHP1  DATA JDIVER(1), JDIVER(2), JDIVER(3) / 40000B,       0,    276B /
CHP1  DATA JLOG10(1), JLOG10(2), JLOG10(3) / 46420B,  46502B,  77777B /
CC
CHP1  IHOST1='HP'
CHP1  IHOST2='    '
CHP1  IHMOD1='2100'
CHP1  IHMOD2='    '
CHP1  IOPSY1='    '
CHP1  IOPSY2='    '
CHP1  ICOMPI='FTN4'
CHP1  ISITE='    '
CC
CC              ************************************************
CC              **  MACHINE CONSTANTS FOR THE HP 2100         **
CC              **  4 WORD DOUBLE PRECISION OPTION WITH FTN4  **
CC              ************************************************
CC
CC
CHP2  DATA I1MACH( 1) /    5 /
CHP2  DATA I1MACH( 2) /    6 /
CHP2  DATA I1MACH( 3) /    4 /
CHP2  DATA I1MACH( 4) /    1 /
CHP2  DATA I1MACH( 5) /   16 /
CHP2  DATA I1MACH( 6) /    2 /
CHP2  DATA I1MACH( 7) /    2 /
CHP2  DATA I1MACH( 8) /   15 /
CHP2  DATA I1MACH( 9) / 32767 /
CHP2  DATA I1MACH(10) /    2 /
CHP2  DATA I1MACH(11) /   23 /
CHP2  DATA I1MACH(12) / -128 /
CHP2  DATA I1MACH(13) /  127 /
CHP2  DATA I1MACH(14) /   55 /
CHP2  DATA I1MACH(15) / -128 /
CHP2  DATA I1MACH(16) /  127 /
CC
CHP2  DATA ISMALL(1), ISMALL(2) / 40000B,       1 /
CHP2  DATA ILARGE(1), ILARGE(2) / 77777B, 177776B /
CHP2  DATA IRIGHT(1), IRIGHT(2) / 40000B,    325B /
CHP2  DATA IDIVER(1), IDIVER(2) / 40000B,    327B /
CHP2  DATA ILOG10(1), ILOG10(2) / 46420B,  46777B /
CC
CHP2  DATA JSMALL(1), JSMALL(2) /  40000B,       0 /
CHP2  DATA JSMALL(3), JSMALL(4) /       0,       1 /
CHP2  DATA JLARGE(1), JLARGE(2) /  77777B, 177777B /
CHP2  DATA JLARGE(3), JLARGE(4) / 177777B, 177776B /
CHP2  DATA JRIGHT(1), JRIGHT(2) /  40000B,       0 /
CHP2  DATA JRIGHT(3), JRIGHT(4) /       0,    225B /
CHP2  DATA JDIVER(1), JDIVER(2) /  40000B,       0 /
CHP2  DATA JDIVER(3), JDIVER(4) /       0,    227B /
CHP2  DATA JLOG10(1), JLOG10(2) /  46420B,  46502B /
CHP2  DATA JLOG10(3), JLOG10(4) /  76747B, 176377B /
CC
CHP2  IHOST1='HP'
CHP2  IHOST2='    '
CHP2  IHMOD1='2100'
CHP2  IHMOD2='    '
CHP2  IOPSY1='    '
CHP2  IOPSY2='    '
CHP2  ICOMPI='FTN4'
CHP2  ISITE='    '
CC              ************************************************
CC              **  MACHINE CONSTANTS FOR THE HP 9000         **
CC              **  THESE VALUES ARE TENTATIVE AND HAVE NOT BEEN CHECKED *******
CC              ************************************************
CC
CHP9  DATA I2MACH( 1) /    5 /
CHP9  DATA I2MACH( 2) /    6 /
CHP9  DATA I2MACH( 3) /    7 /
CHP9  DATA I2MACH( 4) /    6 /
CHP9  DATA I2MACH( 5) /   32 /
CHP9  DATA I2MACH( 6) /    4 /
CHP9  DATA I2MACH( 7) /    2 /
CHP9  DATA I2MACH( 8) /   31 /
CHP9  DATA I2MACH( 9) / 2147483647 /
CHP9  DATA I2MACH(10) /    2 /
CHP9  DATA I2MACH(11) /   23 /
CHP9  DATA I2MACH(12) / -128 /
CHP9  DATA I2MACH(13) /  127 /
CHP9  DATA I2MACH(14) /   55 /
CHP9  DATA I2MACH(15) / -128 /
CHP9  DATA I2MACH(16) /  127 /
CC
CHP9  DATA R2MACH(1) / O00000000200 /
CHP9  DATA R2MACH(2) / O37777677777 /
CHP9  DATA R2MACH(3) / O00000032200 /
CHP9  DATA R2MACH(4) / O00000032400 /
CHP9  DATA R2MACH(5) / O04046637632 /
CC
CHP9  IHOST1='HP'
CHP9  IHOST2='    '
CHP9  IHMOD1='9000'
CHP9  IHMOD2='    '
CHP9  IOPSY1='    '
CHP9  IOPSY2='    '
CHP9  ICOMPI='    '
CHP9  ISITE='    '
CC
CC              ********************************************************
CC              **  MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,     **
CC              **  XEROX SIGMA 5/7/9,                                **
CC              **  SEL SYSTEMS 85/86,                                **
CC              **  INTERDATA 30 AND 40,                            **
CC              **  PERKIN-ELMER 3230, 3240, 3242,                   **
CC              ********************************************************
CC
CC
CIBM   DATA I2MACH( 1) /   5 /
CIBM   DATA I2MACH( 2) /   6 /
CIBM   DATA I2MACH( 3) /   7 /
CIBM   DATA I2MACH( 4) /   6 /
CIBM   DATA I2MACH( 5) /  32 /
CIBM   DATA I2MACH( 6) /   4 /
CIBM   DATA I2MACH( 7) /   2 /
CIBM   DATA I2MACH( 8) /  31 /
CIBM   DATA I2MACH( 9) / Z7FFFFFFF /
CIBM   DATA I2MACH(10) /  16 /
CIBM   DATA I2MACH(11) /   6 /
CIBM   DATA I2MACH(12) / -64 /
CIBM   DATA I2MACH(13) /  63 /
CIBM   DATA I2MACH(14) /  14 /
CIBM   DATA I2MACH(15) / -64 /
CIBM   DATA I2MACH(16) /  63 /
CC
CIBM   DATA R2MACH(1) / Z00100000 /
CIBM   DATA R2MACH(2) / Z7FFFFFFF /
CIBM   DATA R2MACH(3) / Z3B100000 /
CIBM   DATA R2MACH(4) / Z3C100000 /
CIBM   DATA R2MACH(5) / Z41134413 /
CC
CIBM   DATA JSMALL(1),JSMALL(2) / Z00100000, Z00000000 /
CIBM   DATA JLARGE(1),JLARGE(2) / Z7FFFFFFF, ZFFFFFFFF /
CIBM   DATA JRIGHT(1),JRIGHT(2) / Z33100000, Z00000000 /
CIBM   DATA JDIVER(1),JDIVER(2) / Z34100000, Z00000000 /
CIBM   DATA JLOG10(1),JLOG10(2) / Z41134413, Z509F79FF /
CC
CIBM   IHOST1='IBM'
CIBM   IHOST2='    '
CIBM   IHMOD1='370'
CIBM   IHMOD2='    '
CIBM   IOPSY1='    '
CIBM   IOPSY2='    '
CIBM   ICOMPI='    '
CIBM   ISITE='    '
CC              ********************************************************
CC              **  MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR).  **
CC              ********************************************************
C
CPDP1 DATA I2MACH( 1) /    5 /
CPDP1 DATA I2MACH( 2) /    6 /
CPDP1 DATA I2MACH( 3) /    5 /
CPDP1 DATA I2MACH( 4) /    6 /
CPDP1 DATA I2MACH( 5) /   36 /
CPDP1 DATA I2MACH( 6) /    5 /
CPDP1 DATA I2MACH( 7) /    2 /
CPDP1 DATA I2MACH( 8) /   35 /
CPDP1 DATA I2MACH( 9) / "377777777777 /
CPDP1 DATA I2MACH(10) /    2 /
CPDP1 DATA I2MACH(11) /   27 /
CPDP1 DATA I2MACH(12) / -128 /
CPDP1 DATA I2MACH(13) /  127 /
CPDP1 DATA I2MACH(14) /   54 /
CPDP1 DATA I2MACH(15) / -101 /
CPDP1 DATA I2MACH(16) /  127 /
CC
CPDP1 DATA R2MACH(1) / "000400000000 /
CPDP1 DATA R2MACH(2) / "377777777777 /
CPDP1 DATA R2MACH(3) / "146400000000 /
CPDP1 DATA R2MACH(4) / "147400000000 /
CPDP1 DATA R2MACH(5) / "177464202324 /
CC
CPDP1 DATA JSMALL(1),JSMALL(2) / "033400000000, "000000000000 /
CPDP1 DATA JLARGE(1),JLARGE(2) / "377777777777, "344777777777 /
CPDP1 DATA JRIGHT(1),JRIGHT(2) / "113400000000, "000000000000 /
CPDP1 DATA JDIVER(1),JDIVER(2) / "114400000000, "000000000000 /
CPDP1 DATA JLOG10(1),JLOG10(2) / "177464202324, "144117571776 /
CC
CPDP1 IHOST1='PDP'
CPDP1 IHOST2='    '
CPDP1 IHMOD1='10'
CPDP1 IHMOD2='    '
CPDP1 IOPSY1='KA'
CPDP1 IOPSY2='    '
CPDP1 ICOMPI='    '
CPDP1 ISITE='    '
CC
CC              ********************************************************
CC              **  MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR).  **
CC              ********************************************************
CC
CPDP2 DATA I2MACH( 1) /    5 /
CPDP2 DATA I2MACH( 2) /    6 /
CPDP2 DATA I2MACH( 3) /    5 /
CPDP2 DATA I2MACH( 4) /    6 /
CPDP2 DATA I2MACH( 5) /   36 /
CPDP2 DATA I2MACH( 6) /    5 /
CPDP2 DATA I2MACH( 7) /    2 /
CPDP2 DATA I2MACH( 8) /   35 /
CPDP2 DATA I2MACH( 9) / "377777777777 /
CPDP2 DATA I2MACH(10) /    2 /
CPDP2 DATA I2MACH(11) /   27 /
CPDP2 DATA I2MACH(12) / -128 /
CPDP2 DATA I2MACH(13) /  127 /
CPDP2 DATA I2MACH(14) /   62 /
CPDP2 DATA I2MACH(15) / -128 /
CPDP2 DATA I2MACH(16) /  127 /
CC
CPDP2 DATA R2MACH(1) / "000400000000 /
CPDP2 DATA R2MACH(2) / "377777777777 /
CPDP2 DATA R2MACH(3) / "146400000000 /
CPDP2 DATA R2MACH(4) / "147400000000 /
CPDP2 DATA R2MACH(5) / "177464202324 /
CC
CPDP2 DATA JSMALL(1),JSMALL(2) / "000400000000, "000000000000 /
CPDP2 DATA JLARGE(1),JLARGE(2) / "377777777777, "377777777777 /
CPDP2 DATA JRIGHT(1),JRIGHT(2) / "103400000000, "000000000000 /
CPDP2 DATA JDIVER(1),JDIVER(2) / "104400000000, "000000000000 /
CPDP2 DATA JLOG10(1),JLOG10(2) / "177464202324, "476747767461 /
CC
CC              *********************************************************
CC              **  MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING  **
CC              **  32-BIT INTEGER ARITHMETIC.                         **
CC              *********************************************************
CC
CPDP3 DATA I2MACH( 1) /    5 /
CPDP3 DATA I2MACH( 2) /    6 /
CPDP3 DATA I2MACH( 3) /    5 /
CPDP3 DATA I2MACH( 4) /    6 /
CPDP3 DATA I2MACH( 5) /   32 /
CPDP3 DATA I2MACH( 6) /    4 /
CPDP3 DATA I2MACH( 7) /    2 /
CPDP3 DATA I2MACH( 8) /   31 /
CPDP3 DATA I2MACH( 9) / 2147483647 /
CPDP3 DATA I2MACH(10) /    2 /
CPDP3 DATA I2MACH(11) /   24 /
CPDP3 DATA I2MACH(12) / -127 /
CPDP3 DATA I2MACH(13) /  127 /
CPDP3 DATA I2MACH(14) /   56 /
CPDP3 DATA I2MACH(15) / -127 /
CPDP3 DATA I2MACH(16) /  127 /
CC
CPDP3 DATA R2MACH(1) / O00040000000 /
CPDP3 DATA R2MACH(2) / O17777777777 /
CPDP3 DATA R2MACH(3) / O06440000000 /
CPDP3 DATA R2MACH(4) / O06500000000 /
CPDP3 DATA R2MACH(5) / O07746420233 /
CC
CPDP3 DATA ISMALL(1) /    8388608 /
CPDP3 DATA ILARGE(1) / 2147483647 /
CPDP3 DATA IRIGHT(1) /  880803840 /
CPDP3 DATA IDIVER(1) /  889192448 /
CPDP3 DATA ILOG10(1) / 1067065499 /
CC
CPDP3 DATA JSMALL(1),JSMALL(2) /    8388608,           0 /
CPDP3 DATA JLARGE(1),JLARGE(2) / 2147483647,          -1 /
CPDP3 DATA JRIGHT(1),JRIGHT(2) /  612368384,           0 /
CPDP3 DATA JDIVER(1),JDIVER(2) /  620756992,           0 /
CPDP3 DATA JLOG10(1),JLOG10(2) / 1067065498, -2063872008 /
CPDP3 DATA JSMALL(1),JSMALL(2) / O00040000000, O00000000000 /
CPDP3 DATA JLARGE(1),JLARGE(2) / O17777777777, O37777777777 /
CPDP3 DATA JRIGHT(1),JRIGHT(2) / O04440000000, O00000000000 /
CPDP3 DATA JDIVER(1),JDIVER(2) / O04500000000, O00000000000 /
CPDP3 DATA JLOG10(1),JLOG10(2) / O07746420232, O20476747770 /
CC
CC              *********************************************************
CC              **  MACHINE CONSTANTS FOR PDP-11 FORTRAN'S SUPPORTING  **
CC              **  16-BIT INTEGER ARITHMETIC.                         **
CC              *********************************************************
CC
CPDP4 DATA I2MACH( 1) /    5 /
CPDP4 DATA I2MACH( 2) /    6 /
CPDP4 DATA I2MACH( 3) /    5 /
CPDP4 DATA I2MACH( 4) /    6 /
CPDP4 DATA I2MACH( 5) /   16 /
CPDP4 DATA I2MACH( 6) /    2 /
CPDP4 DATA I2MACH( 7) /    2 /
CPDP4 DATA I2MACH( 8) /   15 /
CPDP4 DATA I2MACH( 9) / 32767 /
CPDP4 DATA I2MACH(10) /    2 /
CPDP4 DATA I2MACH(11) /   24 /
CPDP4 DATA I2MACH(12) / -127 /
CPDP4 DATA I2MACH(13) /  127 /
CPDP4 DATA I2MACH(14) /   56 /
CPDP4 DATA I2MACH(15) / -127 /
CPDP4 DATA I2MACH(16) /  127 /
CC
CPDP4 DATA ISMALL(1),ISMALL(2) /   128,     0 /
CPDP4 DATA ILARGE(1),ILARGE(2) / 32767,    -1 /
CPDP4 DATA IRIGHT(1),IRIGHT(2) / 13440,     0 /
CPDP4 DATA IDIVER(1),IDIVER(2) / 13568,     0 /
CPDP4 DATA ILOG10(1),ILOG10(2) / 16282,  8347 /
CPDP4 DATA ISMALL(1),ISMALL(2) / O000200, O000000 /
CPDP4 DATA ILARGE(1),ILARGE(2) / O077777, O177777 /
CPDP4 DATA IRIGHT(1),IRIGHT(2) / O032200, O000000 /
CPDP4 DATA IDIVER(1),IDIVER(2) / O032400, O000000 /
CPDP4 DATA ILOG10(1),ILOG10(2) / O037632, O020233 /
CC
CPDP4 DATA JSMALL(1),JSMALL(2) /    128,      0 /
CPDP4 DATA JSMALL(3),JSMALL(4) /      0,      0 /
CPDP4 DATA JLARGE(1),JLARGE(2) /  32767,     -1 /
CPDP4 DATA JLARGE(3),JLARGE(4) /     -1,     -1 /
CPDP4 DATA JRIGHT(1),JRIGHT(2) /   9344,      0 /
CPDP4 DATA JRIGHT(3),JRIGHT(4) /      0,      0 /
CPDP4 DATA JDIVER(1),JDIVER(2) /   9472,      0 /
CPDP4 DATA JDIVER(3),JDIVER(4) /      0,      0 /
CPDP4 DATA JLOG10(1),JLOG10(2) /  16282,   8346 /
CPDP4 DATA JLOG10(3),JLOG10(4) / -31493, -12296 /
CPDP4 DATA JSMALL(1),JSMALL(2) / O000200, O000000 /
CPDP4 DATA JSMALL(3),JSMALL(4) / O000000, O000000 /
CPDP4 DATA JLARGE(1),JLARGE(2) / O077777, O177777 /
CPDP4 DATA JLARGE(3),JLARGE(4) / O177777, O177777 /
CPDP4 DATA JRIGHT(1),JRIGHT(2) / O022200, O000000 /
CPDP4 DATA JRIGHT(3),JRIGHT(4) / O000000, O000000 /
CPDP4 DATA JDIVER(1),JDIVER(2) / O022400, O000000 /
CPDP4 DATA JDIVER(3),JDIVER(4) / O000000, O000000 /
CPDP4 DATA JLOG10(1),JLOG10(2) / O037632, O020232 /
CPDP4 DATA JLOG10(3),JLOG10(4) / O102373, O147770 /
C
CC
CPDP2 IHOST1='PDP'
CPDP2 IHOST2='    '
CPDP2 IHMOD1='11'
CPDP2 IHMOD2='    '
CPDP2 IOPSY1=' '
CPDP2 IOPSY2='    '
CPDP2 ICOMPI='    '
CPDP2 ISITE='    '
CC
CC     THE FOLLOWING IS FOR THE PRIME--
CC              **********************************************************
CC              **  MACHINE CONSTANTS FOR THE PRIME 50 SERIES.          **
CC              **  FOR F77 COMPILER WITH -INTL OPTION                  **
C               **  MY THANKS TO ING-YUNG LI TSE FOR THIS CONTRIBUTION  **
C               **  (NOVEMBER, 1986).                                   **
CC              **********************************************************
CC
CPRIM DATA I2MACH( 1) /    1 /
CPRIM DATA I2MACH( 2) /    1 /
CPRIM DATA I2MACH( 3) /    7 /
CPRIM DATA I2MACH( 4) /    1 /
CPRIM DATA I2MACH( 5) /   32 /
CPRIM DATA I2MACH( 6) /    4 /
CPRIM DATA I2MACH( 7) /    2 /
CPRIM DATA I2MACH( 8) /   31 /
CPRIM DATA I2MACH( 9) / 2147483647 /
CPRIM DATA I2MACH(10) /    2 /
CPRIM DATA I2MACH(11) /   23 /
CPRIM DATA I2MACH(12) / -128 /
CPRIM DATA I2MACH(13) /  127 /
CPRIM DATA I2MACH(14) /   47 /
CPRIM DATA I2MACH(15) / -32896 /
CPRIM DATA I2MACH(16) /  32639 /
CC
CPRIM R2MACH(1)=0.5*2.0**(-128)
CPRIM R2MACH(2)=(1.0-2.0**(-23))*2.0*(127)
CPRIM R2MACH(3)=2.0**(-22)
CPRIM R2MACH(4)=2.0**(-21)
CPRIM R2MACH(5)=ALOG10(2.0)
CC
CPRIM D2MACH(1)=0.5D0*2.0D0**(-32590)
CPRIM D2MACH(2)=(1.0D0-2.0D0**(-47))*2.0D0**(32638)
CPRIM D2MACH(3)=2.0D0**(-46)
CPRIM D2MACH(4)=2.0D0**(-45)
CPRIM D2MACH(5)=DLOG10(2.0D0)
CC
CPRIM  IHOST1='PRIM'
CPRIM  IHOST2='    '
CPRIM  IHMOD1='X50 '
CPRIM  IHMOD2='    '
CPRIM  IOPSY1='PRIM'
CPRIM  IOPSY2='OS  '
CPRIM  ICOMPI='F77 '
CPRIM  ISITE='    '
CC
CC     THE FOLLOWING IS FOR THE UNIVAC--
CC               ***************************************************************
CC               **  MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. FTN COMPILER
CC               ***************************************************************
CC
CUNIV  DATA I2MACH( 1) /    5 /
CUNIV  DATA I2MACH( 2) /    6 /
CUNIV  DATA I2MACH( 3) /    1 /
CUNIV  DATA I2MACH( 4) /    6 /
CUNIV  DATA I2MACH( 5) /   36 /
CUNIV  DATA I2MACH( 6) /    4 /
CUNIV  DATA I2MACH( 7) /    2 /
CUNIV  DATA I2MACH( 8) /   35 /
CUNIV  DATA I2MACH( 9) / O377777777777 /
CUNIV  DATA I2MACH(10) /    2 /
CUNIV  DATA I2MACH(11) /   27 /
CUNIV  DATA I2MACH(12) / -128 /
CUNIV  DATA I2MACH(13) /  127 /
CUNIV  DATA I2MACH(14) /   60 /
CUNIV  DATA I2MACH(15) /-1024 /
CUNIV  DATA I2MACH(16) / 1023 /
CC
CUNIV  DATA R2MACH(1) / O000400000000 /
CUNIV  DATA R2MACH(2) / O377777777777 /
CUNIV  DATA R2MACH(3) / O146400000000 /
CUNIV  DATA R2MACH(4) / O147400000000 /
CUNIV  DATA R2MACH(5) / O177464202324 /
CC
CUNIV  DATA JSMALL(1),JSMALL(2) /    128,      0 /
CUNIV  DATA JSMALL(3),JSMALL(4) /      0,      0 /
CUNIV  DATA JLARGE(1),JLARGE(2) /  32767,     -1 /
CUNIV  DATA JLARGE(3),JLARGE(4) /     -1,     -1 /
CUNIV  DATA JRIGHT(1),JRIGHT(2) /   9344,      0 /
CUNIV  DATA JRIGHT(3),JRIGHT(4) /      0,      0 /
CUNIV  DATA JDIVER(1),JDIVER(2) /   9472,      0 /
CUNIV  DATA JDIVER(3),JDIVER(4) /      0,      0 /
CUNIV  DATA JLOG10(1),JLOG10(2) /  16282,   8346 /
CUNIV  DATA JLOG10(3),JLOG10(4) / -31493, -12296 /
CUNIV  DATA JSMALL(1),JSMALL(2) / O000200, O000000 /
CUNIV  DATA JSMALL(3),JSMALL(4) / O000000, O000000 /
CUNIV  DATA JLARGE(1),JLARGE(2) / O077777, O177777 /
CUNIV  DATA JLARGE(3),JLARGE(4) / O177777, O177777 /
CUNIV  DATA JRIGHT(1),JRIGHT(2) / O022200, O000000 /
CUNIV  DATA JRIGHT(3),JRIGHT(4) / O000000, O000000 /
CUNIV  DATA JDIVER(1),JDIVER(2) / O022400, O000000 /
CUNIV  DATA JDIVER(3),JDIVER(4) / O000000, O000000 /
CUNIV  DATA JLOG10(1),JLOG10(2) / O037632, O020232 /
CUNIV  DATA JLOG10(3),JLOG10(4) / O102373, O147770 /
CC
CUNIV  IHOST1='UNIV'
CUNIV  IHOST2='    '
CUNIV  IHMOD1='1100'
CUNIV  IHMOD2='    '
CUNIV  IOPSY1='EXEC'
CUNIV  IOPSY2='8'
CUNIV  ICOMPI='FTN'
CUNIV  ISITE='NBS'
CC
CC              ****************************************************************
CC              **  MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. FOR COMPILER
CC              ****************************************************************
CC
CUNI2 DATA I2MACH( 1) /    5 /
CUNI2 DATA I2MACH( 2) /    6 /
CUNI2 DATA I2MACH( 3) /    1 /
CUNI2 DATA I2MACH( 4) /    6 /
CUNI2 DATA I2MACH( 5) /   36 /
CUNI2 DATA I2MACH( 6) /    6 /
CUNI2 DATA I2MACH( 7) /    2 /
CUNI2 DATA I2MACH( 8) /   35 /
CUNI2 DATA I2MACH( 9) / O377777777777 /
CUNI2 DATA I2MACH(10) /    2 /
CUNI2 DATA I2MACH(11) /   27 /
CUNI2 DATA I2MACH(12) / -128 /
CUNI2 DATA I2MACH(13) /  127 /
CUNI2 DATA I2MACH(14) /   60 /
CUNI2 DATA I2MACH(15) /-1024 /
CUNI2 DATA I2MACH(16) / 1023 /
CC
CUNI2 DATA R2MACH(1) / O000400000000 /
CUNI2 DATA R2MACH(2) / O377777777777 /
CUNI2 DATA R2MACH(3) / O146400000000 /
CUNI2 DATA R2MACH(4) / O147400000000 /
CUNI2 DATA R2MACH(5) / O177464202324 /
CC
CUNI2 DATA JSMALL(1),JSMALL(2) / O000040000000, O000000000000 /
CUNI2 DATA JLARGE(1),JLARGE(2) / O377777777777, O777777777777 /
CUNI2 DATA JRIGHT(1),JRIGHT(2) / O170540000000, O000000000000 /
CUNI2 DATA JDIVER(1),JDIVER(2) / O170640000000, O000000000000 /
CUNI2 DATA JLOG10(1),JLOG10(2) / O177746420232, O411757177572 /
CC
CUNI2 IHOST1='UNIV'
CUNI2 IHOST2='    '
CUNI2 IHMOD1='1100'
CUNI2 IHMOD2='    '
CUNI2 IOPSY1='EXEC'
CUNI2 IOPSY2='8'
CUNI2 ICOMPI='FOR'
CUNI2 ISITE='    '
CC
C     THE FOLLOWING IS FOR THE 16-BIT IBM-PC AND CLONES (UNDER DOS) (NOT YET VER
C               ***********************************************************
C               **  MACHINE CONSTANTS FOR THE 16-BIT IBM-PC (NOT YET VERIFIED)
C               **  (WITH 8087 COPROCESSOR)                              **
C               **  (WITH APPRECIATION TO MARTIN KNAPP-CORDES,           **
C               **  JULY, 1986)                                          **
C               ***********************************************************
CC
      DATA I2MACH( 1) /    5 /
      DATA I2MACH( 2) /    6 /
      DATA I2MACH( 3) /    6 /
      DATA I2MACH( 4) /    0 /
      DATA I2MACH( 5) /   32 /
      DATA I2MACH( 6) /    4 /
      DATA I2MACH( 7) /    2 /
      DATA I2MACH( 8) /   31 /
      DATA I2MACH( 9) / 2147483647 /
      DATA I2MACH(10) /    2 /
      DATA I2MACH(11) /   24 /
      DATA I2MACH(12) / -125 /
      DATA I2MACH(13) /  127 /
      DATA I2MACH(14) /   53 /
      DATA I2MACH(15) / -1021 /
      DATA I2MACH(16) /  1023 /
CC
CCCCC DATA R2MACH(1) / Z'00800000' /
CCCCC DATA R2MACH(2) / Z'7F7FFFFF' /
CCCCC DATA R2MACH(3) / Z'33800000' /
CCCCC DATA R2MACH(4) / Z'34000000' /
CCCCC DATA R2MACH(5) / Z'3E9A209B' /
      DATA R2MACH(1) / 1.18E-38 /
      DATA R2MACH(2) / 3.340E+38 /
      DATA R2MACH(3) / 0.59E-07 /
      DATA R2MACH(4) / 1.19E-07 /
      DATA R2MACH(5) / 0.30102999566 /
CC
CCCCC DATA ISMALL(1) / Z'00800000' /
CCCCC DATA ILARGE(1) / Z'7F7FFFFF' /
CCCCC DATA IRIGHT(1) / Z'33800000' /
CCCCC DATA IDIVER(1) / Z'34000000' /
CCCCC DATA ILOG10(1) / Z'3E9A209B' /
      DATA D2MACH(1) / 2.23D-308 /
      DATA D2MACH(2) / 1.790D+308 /
      DATA D2MACH(3) / 1.11D-16 /
      DATA D2MACH(4) / 2.22D-16 /
      DATA D2MACH(5) / 0.30102999563981195D0 /
CC
CCCCC DATA JSMALL(1),JSMALL(2) / Z'00100000', Z'00000000' /
CCCCC DATA JLARGE(1),JLARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' /
CCCCC DATA JRIGHT(1),JRIGHT(2) / Z'3CA00000', Z'00000000' /
CCCCC DATA JDIVER(1),JDIVER(2) / Z'3CB00000', Z'00000000' /
CCCCC DATA JLOG10(1),JLOG10(2) / Z'3FD34413', Z'509F79FF' /
 
      IHOST1='IBM-'
      IHOST2='PC  '
CCCCC THE FOLLOWING LINE WAS FIXED               APRIL 1992
CCCCC IN CONNECTION WITH CODE IN   DPSYS2.FOR    APRIL 1992
CCCCC IHMOD1='    '
      IHMOD1='386 '
      IHMOD2='    '
      IOPSY1='PC-D'
      IOPSY2='OS  '
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IN CONNECTION WITH CODE IN   DPSYS2.FOR    APRIL 1992
CCCCC ICOMPI='    '
CCCCC JUNE 1996.  FOR LAHEY COMPILER, SET ICOMPI SWITCH DIFFERENT.
CCCCC ICOMPI='OTG '
CLAHE ICOMPI='LAHE'
      ICOMPI='MS-F'
      ISITE='    '
CC
C     THE FOLLOWING IS FOR THE MACINTOCH (NOT YET VERIFIED)--
C               **************************************************************
C               **  MACHINE CONSTANTS FOR THE MACINTOCH (NOT YET VERIFIED)  **
C               **  (WITH APPRECIATION TO MARTIN KNAPP-CORDES,              **
C               **  JULY, 1986)                                             **
C               **************************************************************
CC
CMACI  DATA I2MACH( 1) /    5 /
CMACI  DATA I2MACH( 2) /    6 /
CMACI  DATA I2MACH( 3) /    6 /
CMACI  DATA I2MACH( 4) /    0 /
CMACI  DATA I2MACH( 5) /   32 /
CMACI  DATA I2MACH( 6) /    4 /
CMACI  DATA I2MACH( 7) /    2 /
CMACI  DATA I2MACH( 8) /   31 /
CMACI  DATA I2MACH( 9) / 2147483647 /
CMACI  DATA I2MACH(10) /    2 /
CMACI  DATA I2MACH(11) /   24 /
CMACI  DATA I2MACH(12) / -125 /
CMACI  DATA I2MACH(13) /  128 /
CMACI  DATA I2MACH(14) /   53 /
CMACI  DATA I2MACH(15) / -1021 /
CMACI  DATA I2MACH(16) /  1024 /
CC
CMACI  DATA R2MACH(1) / Z'00800000' /
CMACI  DATA R2MACH(2) / Z'7F7FFFFF' /
CMACI  DATA R2MACH(3) / Z'33800000' /
CMACI  DATA R2MACH(4) / Z'34000000' /
CMACI  DATA R2MACH(5) / Z'3E9A209B' /
CC
CMACI  DATA ISMALL(1) / Z'00800000' /
CMACI  DATA ILARGE(1) / Z'7F7FFFFF' /
CMACI  DATA IRIGHT(1) / Z'33800000' /
CMACI  DATA IDIVER(1) / Z'34000000' /
CMACI  DATA ILOG10(1) / Z'3E9A209B' /
CC
CMACI  DATA JSMALL(1),JSMALL(2) / Z'00100000', Z'00000000' /
CMACI  DATA JLARGE(1),JLARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' /
CMACI  DATA JRIGHT(1),JRIGHT(2) / Z'3CA00000', Z'00000000' /
CMACI  DATA JDIVER(1),JDIVER(2) / Z'3CB00000', Z'00000000' /
CMACI  DATA JLOG10(1),JLOG10(2) / Z'3FD34413', Z'509F79FF' /
C
CMACI  IHOST1='MACI'
CMACI  IHOST2='NTOC'
CMACI  IHMOD1='    '
CMACI  IHMOD2='    '
CMACI  IOPSY1='MACI'
CMACI  IOPSY2='NTOC'
CMACI  ICOMPI='    '
CMACI  ISITE='    '
CC
CCCCC THE FOLLOWING WAS ADDED JUNE 1989--
C     THE FOLLOWING IS FOR THE 32-BIT IBM-PC/OS2 AND  COMPAQ 386/XX (NOT YET VER
C     (PROBABLY NOT FULLY CORRECT)
C               ***********************************************************
C               **  MACHINE CONSTANTS FOR THE 32-BIT IBM-PC (NOT YET VERIFIED)
C               **  (WITH 387 COPROCESSOR)                              **
C               **  (WITH APPRECIATION TO NELSON HSU                     **
C               **  JUNE, 1989)                                          **
C               ***********************************************************
CC
COS2  DATA I2MACH( 1) /    5 /
COS2  DATA I2MACH( 2) /    6 /
COS2  DATA I2MACH( 3) /    6 /
COS2  DATA I2MACH( 4) /    0 /
COS2  DATA I2MACH( 5) /   32 /
COS2  DATA I2MACH( 6) /    4 /
COS2  DATA I2MACH( 7) /    2 /
COS2  DATA I2MACH( 8) /   31 /
COS2  DATA I2MACH( 9) / 2147483647 /
COS2  DATA I2MACH(10) /    2 /
COS2  DATA I2MACH(11) /   24 /
COS2  DATA I2MACH(12) / -125 /
COS2  DATA I2MACH(13) /  128 /
COS2  DATA I2MACH(14) /   53 /
COS2  DATA I2MACH(15) / -1021 /
COS2  DATA I2MACH(16) /  1024 /
CC
COS2  DATA R2MACH(1) / Z'00800000' /
COS2  DATA R2MACH(2) / Z'7F7FFFFF' /
COS2  DATA R2MACH(3) / Z'33800000' /
COS2  DATA R2MACH(4) / Z'34000000' /
COS2  DATA R2MACH(5) / Z'3E9A209B' /
CC
COS2  DATA ISMALL(1) / Z'00800000' /
COS2  DATA ILARGE(1) / Z'7F7FFFFF' /
COS2  DATA IRIGHT(1) / Z'33800000' /
COS2  DATA IDIVER(1) / Z'34000000' /
COS2  DATA ILOG10(1) / Z'3E9A209B' /
CC
COS2  DATA JSMALL(1),JSMALL(2) / Z'00100000', Z'00000000' /
COS2  DATA JLARGE(1),JLARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' /
COS2  DATA JRIGHT(1),JRIGHT(2) / Z'3CA00000', Z'00000000' /
COS2  DATA JDIVER(1),JDIVER(2) / Z'3CB00000', Z'00000000' /
COS2  DATA JLOG10(1),JLOG10(2) / Z'3FD34413', Z'509F79FF' /
C
COS2  IHOST1='IBM-'
COS2  IHOST2='PC  '
COS2  IHMOD1='    '
COS2  IHMOD2='    '
COS2  IOPSY1='OS38'
COS2  IOPSY2='6   '
COS2  ICOMPI='    '
COS2  ISITE='    '
CC
CC              ************************************************
CC              **  MACHINE CONSTANTS FOR THE SUN  (AND SUN 2)    **
CC              **  WITH APPRECIATION TO BILL ANDERSON, NBS
C               **  OCTOBER, 1987
CC              **  THESE VALUES ARE TENTATIVE AND HAVE NOT BEEN CHECKED *******
CC              ************************************************
CC
CSUN  DATA I2MACH( 1) /    5 /
CSUN  DATA I2MACH( 2) /    6 /
CSUN  DATA I2MACH( 3) /    5 /
CSUN  DATA I2MACH( 4) /    7 /
CSUN  DATA I2MACH( 5) /   32 /
CSUN  DATA I2MACH( 6) /    4 /
CSUN  DATA I2MACH( 7) /    2 /
CSUN  DATA I2MACH( 8) /   31 /
CSUN  DATA I2MACH( 9) / 2147483647 /
CSUN  DATA I2MACH(10) /    2 /
C
CC    DOES APOLLO NORMALIZE THEIR FRACTION LIKE A    VAX?
CC    IF SO, CHANGE THE FOLLOWING 23 TO 24
CC    ASK APOLLO HOW THEY DO THEIR NUMBERS
CSUN  DATA I2MACH(11) /   24 /
CSUN  DATA I2MACH(12) / -124 /
CSUN  DATA I2MACH(13) /  127 /
CSUN  DATA I2MACH(14) /   51 /
CSUN  DATA I2MACH(15) / -1013/
CSUN  DATA I2MACH(16) /  1013/
CC
CC    AM GOING TO USE HP-9000 NUMBERS FOR NOW AND ON MY OWN
CC    (THAT IS 2**-23 AND 2**22)
CC    FOR THE NUMBERS BELOW,
CSUN  DATA R2MACH(1) / 1.175495E-38 /
CSUN  DATA R2MACH(2) / 3.402823E38 /
CSUN  DATA R2MACH(3) / 1.1920928955078E-7 /
CSUN  DATA R2MACH(4) / 2.3841857910156E-7 /
CSUN  DATA R2MACH(5) / 0.3010300 /
CC
CC    AM GOING TO USE HP-9000 NUMBERS FOR NOW AND ON MY OWN
CC    (THAT IS 2**-23 AND 2**22)
CC    FOR THE NUMBERS BELOW,
CSUN  DATA D2MACH(1) / 2.22507385850721D-308 /
CSUN  DATA D2MACH(2) / 1.79769313486231D308 /
CSUN  DATA D2MACH(3) / 1.1102230246252D-16 /
CSUN  DATA D2MACH(4) / 2.2204460492503D-16 /
CSUN  DATA D2MACH(5) / 0.3010299956639812 /
CC
CSUN  IHOST1='SUN '
CSUN  IHOST2='    '
CSUN  IHMOD1='3   '
CSUN  IHMOD2='    '
CSUN  IOPSY1='UNIX'
CSUN  IOPSY2='    '
CSUN  ICOMPI='f77 '
CSUN  ISITE='    '
CC
CC              ************************************************
CC              **  MACHINE CONSTANTS FOR THE CONVEX          **
CC              **  CONVEX C-120, NATIVE MODE                 **
CC              **  EXTRACTED FROM CMLIB LIBRARY              **
CC              **  AUGUST, 1990                              **
CC              ************************************************
CC
CCON1 DATA I2MACH( 1) /    5 /
CCON1 DATA I2MACH( 2) /    6 /
CCON1 DATA I2MACH( 3) /    0 /
CCON1 DATA I2MACH( 4) /    6 /
CCON1 DATA I2MACH( 5) /   32 /
CCON1 DATA I2MACH( 6) /    4 /
CCON1 DATA I2MACH( 7) /    2 /
CCON1 DATA I2MACH( 8) /   31 /
CCON1 DATA I2MACH( 9) / 2147483647 /
CCON1 DATA I2MACH(10) /    2 /
CCON1 DATA I2MACH(11) /   24 /
CCON1 DATA I2MACH(12) / -127 /
CCON1 DATA I2MACH(13) /  127 /
CCON1 DATA I2MACH(14) /   53 /
CCON1 DATA I2MACH(15) / -1023 /
CCON1 DATA I2MACH(16) /  1023 /
C
CCON1 DATA D2MACH(1) / 5.562684646268007D-309 /
CCON1 DATA D2MACH(2) / 8.988465674311577D+307 /
CCON1 DATA D2MACH(3) / 1.110223024625157D-016 /
CCON1 DATA D2MACH(4) / 2.220446049250313D-016 /
CCON1 DATA D2MACH(5) / 3.010299956639812D-001 /
C
CCON1 DATA R2MACH(1) / 2.9387360E-39 /
CCON1 DATA R2MACH(2) / 1.7014117E+38 /
CCON1 DATA R2MACH(3) / 5.9604645E-08 /
CCON1 DATA R2MACH(4) / 1.1920929E-07 /
CCON1 DATA R2MACH(5) / 3.0102999E-01 /
CC
CCON1 IHOST1='CONV'
CCON1 IHOST2='EX  '
CCON1 IHMOD1='C120'
CCON1 IHMOD2='    '
CCON1 IOPSY1='UNIX'
CCON1 IOPSY2='    '
CCON1 ICOMPI='f77 '
CCON1 ISITE='    '
CC
CC
CC              ************************************************
CC              **  MACHINE CONSTANTS FOR THE CONVEX          **
CC              **  EXTRACTED FROM CMLIB LIBRARY              **
CC              **  CONVEX C-120, NATIVE MODE WITH -R8 OPTION **
CC              **  AUGUST, 1990                              **
CC              ************************************************
CC
CCON2 DATA I2MACH( 1) /     5 /
CCON2 DATA I2MACH( 2) /     6 /
CCON2 DATA I2MACH( 3) /     0 /
CCON2 DATA I2MACH( 4) /     6 /
CCON2 DATA I2MACH( 5) /    32 /
CCON2 DATA I2MACH( 6) /     4 /
CCON2 DATA I2MACH( 7) /     2 /
CCON2 DATA I2MACH( 8) /    31 /
CCON2 DATA I2MACH( 9) / 2147483647 /
CCON2 DATA I2MACH(10) /     2 /
CCON2 DATA I2MACH(11) /    53 /
CCON2 DATA I2MACH(12) / -1023 /
CCON2 DATA I2MACH(13) /  1023 /
CCON2 DATA I2MACH(14) /    53 /
CCON2 DATA I2MACH(15) / -1023 /
CCON2 DATA I2MACH(16) /  1023 /
C
CCON2 DATA R2MACH(1) / 5.562684646268007D-309 /
CCON2 DATA R2MACH(2) / 8.988465674311577D+307 /
CCON2 DATA R2MACH(3) / 1.110223024625157D-016 /
CCON2 DATA R2MACH(4) / 2.220446049250313D-016 /
CCON2 DATA R2MACH(5) / 3.010299956639812D-001 /
C
CCON2 DATA D2MACH(1) / 5.562684646268007D-309 /
CCON2 DATA D2MACH(2) / 8.988465674311577D+307 /
CCON2 DATA D2MACH(3) / 1.110223024625157D-016 /
CCON2 DATA D2MACH(4) / 2.220446049250313D-016 /
CCON2 DATA D2MACH(5) / 3.010299956639812D-001 /
CC
CCON2 IHOST1='CONV'
CCON2 IHOST2='EX  '
CCON2 IHMOD1='C120'
CCON2 IHMOD2='    '
CCON2 IOPSY1='UNIX'
CCON2 IOPSY2='    '
CCON2 ICOMPI='f77 '
CCON2 ISITE='    '
CC
CC
CC              ************************************************
CC              **  MACHINE CONSTANTS FOR THE CONVEX          **
CC              **  EXTRACTED FROM CMLIB LIBRARY              **
CC              **  CONVEX C-120, IEEE MODE                   **
CC              **  AUGUST, 1990                              **
CC              ************************************************
CC
CCON3 DATA I2MACH( 1) /    5 /
CCON3 DATA I2MACH( 2) /    6 /
CCON3 DATA I2MACH( 3) /    0 /
CCON3 DATA I2MACH( 4) /    6 /
CCON3 DATA I2MACH( 5) /   32 /
CCON3 DATA I2MACH( 6) /    4 /
CCON3 DATA I2MACH( 7) /    2 /
CCON3 DATA I2MACH( 8) /   31 /
CCON3 DATA I2MACH( 9) / 2147483647 /
CCON3 DATA I2MACH(10) /    2 /
CCON3 DATA I2MACH(11) /   24 /
CCON3 DATA I2MACH(12) / -125 /
CCON3 DATA I2MACH(13) /  128 /
CCON3 DATA I2MACH(14) /   53 /
CCON3 DATA I2MACH(15) / -1021 /
CCON3 DATA I2MACH(16) /  1024 /
C
CCON3 DATA R2MACH(1) / 1.1754945E-38 /
CCON3 DATA R2MACH(2) / 3.4028234E+38 /
CCON3 DATA R2MACH(3) / 5.9604645E-08 /
CCON3 DATA R2MACH(4) / 1.1920929E-07 /
CCON3 DATA R2MACH(5) / 3.0102999E-01 /
C
CCON3 DATA D2MACH(1) / 2.225073858507202D-308 /
CCON3 DATA D2MACH(2) / 1.797693134862315D+308 /
CCON3 DATA D2MACH(3) / 1.110223024625157D-016 /
CCON3 DATA D2MACH(4) / 2.220446049250313D-016 /
CCON3 DATA D2MACH(5) / 3.010299956639812D-001 /
CC
CCON3 IHOST1='CONV'
CCON3 IHOST2='EX  '
CCON3 IHMOD1='C120'
CCON3 IHMOD2='    '
CCON3 IOPSY1='UNIX'
CCON3 IOPSY2='    '
CCON3 ICOMPI='f77 '
CCON3 ISITE='    '
CC
CC
CC              ************************************************
CC              **  MACHINE CONSTANTS FOR THE CONVEX          **
CC              **  EXTRACTED FROM CMLIB LIBRARY              **
CC              **  CONVEX C-120, IEEE MODE WITH -R8 OPTION   **
CC              **  AUGUST, 1990                              **
CC              ************************************************
CC
CCON4 DATA I2MACH( 1) /     5 /
CCON4 DATA I2MACH( 2) /     6 /
CCON4 DATA I2MACH( 3) /     0 /
CCON4 DATA I2MACH( 4) /     6 /
CCON4 DATA I2MACH( 5) /    32 /
CCON4 DATA I2MACH( 6) /     4 /
CCON4 DATA I2MACH( 7) /     2 /
CCON4 DATA I2MACH( 8) /    31 /
CCON4 DATA I2MACH( 9) / 2147483647 /
CCON4 DATA I2MACH(10) /     2 /
CCON4 DATA I2MACH(11) /    53 /
CCON4 DATA I2MACH(12) / -1021 /
CCON4 DATA I2MACH(13) /  1024 /
CCON4 DATA I2MACH(14) /    53 /
CCON4 DATA I2MACH(15) / -1021 /
CCON4 DATA I2MACH(16) /  1024 /
C
CCON4 DATA R2MACH(1) / 2.225073858507202D-308 /
CCON4 DATA R2MACH(2) / 1.797693134862315D+308 /
CCON4 DATA R2MACH(3) / 1.110223024625157D-016 /
CCON4 DATA R2MACH(4) / 2.220446049250313D-016 /
CCON4 DATA R2MACH(5) / 3.010299956639812D-001 /
C
CCON4 DATA D2MACH(1) / 2.225073858507202D-308 /
CCON4 DATA D2MACH(2) / 1.797693134862315D+308 /
CCON4 DATA D2MACH(3) / 1.110223024625157D-016 /
CCON4 DATA D2MACH(4) / 2.220446049250313D-016 /
CCON4 DATA D2MACH(5) / 3.010299956639812D-001 /
CC
CCON4 IHOST1='CONV'
CCON4 IHOST2='EX  '
CCON4 IHMOD1='C120'
CCON4 IHMOD2='    '
CCON4 IOPSY1='UNIX'
CCON4 IOPSY2='    '
CCON4 ICOMPI='f77 '
CCON4 ISITE='    '
CC
CC
C    THE FOLLOWING IS FOR THE VAX--
C              ********************************************
C              **  MACHINE CONSTANTS FOR THE VAX-11/780  **
C              ********************************************
C
CVAX   DATA I2MACH( 1) /    5 /
CVAX   DATA I2MACH( 2) /    6 /
CVAX   DATA I2MACH( 3) /    5 /
CVAX   DATA I2MACH( 4) /    6 /
CVAX   DATA I2MACH( 5) /   32 /
CVAX   DATA I2MACH( 6) /    4 /
CVAX   DATA I2MACH( 7) /    2 /
CVAX   DATA I2MACH( 8) /   31 /
CVAX   DATA I2MACH( 9) / 2147483647 /
CVAX   DATA I2MACH(10) /    2 /
CVAX   DATA I2MACH(11) /   24 /
CVAX   DATA I2MACH(12) / -127 /
CVAX   DATA I2MACH(13) /  127 /
CVAX   DATA I2MACH(14) /   56 /
CVAX   DATA I2MACH(15) / -127 /
CVAX   DATA I2MACH(16) /  127 /
C
CVAX   DATA R2MACH(1) / O00000000200 /
CVAX   DATA R2MACH(2) / O37777677777 /
CVAX   DATA R2MACH(3) / O00000032200 /
CVAX   DATA R2MACH(4) / O00000032400 /
CVAX   DATA R2MACH(5) / O04046637632 /
C
CVAX   DATA ISMALL(1) /        128 /
CVAX   DATA ILARGE(1) /     -32769 /
CVAX   DATA IRIGHT(1) /      13440 /
CVAX   DATA IDIVER(1) /      13568 /
CVAX   DATA ILOG10(1) /  547045274 /
C
CVAX   DATA JSMALL(1),JSMALL(2) /        128,           0 /
CVAX   DATA JLARGE(1),JLARGE(2) /     -32769,          -1 /
CVAX   DATA JRIGHT(1),JRIGHT(2) /       9344,           0 /
CVAX   DATA JDIVER(1),JDIVER(2) /       9472,           0 /
CVAX   DATA JLOG10(1),JLOG10(2) /  546979738,  -805665541 /
CVAX   DATA JSMALL(1),JSMALL(2) / O00000000200, O00000000000 /
CVAX   DATA JLARGE(1),JLARGE(2) / O37777677777, O37777777777 /
CVAX   DATA JRIGHT(1),JRIGHT(2) / O00000022200, O00000000000 /
CVAX   DATA JDIVER(1),JDIVER(2) / O00000022400, O00000000000 /
CVAX   DATA JLOG10(1),JLOG10(2) / O04046437632, O31776502373 /
CC
CVAX   IHOST1='VAX'
CVAX   IHOST2='    '
CVAX   IHMOD1='11'
CVAX   IHMOD2='780'
CVAX   IOPSY1='VMS'
CVAX   IOPSY2='    '
CVAX   ICOMPI='    '
CVAX   ISITE='    '
C
C
C-----START POINT-----------------------------------------------------
C
CCCCC IF(IBUGIN.EQ.'OFF')GOTO90
CCCCC WRITE(ICOUT,51)
CCC51 FORMAT(1X)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,52)
CCC52 FORMAT('***** AT THE BEGINNING OF INITMC--')
CCCCC CALL DPWRST('XXX','BUG ')
CCC90 CONTINUE
C
C               *************************
C               **  COPY OVER INTEGER  **
C               **  MACHINE CONSTANTS  **
C               *************************
C
      DO100I=1,16
      I1MACH(I)=I2MACH(I)
  100 CONTINUE
C
C               ********************************************************
C               **  COPY OVER REAL (SINGLE PRECISION FLOATING POINT)  **
C               **  MACHINE CONSTANTS                                 **
C               ********************************************************
C
      DO200I=1,5
      R1MACH(I)=R2MACH(I)
  200 CONTINUE
C
CC              **********************************
CC              **  COPY OVER DOUBLE PRECISION  **
CC              **  MACHINE CONSTANTS           **
CC              **********************************
C
CCCCC THE FOLLOWING 3 LINES WERE COMMENTED OUT MAY 1992 (JJF)
CCCCC TO AVOID UNEXPLAINABLE OVERFLOW PROBLEMS MAY 1992 (JJF)
      DO300I=1,5
      D1MACH(I)=D2MACH(I)
  300 CONTINUE
C
C               **************************************
C               **  COMPUTE SELECTED COMMONLY-USED  **
C               **  MACHINE CONSTANTS               **
C               **************************************
C
      IRD=I2MACH(1)
      IPR=I2MACH(2)
C
CCCCC THE FOLLOWING 5 LINES WERE ENTERED                         FEBRUARY 1989
CCCCC TO SET DIFFERENT UNITS FOR ALPHANUMERIC AND GRAPHICS I/O.  FEBRUARY 1989
CCCCC MOST HOSTS WILL SET THE SAME.  CDC NOS/VE REQUIRES GRAPHICS I/O
CCCCC TO BE IN "TRANSPARENT MODE", ALPHANUMERIC IN "NON-TRANSPARENT"
      IPRGR=IPR
      IRDGR=IRD
      IF(IHOST1.EQ.'NVE') IPRGR=6
      IF(IHOST1.EQ.'NVE') IPR=7
      IF(IHOST1.EQ.'NVE') IRDGR=4
C
      CPUMIN=-R2MACH(2)
      CPUMAX=R2MACH(2)
      NUMBPW=I2MACH(5)
      NUMCPW=I2MACH(6)
      NUMBPC=NUMBPW/NUMCPW
C
      ISTATUS=SETEXITQQ(QWIN$EXITNOPERSIST)
      IQWNFT=INITIALIZEFONTS()
      IQWNFN=GETFONTINFO(MSFONT)
C
CCCCC NOVEMBER 2002.
CCCCC 1. RESET TITLE ON TEXT WINDOW.
CCCCC 2. MODIFY SOME OF THE MENU ITEMS
CCCCC 3. MODIFY THE HELP MENU TO GIVE INSTRUCTIONS FOR DATAPLOT
CCCCC    HELP
C
      IRESLT=SETACTIVEQQ(IPR)
      MODESTATUS=GETWINDOWCONFIG(DPSCREEN)
      DPSCREEN.TITLE="Dataplot Text Window"
      DPSCREEN.NUMTEXTROWS=200
      MODESTATUS=SETWINDOWCONFIG(DPSCREEN)
      IRESLT=ABOUTBOXQQ("Dataplot: Version 2/2005.  "//
     1"Dataplot is a language for graphics, fitting, "//
     1"general data analysis, and mathematics.  Dataplot "//
     1"commands are high-level, English-syntax, and "//
     1"self-descriptive.  The three most important commands are "//
     1"PLOT, FIT, and LET."C)
      IRESLT=MODIFYMENUROUTINEQQ(6,1,IQWNBR)
      IRESLT=MODIFYMENUROUTINEQQ(6,2,IQWNHE)
CCCCC IRESLT=MODIFYMENUROUTINEQQ(6,3,IQWNAB)
CCCCC IRESLT=DELETEMENUQQ(6,1)
C
CCCCC MARCH 2002: SET FOREGROUND/BACKGROUND COLOR FOR TEXT
CCCCC SCREEN BASED ON WHETHER OR NOT TRUE COLOR SPECIFIED.
C
      IF(IQWNCL.EQ.'VGA')THEN
         IQWNBC=0
         IQWNF2=15
         IRESLT=SETACTIVEQQ(IPR)
         IRESLT=SETBKCOLOR(INT2(IQWNBC))
         IRESLT=SETTEXTCOLOR(INT2(IQWNF2))
         CALL CLEARSCREEN($GCLEARSCREEN)
      ELSE
        IQWNBC=1
        IQWNF2=0
        IRESLT=SETACTIVEQQ(IPR)
        JTEMP=IQWNF2+1
        JTEMP2=RGBTOINTEGER(IRED(JTEMP),IGREEN(JTEMP),IBLUE(JTEMP))
        ISTATUS=SETTEXTCOLORRGB(JTEMP2)
        ISTATUS=SETCOLORRGB(JTEMP2)
        CALL CLEARSCREEN($GCLEARSCREEN)
        ISTATUS=DISPLAYCURSOR($GCURSORON)
      ENDIF
C
 9000 CONTINUE
      IF(IBUGIN.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF INITMC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IHOST1,IHOST2
 9012 FORMAT('IHOST1,IHOST2  (HOST) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IHMOD1,IHMOD2
 9013 FORMAT('IHMOD1,IHMOD2 (MODEL) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IOPSY1,IOPSY2
 9014 FORMAT('IOPSY1,IOPSY2 (OPERATING SYSTEM) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICOMPI
 9015 FORMAT('ICOMPI        (COMPILER) = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ISITE
 9016 FORMAT('ISITE         (SITE) = ',A4)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IPR,IRD
 9022 FORMAT('IPR,IRD = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)CPUMIN,CPUMAX
 9023 FORMAT('CPUMIN,CPUMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)NUMBPC,NUMCPW,NUMBPW
 9024 FORMAT('NUMBPC,NUMCPW,NUMBPW = ',3I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,16
      IF(NUMBPW.EQ.32)WRITE(ICOUT,9031)I,I1MACH(I)
 9031 FORMAT('I,I1MACH(I) = ',I8,2X,I11)
      IF(NUMBPW.EQ.32)CALL DPWRST('XXX','BUG ')
      IF(NUMBPW.EQ.36)WRITE(ICOUT,9032)I,I1MACH(I)
 9032 FORMAT('I,I1MACH(I) = ',I8,2X,I12)
      IF(NUMBPW.EQ.36)CALL DPWRST('XXX','BUG ')
      IF(NUMBPW.EQ.48)WRITE(ICOUT,9033)I,I1MACH(I)
 9033 FORMAT('I,I1MACH(I) = ',I8,2X,I16)
      IF(NUMBPW.EQ.48)CALL DPWRST('XXX','BUG ')
      IF(NUMBPW.EQ.60)WRITE(ICOUT,9034)I,I1MACH(I)
 9034 FORMAT('I,I1MACH(I) = ',I8,2X,I20)
      IF(NUMBPW.EQ.60)CALL DPWRST('XXX','BUG ')
      IF(NUMBPW.NE.32.AND.NUMBPW.NE.36.AND.
     1   NUMBPW.NE.48.AND.NUMBPW.NE.60)WRITE(ICOUT,9035)I,I1MACH(I)
 9035 FORMAT('I,I1MACH(I) = ',I8,2X,I8)
      IF(NUMBPW.NE.32.AND.NUMBPW.NE.36.AND.
     1   NUMBPW.NE.48.AND.NUMBPW.NE.60)CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9040I=1,5
      WRITE(ICOUT,9041)I,R1MACH(I)
 9041 FORMAT('I,R1MACH(I)  = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9040 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9050I=1,5
      WRITE(ICOUT,9051)I,D1MACH(I)
 9051 FORMAT('I,D1MACH(I)  = ',I8,2X,D15.7)
      CALL DPWRST('XXX','BUG ')
 9050 CONTINUE
C
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE INITFO(IBUGIN)
C
CCCCC THE FOLLOWING SECTION WAS ADDED JUNE 1990
C     IMPLEMENTATION NOTE--DATAPLOT CANNOT BE LINKED/LOADED
C           WITHOUT AN EDITOR PASS OF THIS FILE SO AS TO
C           SPECIFY THE FILE NAMES ON YOUR COMPUTER OF CHOICE.
C
C           DATAPLOT USES 2 TYPES OF FILES.  PERMANENT FILES (E.G., THE
C           ON-LINE HELP FILES) AND TEMPORARY FILES (E.G., THE PLOT FILE)
C           CREATED DURING A DATAPLOT SESSION.  THIS ROUTINE DEFINES WHERE
C           THE PERMANENT FILES WILL BE FOUND AND WHERE THE TEMPORARY FILES
C           WILL BE CREATED.  THIS WILL VARY FROM DEPENDING ON THE
C           HOST, OPERATING SYSTEM, AND THE SITE.  FOR EASE OF
C           IMPLEMENATION, AN IF BLOCK IS DEFINED AT THE BEGINING OF THE
C           ROUTINE.  SEARCH FOR THE STRING "MAKE USER CHANGES HERE".
C           BLOCKS ARE DEFINED FOR:
C
C            1) VAX/VMS - NO CHANGE REQUIRED, USE VMS COMMAND
C               "SET DATAPLO$:" TO DEFINE THE PATH.
C            2) UNIX OPERATING SYSTEM - NO CHANGE IF USE
C               "/usr/local/lib/dataplot/" AS DIRECTORY FOR PERMANENT FILES.
C            3) IBM/PC 386 (NEED TO UNCOMMENT THE LINE "CIBM- ...",
C               COMMENTED OUT TO AVOID COMPILE ERRORS FOR OTHER SYSTEMS).
C               NO OTHER CHANGE REQUIRED.
C            4) CYBER USING NOS/VE - CHECK THE PATH NAME FOR PERMANENT FILES
C
C           FOR AN UNSUPPORTED HOST, LOOK FOR THE IF BLOCK SET TO
C           "IHOST1.EQ.'XXXX'" AND MAKE THE APPROPRIATE CHANGES.  THE
C           DETAILS ARE GIVEN IN THE COMMENTS AT THE START OF THE IF BLOCK.
C
C           NO CHANGES REQUIRED AFTER THE LINE "END OF USER CHANGES".
C           HOWEVER, BE SURE TO CHECK THE ROUTINE DPOPFI WHICH MAY REQUIRE
C           A FEW LINES TO BE MODIFIED IN ORDER TO AUTOMATICALLY ACCESS
C           DATAPLOT REFERENCE FILES (I.E., SAMPLE DATA AND MACRO FILES).
C
C     PURPOSE--THIS IS SUBROUTING INITFO.
C              (THE   FO    AT THE END OF    INITFO   STANDS FOR
C              FILE OPERATIONS.
C              THIS SUBROUTINE DEFINES ALL OF THE FILE NAMES
C              THAT DATAPLOT USES, AND ALSO DEFINES
C              ATTRIBUTES OF SUCH FILES.
C
C     NOTE--TYPICAL FILE NAMES FOR THE MESSAGE FILE
C           FOR VARIOUS COMPUTERS--
C              VAX             --[DATAPLOT]DPMESF.TEX
C              CDC (NOS-2)     --DPMESF
C              CDC (NOS/VE)    --
C              HONEYWELL       --udd>dataplot>dpmesf.text
C              PERKIN-ELMER    --CALX:DPMESF.TEX/255       ACCOUNT:FILE.EXT/ACCO
C              IBM (EBCDIC)    --
C              PRIME           --DATAPLOT>DPMESF.TEX
C              UNIVAC          --
C              SUN             --/usr/local/lib/dataplot/dpmesf.tex
C              AT&T 3B20 (UNIX)--
C              APOLLO          --
C              DATA GENERAL    --
C              UNIX            --/usr/local/lib/dataplot/dpmesf.tex
C     NOTE--TYPICAL FORTRAN EXTENSIONS FOR DATAPLOT'S MAIN ROUTINE
C           FOR VARIOUS COMPUTERS--
C              VAX             --[DATAPLOT]MAIN.FOR
C              CDC (NOS-2)     --MAIN
C              CDC (NOS/VE)    --
C              HONEYWELL       --dataplot>main.fortran
C              PERKIN-ELMER    --
C              IBM (EBCDIC)    --
C              PRIME           --DATAPLOT>MAIN.F77
C              UNIVAC          --DATAPLOT.MAIN
C              SUN             --/usr/local/src/dataplot/main.f
C              AT&T 3B20 (UNIX)--
C              APOLLO          --
C              DATA GENERAL    --
C              CRAY            --
C     NOTE--TYPICAL INCLUDE STATEMENTS FOR VARIOUS COMPUTERS--
C              VAX             --INCLUDE 'DPCOMC.INC' (START IN COL. 7)
C              CDC (NOS-2)     --(NO INCLUDE CAPABILITY)
C              CDC (NOS/VE)    --
C              HONEYWELL       --%INCLUDE DPCOMC (START IN COL. 1)
C                                (AND SEARCHES FOR DPCOMC.INCL.FORTRAN)
C              PERKIN-ELMER    --
C              IBM (EBCDIC)    --
C              PRIME           --$INSERT DPCOMC.INC (START IN COL. 1)
C              UNIVAC          --
C                                (MUST PREPROCESS WITH PDP PROCESSOR)
C              SUN             --INCLUDE 'DPCOMC.INC'
C              AT&T 3B20 (UNIX)--
C              APOLLO          --
C              DATA GENERAL    --
C              CRAY            --
C     THE FILES THAT DATAPLOT USES ARE  --
C           1) A SIGN-ON MESSAGE FILE
C              CONTAINING THE LATEST IN DATAPLOT
C              INFORMATION.  THIS FILE IS AUTOMATICALLY PRINTED
C              OUT IN THE FORM OF A MESSAGE WHICH
C              THE ANALYST SEES WHENEVER HE/SHE SIGNS
C              ONTO DATAPLOT.
C              IT TYPICALLY CONSISTS OF ONLY
C              A FEW LINES OF INFORMATION.
C              THE VARIABLE NAMES ALL START WITH    IMES,
C              AS IN IMESNU, IMESNA, IMESST, ETC.
C           2) A NEWS FILE WHICH
C              DATAPLOT MAKES USE OF WHENEVER THE
C              ANALYST ENTERS THE NEWS COMMAND.
C              THE VARIABLE NAMES ALL START WITH    INEW,
C           3) A MAIL FILE WHICH
C              AS IN INEWNU, INEWNA, INEWST, ETC.
C              DATAPLOT MAKES USE OF WHENEVER THE
C              ANALYST ENTERS THE MAIL COMMAND
C              FOLLOWED BY HIS/HER LAST NAME.
C              THE VARIABLE NAMES ALL START WITH    IMAI,
C           4) A HELP (= DOCUMENTATION) FILE THAT
C              AS IN IMAINU, IMAINA, IMAIST, ETC.
C              DATAPLOT MAKES USE OF WHENEVER THE
C              ANALYST ENTERS THE HELP COMMAND.
C              THE VARIABLE NAMES ALL START WITH    IHEL,
C              AS IN IHELNU, IHELNA, IHELST, ETC.
C           5) A BUGS FILE WHICH
C              DATAPLOT MAKES USE OF WHENEVER THE
C              ANALYST ENTERS THE BUGS COMMAND.
C              THE VARIABLE NAMES ALL START WITH    IBUG,
C              AS IN IBUGNU, IBUGNA, IBUGST, ETC.
C           6) A QUERY FILE WHICH
C              DATAPLOT WRITES TO WHENEVER THE
C              ANALYST ENTERS THE QUERY COMMAND
C              FOLLOWED BY A COMMENT OF INTEREST.
C              THE VARIABLE NAMES ALL START WITH    IQUE,
C              AS IN IQUENU, IQUENA, IQUEST, ETC.
C           7) A SIGN-ON SYSTEM LOGIN FILE
C              WHICH GETS EXECUTED (CALLED) EVERY
C              TIME THAT DATAPLOT GETS INVOKED.
C              THIS FILE IS A HANDY PLACE FOR THE IMPLEMENTOR
C              TO PLACE DATAPLOT COMMANDS
C              SO AS TO TAILOR DATAPLOT FOR AN ENTIRE SITE.
C              THE VARIABLE NAMES ALL START WITH    ISYS,
C              AS IN ISYSNU, ISYSNA, ISYSST, ETC.
C
C           8) A USER LOGIN FILE (IN THE USER'S DIRECTORY)
C              WHICH GETS EXECUTED (CALLED) EVERY
C              TIME THAT DATAPLOT GETS INVOKED BY THAT USER.
C              THIS FILE IS A HANDY PLACE FOR THE USER
C              TO PLACE DATAPLOT COMMANDS
C              SO AS TO TAILOR DATAPLOT
C              FOR THE INDIVIDUAL USER'S PARTICULAR
C              TERMINAL AND PLOTTER.
C              THE VARIABLE NAMES ALL START WITH    ILOG,
C              AS IN ILOGNU, ILOGNA, ILOGST, ETC.
C           9) A DIRECTORY FILE WHICH
C              CONSISTS OF A LIST OF FILE NAMES
C              (AND 1-LINE DESCRIPTIONS)
C              FOR INDIVIDUAL ON-LINE MASTER REFERENCE FILES,
C              INDIVIDUAL ON-LINE DATA FILES, AND
C              INDIVIDUAL ON-LINE PROGRAM FILES.
C              THIS FILE IS USUALLY ACCESSED VIA
C              THE LIST AND SEARCH COMMANDS.
C
C          11) A READ  FILE WHOSE NAME IS
C              SUPPLIED BY THE ANALYST
C              AND ARISES IN CONNECTION
C              WITH THE READ COMMAND
C              AND THE SERIAL READ COMMAND
C              IN READING VARIABLES/PARAMETERS/FUNCTIONS
C              IN FROM A MASS STORAGE FILE.
C              THE VARIABLE NAMES ALL START dITH    IREA,
C              AS IN IREANU, IREANA, IREAST, ETC.
C          12) A WRITE FILE WHOSE NAME IS
C              SUPPLIED BY THE ANALYST
C              AND ARISES IN CONNECTION
C              WITH THE WRITE COMMAND
C              IN WRITING VARIABLES/PARAMETERS/FUNCTIONS
C              OUT TO A MASS STORAGE FILE.
C              THE VARIABLE NAMES ALL START WITH    IWRI,
C              AS IN IWRINU, IWRINA, IWRIST, ETC.
C          13) A SAVE FILE WHOSE NAME IS
C              SUPPLIED BY THE ANALYST
C              AND ARISES IN CONNECTION
C              WITH THE SAVE AND RESTORE COMMANDS
C              IN EFFICIENTLY DUMPING OUT
C              (OR ROLLING BACK IN) ALL OF
C              THE DATAPLOT INTERNAL SETTINGS
C              FOR RESUMING A DATAPLOT RUN
C              AT A LATER TIME.
C              THIS FILE IS USED IN CONNECTION
C              WITH THE SAVE COMMAND
C              AND WITH THE RESTORE COMMAND.
C              THE VARIABLE NAMES ALL START WITH    ISAV,
C              AS IN ISAVNU, ISAVNA, ISAVST, ETC.
C          14) A LIST  FILE WHOSE NAME IS
C              SUPPLIED BY THE ANALYST
C              AND ARISES IN CONNECTION
C              WITH THE LIST COMMAND
C              IN PASSIVELY LISTING THE CONTENTS
C              OF A MASS STORAGE FILE.
C              THE VARIABLE NAMES ALL START WITH    ILIS,
C              AS IN ILISNU, ILISNA, ILISST, ETC.
C          15) A MACRO FILE WHOSE NAME IS
C              SUPPLIED BY THE ANALYST
C              AND ARISES IN CONNECTION
C              WITH THE    CREATE    AND    CALL    COMMANDS
C              WHEN HE/SHE IS DYNAMICALLY FORMING
C              OR EXECUTING A MACRO
C              WHILE RUNNING DATAPLOT.
C              THE VARIABLE NAMES ALL START WITH    ICRE,
C              AS IN ICRENU, ICRENA, ICREST, ETC.
C          16) A (TEXT) CAPTURE FILE WHOSE NAME IS
C              SUPPLIED BY THE ANALYST
C              AND ARISES IN CONNECTION
C              WITH THE    CAPTURE/REDIRECT COMMANDS
C              WHEN HE/SHE IS DYNAMICALLY CAPTURING
C              TEXT OUTPUT FROM ANY DATAPLOT COMMANDS.
C              THE VARIABLE NAMES ALL START WITH    ICAP,
C              AS IN ICAPNU, ICAPNA, ICAPST, ETC.
C
C          21) A TEMPORARY SCRATCH FILE THAT DATAPLOT
C              MAKES USE OF (TO SAVE SPACE) DURING
C              THE FIT COMMAND,
C              THE PRE-FIT COMMAND,
C              AND THE SPLINE FIT COMMAND.
C              THE VARIABLE NAMES ALL START WITH    ISCR,
C              AS IN ISCRNU, ISCRNA, ISCRST, ETC.
C          22) FOR FUTURE DEVELOPMENT--
C              A DATA FILE THAT DATAPLOT
C              COULD MAKE USE OF IN STORING THE
C              MAIN INTERNAL DATA ARRAY
C              IF SUCH AN ARRAY IS LARGER THAN
C              CAN BE HELD INTERNALLY IN MAIN MEMORY.
C              SUCH A DATA FILE IS NOT CURRENTLY USED
C              BUT HAS BEEN ENTERED FOR FUTURE DEVELOPMENT.
C              THE VARIABLE NAMES ALL START WITH    IDAT,
C              AS IN IDATNU, IDATNA, IDATST, ETC.
C          23) A PLOT FILE THAT DATAPLOT
C              WRITES A PLOT OUT TO
C              WHENEVER SIMULTANEOUS SECONDARY PLOTS ARE CALLED FOR
C              (AS IN DEVICE 2 TEKTRONIX 4014
C                     DEVICE 2 HP-GL
C                     DEVICE 2 GENERAL
C                     DEVICE 2 etc.
C              THE VARIABLE NAMES ALL  TART WITH    IPL1,
C              AS IN IPL1NU, IPL1NA, IPL1ST, ETC.
C          24) ANOTHER PLOT FILE THAT DATAPLOT
C              COULD WRITE A PLOT OUT TO
C              WHENEVER SIMULTANEOUS TERTIARY PLOTS ARE CALLED FOR
C              (AS IN DEVICE 3 TEKTRONIX 4014
C                     DEVICE 3 HP-GL
C                     DEVICE 3 GENERAL
C                     DEVICE 3 etc.
C              THE VARIABLE NAMES ALL START WITH    IPL2,
C              AS IN IPL2NU, IPL2NA, IPL2ST, ETC.
C          25) A PROGRAM FILE WHICH DATAPLOT
C              WRITES TO AND RUNS FROM
C              IN CONJUNCTION WITH CERTAIN
C              "PRE-PACKAGED" COMMANDS SUCH AS
C              4-PLOT    AND    RUN RANDOMNESS
C              THE VARIABLE NAMES ALL START WITH    IPRO,
C              AS IN IPRONU, IPRONA, IPROST, ETC.
C          26) A CONCLUSIONS FILE WHICH DATAPLOT
C              WRITES TO AND READS FROM
C              IN CONJUNCTION WITH FORMING CONCLUSIONS
C              AS PART OF DATAPLOT'S EXPERT SUB-SYSTEM
C              THE VARIABLE NAMES ALL START WITH    ICON,
C              AS IN ICONNU, ICONNA, ICONST, ETC.
C
C          27) A COMMAND-SAVE FILE WHICH DATAPLOT
C              WRITES TO AND READS FROM
C              IN CONJUNCTION WITH SAVING COMMANDS
C              (VIA THE    SAVE COMMAND    COMMAND), AND
C              REEXECUTING COMMANDS (VIA THE CALL COMMAND).
C              THE VARIABLE NAMES ALL START WITH    ISAC,
C              AS IN ISACNU, ISACNA, ISACST, ETC.
C
C          31) A LOGIC-TREE MENU FILE WHICH DATAPLOT
C              ACCESSES
C              IN CONJUNCTION WITH DISPLAYING MENUS
C              AS PART OF DATAPLOT'S EXPERT SUB-SYSTEM.
C              THE VARIABLE NAMES ALL START WITH    IEX1,
C              AS IN IEX1NU, IEX1NA, IEX1ST, ETC.
C          32) ANOTHER LOGIC-TREE MENU FILE WHICH DATAPLOT
C              ACCESSES
C              IN CONJUNCTION WITH DISPLAYING MENUS
C              AS PART OF DATAPLOT'S EXPERT SUB-SYSTEM
C              (THIS FILE WILL BE USED IN FUTURE VERSIONS).
C              THE VARIABLE NAMES ALL START WITH    IEX2,
C              AS IN IEX2NU, IEX2NA, IEX2ST, ETC.
C          33) ANOTHER LOGIC-TREE MENU FILE WHICH DATAPLOT
C              ACCESSES
C              IN CONJUNCTION WITHIDISPLAYING MENUS
C              AS PART OF DATAPLOT'S EXPERT SUB-SYSTEM
C              (THIS FILE WILL BE USED IN FUTURE VERSIONS).
C              THE VARIABLE NAMES ALL START WITH    IEX3,
C              AS IN IEX3NU, IEX3NA, IEX3ST, ETC.
C          34) ANOTHER LOGIC-TREE MENU FILE WHICH DATAPLOT
C              ACCESSES
C              IN CONJUNCTION WITH DISPLAYING MENUS
C              AS PART OF DATAPLOT'S EXPERT SUB-SYSTEM
C              (THIS FILE WILL BE USED IN FUTURE VERSIONS).
C
C              THE VARIABLE NAMES ALL START WITH    IEX4,
C              AS IN IEX4NU, IEX4NA, IEX4ST, ETC.
C          35) ANOTHER LOGIC-TREE MENU FILE WHICH DATAPLOT
C              ACCESSES
C              IN CONJUNCTION WITH DISPLAYING MENUS
C              AS PART OF DATAPLOT'S EXPERT SUB-SYSTEM
C              (THIS FILE WILL BE USED IN FUTURE VERSIONS).
C              THE VARIABLE NAMES ALL START WITH    IEX5,
C              AS IN IEX5NU, IEX5NA, IEX5ST, ETC.
C
CCCCC THE FOLLOWING 1 SECTION IS A SHRINKAGE OF 9 SECTIONS JUNE 1990
C          41 TO 49) HELP (DOCUMENTATION) FILES WHICH DATAPLOT
C              ACCESSES
C              IN CONJUNCTION WITH DISPLAYING INFORMATION
C              AS PART OF DATAPLOT'S HELP SUB-SYSTEM
C              (THIS FILE WILL BE USED IN FUTURE VERSIONS).
C              THE VARIABLE NAMES ALL START WITH    IHE1 THROUGH IHE9,
C              AS IN     IHE1NU, IHE1NA, IHE1ST, ETC.
C              THROUGH   IHE9NU, IHE9NA, IHE9ST, ETC.
C
CCCCC THE FOLLOWING 9 SECTIONS WERE ADDED JUNE 1990
C          51 TO 59) MENU FILES WHICH DATAPLOT
C              ACCESSES
C              IN CONJUNCTION WITH DISPLAYING INFORMATION
C              AS PART OF DATAPLOT'S MENU SUB-SYSTEM
C              (THIS FILE WILL BE USED IN FUTURE VERSIONS).
C              THE VARIABLE NAMES ALL START WITH    IME1 THROUGH IME9,
C              AS IN     IME1NU, IME1NA, IME1ST, ETC.
C
C              THROUGH   IME9NU, IME9NA, IME9ST, ETC.
C     THE FILE ATTRIBUTES THAT DATAPLOT DEFINES ARE--
C           1) THE FORTRAN LOGICAL UNIT NUMBER
C              (AN INTEGER).
C              THE VARIABLE NAMES ALL END IN    NU,
C              AS IN IMESNU, IHELNU, IREANU, ETC.
C              RECOMMENDED SETTINGS (IF THESE POSE A CONFLICT
C              AT YOUR SITE, THEN CHANGE THEM ACCORDINGLY)--
C
C                 IMESNU=21
C                 INEWNU=22
C                 IMAINU=23
C                 IHELNU=24
C                 IBUGNU=25
C                 IQUENU=26
C                 ISYSNU=27
C                 ILOGNU=28
C                 IDIRNU=29
C                 IDICNU=30
C
C                 IREANU=31
C                 IWRINU=32
C                 ISAVNU=33
C                 ILISNU=34
C                 ICRENU=35
C
C                 ISCRNU=41
C                 IDATNU=42
C                 IPL1NU=43
C                 IPL2NU=44
C                 IPRONU=45
C                 ICONNU=46
C                 ISACNU=47
C
C                 IEX1NU=51
C                 IEX2NU=52
C                 IEX3NU=53
C                 IEX4NU=54
C                 IEX5NU=55
C
CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1997
C                 IHRMNU=60
C                 IHE1NU=61
C                 IHE2NU=62
C                 IHE3NU=63
C                 IHE4NU=64
C                 IHE5NU=65
C                 IHE6NU=66
C                 IHE7NU=67
C                 IHE8NU=68
C                 IHE9NU=69
 
CCCCC THE FOLLOWING 9 LINES WERE ADDED JUNE 1990
C                 IME1NU=71
C                 IME2NU=72
C                 IME3NU=73
C                 IME4NU=74
C                 IME5NU=75
C                 IME6NU=76
C                 IME7NU=77
C                 IME8NU=78
C                 IME9NU=79
CCCCC THE FOLLOWING 11 LINES WERE ADDED AUGUST 1990
C                 IM10NU=80
C                 IM11NU=81
C                 IM12NU=82
C                 IM13NU=83
C                 IM14NU=84
C                 IM15NU=85
C                 IM16NU=86
C                 IM17NU=87
C                 IM18NU=88
C                 IM19NU=89
C                 IM20NU=90
CCCCC THE FOLLOWING 3 LINES WERE ADDED OCTOBER 1991
C                 IST1NU=91
C                 IST2NU=92
C                 IST3NU=93
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1994
C                 IST4NU=94
CCCCC THE FOLLOWING LINE WAS ADDED JANUARY  2004
C                 IZCHNU=97
C
C           2) THE FILE NAME
C              (A CHARACTER*80 VARIABLE).
C              THE VARIABLE NAMES ALL END IN    NA,
C              AS IN IMESNA, IHELNA, IREANA, ETC.
C              FILES 21 TO 27 AND 51 AND ABOVE
C              ARE PERMANENT DATAPLOT FILES, AND
C              SO THE FULL FILE NAME
C              DEFINING EXACTLY WHERE THE FILE RESIDES
C              SHOULD BE EXPLICIT (INCLUDING,
C              IF NEED BE, THE DEVICE, DIRECTORY, AND
C              SUBDIRECTORIES SHOULD BE INCLUDED).
C              THESE FILES USUALLY RESIDE IN A MASTER
C              DATAPLOT DIRECTORY OR IN THE
C              IMPLEMENTOR'S DIRECTORY; IF SUCH IS
C              THE CASE, THEN ALSO MAKE SURE THE SYSTEM-PROTECTION
C              ON THESE FILES IS SUCH THAT ANYBODY
C              ELSE CAN ACCESS THEM--THAT IS, ALLOW
C              "WORLD" ACCESS.
C              FILES 31 TO 35 ARE USER-DEFINED FILES
C              AND SO CONTAIN A DUMMY NAME (-999).
C              FILES 41 TO 46 ARE DATAPLOT-GENERATED
C              FILES WHICH WILL END UP IN THE USER'S
C              CURRENT DIRECTORY.  THESE FILES MAY
C              BE EITHER TEMPORARY OR PERMANENT
C              IN THE SENSE THAT THE USER MAY
C              EITHER MANUALLY OR AUTOMATICALLY
C              DELETE THEM (IF HE/SHE SO CHOOSES)
C              AFTER EXITING OUT OF DATAPLOT.
C
C           3) THE FILE (EXISTENCE) STATUS
C              (A CHARACTER*12 VARIABLE).
C              THE VARIABLE NAMES ALL END IN    ST,
C              AS IN IMESST, IHELST, IREAST, ETC.
C              THERE ARE 3 POSSIBLE SETTINGS--
C                 1) OLD     (THAT IS, THE FILE PRE-EXISTS)
C                 2) NEW     (THAT IS, THE FILE DOES NOT PRE-EXIST)
C                 3) UNKNOWN (THAT IS, EITHER CASE IS POSSIBLE)
C              FILES 21 TO 27 ARE OLD.
C              FILES 31 TO 35 ARE UNKNOWN.
C              FILES 41 TO 46 ARE UNKNOWN.
C              FILES 51 AND ABOVE ARE OLD.
C
C           4) THE FILE (FORTRAN I/O) FORMAT
C              (A CHARACTER*12 VARIABLE).
C              THE VARIABLE NAMES ALL END IN    FO,
C              AS IN IMESFO, IHELFO, IREAFO, ETC.
C              THERE ARE 2 POSSIBLE SETTINGS--
C                 1) FORMATTED   (THAT IS, THE CONTENTS OF THE FILE ARE
C                                READABLE VIA A FORMATTED FORTRAN READ).
C                                THE FILE IS THUS EDITABLE VIA MOST EDITORS,
C                                BUT ARE SLOWER TO CREATE AND READ.
C                 2) UNFORMATTED (THAT IS, THE CONTENTS OF THE FILE
C                                ARE READABLE ONLY VIA AN UNFORMATTED
C                                FORTRAN READ.  THE FILE IS THUS
C                                UNEDITABLE BY MOST EDITORS,
C                                BUT ARE FASTER TO CREATE AND READ.
C               ALL OF DATAPLOT'S FILES ARE FORMATTED
C               EXCEPT THE SCRATCH FILE (ISCRNA--FILE 41
C               AND    THE DATA    FILE (IDATNA--FILE 42).
C
C           5) THE FILE ACCESS ATTRIBUTE
C              (A CHARACTER*12 VARIABLE).
C              THE VARIABLE NAMES ALL END IN    AC,
C              AS IN IMESAC, IHELAC, IREAAC, ETC.
C              THERE ARE 2 POSSIBLE SETTINGS--
C                 1) SEQUENTIAL (THAT IS, THE CONTENTS OF THE FILE ARE
C                               ACCESSED IN A SEQUENTIAL FASHION.
C                               SEQUENTIAL ACCESS FILES ARE SIMPLER IN
C                               STRUCTURE BUT SLOWER TO ACCESS.
C     b           2) DIRECT     (THAT IS, THE CONTENTS OF THE FILE
C                               ARE ACCESSED DIRECTLY--
C                               A RECORD IN THE MIDDLE OF THE FILE
C                               MAY THUS BE ACCESSED DIRECTLY WITHOUT
C                               THE NEED TO READ THROUGH ALL PREVIOUS
C                               RECORDS.  DIRECT ACCESS FILES
C                               ARE USUALLY UNEDITABLE, ARE
C                               USUALLY MORE COMPLICATED IN STRUTURE,
C                               BUT ARE FASTER TO ACCESS.
C              DIRECT-ACCESS FILES ARE NOT SUPPORTED
C              IN FORTRAN 77, THUS DATAPLOT DOES
C              NOT MAKE USE OF THEM (THAT IS, ALL
C              OF DATAPLOT'S FILE ARE SEQUENTIAL).
C              IF ONE WERE TO DEVIATE FROM DATAPLOT'S
C              DEFAULT SETTINGS IN REGARD TO
C              SEQUENTIAL VERSUS DIRECT-ACCESS FILES,
C              THEN THE PRIMARY CANDIDATE WOULD
C              BE THE HELP FILE (IHELNA)--MAKING
C              THIS DIRECT ACCESS WOULD SPEED UP
C              THE USE OF THE HELP COMMAND; THIS
C              SHOULD BE DONE ONLY, HOWEVER, AFTER THE
C              DEFAULT DATAPLOT IMPLEMENTATION HAS
C              BEEN DONE AND IS RUNNING SATISFACTORILY.
C
C           6) THE FILE READ/WRITE PROTECTION ATTRIBUTE
C              (A CHARACTER*12 VARIABLE).
C              THE VARIABLE NAMES ALL END IN    PR,
C              AS IN IMESPR, IHELPR, IREAPR, ETC.
C              THERE ARE 2 POSSIBLE SETTINGS--
C                 1) READWRITE (THAT IS, THE CONTENTS OF THE FILE MAY
CC                              SEQUENTIAL ACCESS FILES ARE SIMPLER IN
C                               BE BOTH READ FROM AND WRITTEN TO DURING A
C                               DATAPLOT RUN.  THE FILE IS THUS FREELY
C                               ACCESSED FOR BOTH READING AND WRITING.
C                 2) READONLY   (THAT IS, THE FILE MAY
C                               BE READ FROM, BUT MAY NOT BE WRITTEN INTO.
C                               THE FILE THUS HAS ONLY LIMITED ACCESS.
C              FILES 21 TO 27 (EXCEPT FILE 23) ARE READONLY.
C              FILES 31 TO 35 ARE READWRITE.
C              FILES 41 TO 46 ARE READWRITE.
C              FILES 51 AND ABOVE ARE READONLY.
C
C           7) THE FILE OPEN/CLOSE STATUS
C              (A CHARACTER*12 VARIABLE).
C              THE VARIABLE NAMES ALL END IN    CS,
C              AS IN IMESCS, IHELCS, IREACS, ETC.
C              THERE ARE 2 POSSIBLE SETTINGS--
C                 1) OPEN   (THAT IS, THE FILE IS CURRENTLY OPEN).
C                 2) CLOSED (THAT IS, THE FILE IS CURRENTLY CLOSED).
C              UPON ACCESSING DATAPLOT, ALL FILES ARE CLOSED.
C              AT VARIOUS TIMES WITHIN A DATAPLOT RUN,
C              A GIVEN FILE MAY BE OPEN OR CLOSED--
C              DEPENDING ON WHAT THE ANALYST IS DOING.
C              UPON EXITING DATAPLOT, ANY FILES WHICH HAPPEN
C              TO BE OPEN WILL BE CLOSED.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--DECEMBER  1985.
C     UPDATED         --JULY      1986.
C     UPDATED         --SEPTEMBER 1987. (EXPANDED HELP)
C     UPDATED         --JANUARY   1988. (DIRECTORY FILE)
C     UPDATED         --AUGUST    1988. (DICTIONARY FILE)
C     UPDATED         --JUNE      1990. MENU 1 THRU 9
C     UPDATED         --JULY      1990. PL1/PL2/CON/SAC  NEW TO UNKNOWN
C     UPDATED         --AUGUST    1990. MENU 11 THRU 20
C     UPDATED         --SEPTEMBER 1990. USER-DEFINABLE DOS DIRECTORY
C     UPDATED         --APRIL     1991. MERGE ALAN/JJF VERSIONS
C     UPDATED         --OCTOBER   1991. STORAGE 1, 2, AND 3
C     UPDATED         --NOVEMBER  1991. HEAVILY MODIFIED FOR EASIER
C                                       USER IMPLEMENTATION (ALAN)
C     UPDATED         --MARCH     1992. GENERAL OUTPUT FILE
C                                       (INCLUDING LASER PRINTER)
C     UPDATED         --APRIL     1992. ADD SOME DECLARATIONS, MAKE
C                                       MODIFICATION INSTRUCTIONS CLEAR
C     UPDATED         --AUGUST    1992. FILE PERMISSION FOR DPST<1/2/3>F
C     UPDATED         --AUGUST    1992. FOR EDIT COMMAND
C     UPDATED         --JANUARY   1994. CHECK FOR SET DATAPLO$, FED$
C     UPDATED         --FEBRUARY  1994. DELETE SOME OBSOLETE COMMENTS
C                                       TO AVOID CONFUSION.
C     UPDATED         --APRIL     1996. FOR UNIX, ALLOW FILE AREA FOR
C                                       TO BE SET VIA:
C                                         setenv DATAPLOT_FILES
C     UPDATED         --APRIL     1996. SET PATH, NCPATH FOR PC
C     UPDATED         --JULY      1996. FOR UNIX, CHECK FOR PRESCENCE
C                                       OF "HOME" ENVIORNMENT VARIABLE
C                                       IF FOUND, READ DPLOGF FROM
C                                       HOME DIRECTORY RATHER THAN
C                                       CURRENT DIRECTORY
C     UPDATED         --JULY      1996. DATAPLOT_WEB VARIABLE
C     UPDATED         --AUGUST    1996. FIXES FOR SEARCHING SUB-DIRECTORIES
C     UPDATED         --APRIL     1997. BROWSER VARIABLE
C     UPDATED         --APRIL     1997. DATAPLOT_HOME_PAGE VARIABLE
C     UPDATED         --APRIL     1997. URL VARIABLE
C     UPDATED         --APRIL     1997. UNIT FOR WEB HELP COMMAND
C                                       (IHRMNU)
C     UPDATED         --APRIL     1997. COMBINE UNIX HOSTS
C     UPDATED         --APRIL     1997. DIFFERERT UNIT FOR CREATE AND
C                                       CALL
C     UPDATED         --MARCH     1999. UNIT FOR WEB HANDBOOK COMMAND
C     UPDATED         --JANUARY   2004. UNIT FOR CHARACTER DATA
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      USE MSFLIB
C
      CHARACTER*4 IBUGIN
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C  NOVEMBER 1991.  FOLLOWING BLOCK ADDED
C
      CHARACTER*80 IPATH1
      CHARACTER*80 IPATH2
      CHARACTER*6  INAME
      CHARACTER*10 IEXT1
      CHARACTER*10 IEXT2
      CHARACTER*4  ICASFL
C
C  JUNE 1996.  FOLLOWING BLOCK ADDED
C
      CHARACTER*80 IPATH3
      CHARACTER*4 IFHOME
C
C  JULY 1996.  FOLLOWING BLOCK ADDED
C
      CHARACTER*80 ITEMP
C
C
CCCCC THE FOLLOWING LINE WAS ADDED SEPTEMBER 1990
      CHARACTER*80 ICDIR
C  FOLLOWING 2 LINES ADDED APRIL 1992.
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOHO.INC'
CCCCC AUGUST 1992.  FOLLOWING COMMON BLOCK FOR EDIT COMMAND
      CHARACTER*80 IEDDIR
      CHARACTER*10 IEDEXT
      CHARACTER*4 IEDCAS
      COMMON /ICEDC4/
     1IEDDIR,IEDEXT,IEDCAS
      COMMON/ICEDI4/
     1NCEDT1,NCEDT2
C
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='INIT'
      ISUBN2='FO  '
CCCCC JUNE 1996.  ADD FOLLOWING LINE
      IFHOME='NO'
C
      IF(IBUGIN.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF INITFO--')
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C  MAKE USER CHANGES HERE!!!!
C
C  NOVEMBER 1991.  FOLLOWING SECTION ADDED.  ONLY NEED TO DEFINE "PATH"
C  AND FILE EXTENSIONS ONCE HERE.  COMPLICATES LATER CODE SOMEWHAT,
C  BUT SIMPLIFIES MAKING HOST DEPENDENT CHANGES.
C
C  DATAPLOT USES 2 TYPES OF FILES.  ONE ARE PERMAMNENT FILES SUCH AS
C  THE ON-LINE HELP FILES AND THE NEWS FILES.  THE LOCAL INSTALLOR CAN
C  PUT THESE FILES WHEREVER DESIRED.  THESE FILES TYPICALLY HAVE A
C  ".TEX" EXTENSION, ALTHOUGH THIS CAN BE SET HOWEVER THE LOCAL
C  IMPLEMENTOR CHOOSES.
C
C  THE SECOND TYPE OF FILES ARE TEMPORARY FILES CREATED DURING A
C  DATAPLOT SESSION.  THIS WOULD INCLUDE THE PLOT FILE, SCRATCH FILES,
C  AND OTHER MISCELLANEOUS FILES.  THESE FILES TYPICALLY ARE CREATED IN
C  THE USER'S CURRENT DIRECTORY OR IN SOME TYPE OF TEMPORARY DIRECTORY.
C  AGAIN, THE LOCAL INSTALLOR CAN MAKE THAT CHOICE.  THE FILE EXTENSION
C  IS TYPICALLY ".DAT", BUT THIS CAN ALSO BE SET BY THE LOCAL
C  IMPLEMENTOR.
C
C  IPATH1   = DIRECTORY NAME WHERE DATAPLOT PERMANENT FILES ARE STORED
C  IEXT1    = EXTENSION FOR PERMANENT FILES
C  IPATH2   = DIRECTORY NAME FOR TEMPORARY FILES (E.G., SCRATCH FILES)
C  IEXT2    = EXTENSION FOR TEMPORARY FILES
C  ICASFL   = 'UPPE' MEANS FILE NAMES ARE UPPER CASE, 'LOWE' MEANS FILE
C             NAMES ARE LOWER CASE.  TYPICALLY SET TO 'LOWE' FOR UNIX
C             SYSTEMS, 'UPPE' FOR OTHERS.
C  IEDDIR   = DIRECTORY FOR THE EDIT COMMAND (WILL USUALLY BE SAME AS
C             IPATH1, BUT DIFFERS ON PC)
C
C  THERE IS A CORRESPONDING VARIABLE THAT DEFINES THE NUMBER OF
C  CHARACTERS, NOTE THAT SETTING THIS VARIABLE TO ZERO IMPLIES NO PATH
C  OR EXTENSION.
C
C --------------------
C
      IF(IHOST1.EQ.'VAX')THEN
        IPATH1='DATAPLO$:'
        NCP1=9
        IEDDIR=IPATH1
        NCEDT1=NCP1
        IPATH2=' '
        NCP2=0
        IEXT1='.TEX'
        NCEXT1=4
        IEXT2='.DAT'
        NCEXT2=4
        ICASFL='UPPE'
C
      ELSE IF(IHOST1.EQ.'NVE')THEN
        IPATH1='.CS2.APPLICATIONS.DATAPLOT.VER_2.'
        NCP1=33
        IEDDIR=IPATH1
        NCEDT1=NCP1
C  FOR NOS/VE, IMPLEMENTOR CAN DECIDE WHETHER TO PUT TEMPORARY FILES IN THE
C  CURRENT CATALOG OR USE $LOCAL
        IPATH2='$LOCAL.'
        NCP2=7
CCCCC   IPATH2=' '
CCCCC   NCP2=0
C  END FILES WITH A ".".  THIS TRAILING DOT IS JUST TO IDENTIFY THE NAME AS
C  A FILE TO DATAPLOT.  THE "DPOPFI" ROUTINE WILL STRIP IT OFF.
        IEXT1='.'
        NCEXT1=1
        IEXT2='.'
        NCEXT2=1
        ICASFL='UPPE'
C
CCCCC APRIL 1996.  FOR UNIX SYSTEMS, CHECK FOR EXISTENCE OF
CCCCC "DATAPLOT_FILES" ENVIRONMENT VARIABLE
CCCCC APRIL 1997.  REDUCE TO 1 UNIX SECTION (A BUNCH OF CODE WAS
CCCCC DELETED< ESSENTIALLY REDUNDANT)
CCCCC ELSE IF(IHOST1.EQ.'SUN')THEN
      ELSE IF(
     1       (IHOST1.EQ.'SUN') .OR.
     1       (IHOST1.EQ.'CRAY' .AND. IOPSY1.EQ.'UNIX') .OR.
     1       (IHOST1.EQ.'CONV') .OR.
     1       (IHOST1.EQ.'SGI ') .OR.
     1       (IHOST1.EQ.'HP-9') .OR.
     1       (IHOST1.EQ.'AIX ') .OR.
     1       (IHOST1.EQ.'LINU') .OR.
     1       (IOPSY1.EQ.'UNIX')
     1    )THEN
        UNIXPV='DATAPLOT_FILES'
CUNIX   CALL getenv(UNIXPV,UNIXPN)
        IF(UNIXPN.EQ.' ')THEN
          IPATH1='/usr/local/lib/dataplot/'
          NCP1=24
          UNIXPN=' '
          UNIXPN(1:NCP1)=IPATH1(1:NCP1)
          IUNXNC=NCP1
        ELSE
          DO1001I=80,1,-1
            NCP1=I
            IF(UNIXPN(I:I).NE.' ')GOTO1009
 1001     CONTINUE
 1009     CONTINUE
          IPATH1(1:NCP1)=UNIXPN(1:NCP1)
          IUNXNC=NCP1
        ENDIF
CCCCC AUGUST 1996.  TO MAKE SEARCH OF SUB-DIRECTORIES WORK, SET PATH
CCCCC TO BE EMPTY.
        IPATH1=' '
        NCP1=0
CCCCC JUNE 1996.  FOR UNIX SYSTEMS, CHECK FOR EXISTENCE OF
CCCCC "HOME" ENVIRONMENT VARIABLE.  READ DPLOGF FROM USER'S HOME
CCCCC DIRECTORY IF FOUND.  OTHERWISE, CURRENT DIRECTORY.
        UNIXPV='HOME'
CUNIX   CALL getenv(UNIXPV,IPATH3)
        IF(IPATH3.NE.' ')THEN
          IFHOME='YES'
          DO1002I=80,1,-1
            NCP3=I
            IF(IPATH3(I:I).NE.' ')GOTO1003
 1002     CONTINUE
 1003     CONTINUE
          NCP3=NCP3+1
          IPATH3(NCP3:NCP3)='/'
        ENDIF
C
        IEDDIR=IPATH1
        NCEDT1=NCP1
        IEDDIR=' '
        NCEDT1=0
        IPATH2=' '
        NCP2=0
        IEXT1='.tex'
        NCEXT1=4
        IEXT2='.dat'
        NCEXT2=4
        ICASFL='LOWE'
CCCCC JULY 1996.  FOR UNIX SYSTEMS, CHECK FOR EXISTENCE OF
CCCCC "DATAPLOT_WEB" ENVIRONMENT VARIABLE.  IF ON, TRUE, YES, ASSUME
CCCCC RUNNING DATAPLOT FROM A WEB PAGE.  IF SO, CREATE LOCAL FILES
CCCCC (E.G, DPPL1F.DAT) IN /tmp DIRECTORY RATHER THAN CURRENT
CCCCC DIRECTORY.
        ITEMP=' '
        UNIXPV='DATAPLOT_WEB'
CUNIX   CALL getenv(UNIXPV,ITEMP)
        IF(ITEMP.NE.' ')THEN
          IWBFLG='YES'
          IF(ITEMP.EQ.'NO')IWBFLG='NO'
          IF(ITEMP.EQ.'no')IWBFLG='NO'
          IF(ITEMP.EQ.'OFF')IWBFLG='NO'
          IF(ITEMP.EQ.'off')IWBFLG='NO'
          IF(ITEMP.EQ.'FALS')IWBFLG='NO'
          IF(ITEMP.EQ.'fals')IWBFLG='NO'
        ENDIF
CCCCC MARCH 1997.  FOR UNIX SYSTEMS, CHECK FOR EXISTENCE OF:
CCCCC 1)  "BROWSER" ENVIRONMENT VARIABLE.  THIS ENVIRONMENT VARIABLE
CCCCC     IS USED BY THE "WEB HELP" COMMAND TO SPECIFY WHAT BROWSER
CCCCC     WILL BE USED TO EXAMINE THE DATAPLOT REFERENCE MANUAL.
CCCCC     DEFAULTS TO NETSCAPE.
CCCCC 2)  "DATAPLOT_URL" ENVIRONMENT VARIABLE.  THIS ENVIRONMENT
CCCCC     VARIABLE SPECIFIES THE LOCATION OF THE DATAPLOT REFERENCE
CCCCC     MANUAL.  DEFUALTS TO THE NIST SITE.  INCLUDED TO ALLOW
CCCCC     SITES TO INSTALL THE REFERENCE MANUAL LOCALLY.
CCCCC 3)  "URL" ENVIRONMENT VARIABLE.  THIS ENVIRONMENT
CCCCC     VARIABLE SPECIFIES THE DEFAULT URL TO USE FOR THE WEB
CCCCC     COMMAND.
        IBROWS=' '
        IDPURL=' '
        IURL=' '
        UNIXPV='BROWSER'
CUNIX   CALL getenv(UNIXPV,IBROWS)
        IF(IBROWS.EQ.' ')IBROWS='netscape'
C
        UNIXPV='DATAPLOT_URL'
CUNIX   CALL getenv(UNIXPV,IDPURL)
        IF(IDPURL.EQ.' ')THEN
          IDPURL(1:24)='http://www.itl.nist.gov/'
          IDPURL(25:49)='div898/software/dataplot/'
        ENDIF
C
        UNIXPV='URL'
CUNIX   CALL getenv(UNIXPV,IURL)
        IF(IURL.EQ.' ')IURL(1:20)='http://www.nist.gov/'
C
C
        IEDDIR=IPATH1
        NCEDT1=NCP1
        IEDDIR=' '
        NCEDT1=0
        IPATH2=' '
        NCP2=0
        IF(IWBFLG.EQ.'YES')THEN
          IPATH2='/tmp/'
          NCP2=5
        ENDIF
        IEXT1='.tex'
        NCEXT1=4
        IEXT2='.dat'
        NCEXT2=4
        ICASFL='LOWE'
C
CCCCC THE FOLLOWING SECTION WAS ADDED SEPTEMBER 1990
CCCCC IT ASSUMES THE IMPLEMENTER HAS 2 DOS LINES EXISTING--
CCCCC SET DATAPLO$=the full pathname for the directory
CCCCC              where the implementer put DATAPLOT.EXE
CCCCC              (e.g., SET DATAPLO$=C:\DATAPLOT\)
CCCCC              (this SET command goes anywhere in AUTOEXEC.BAT)
CCCCC SHELL=COMMAND.COM /E:288 /P
CCCCC              (this SHELL command goes as the last line
CCCCC              in CONFIG.SYS)
CCCCC JUNE 1996.  DEPENDING ON WHETHER OTG OR LAHEY COMPILER IS USED.
CCCCC OUR VERSION OF LAHEY (5.11) DOESN'T SEEM TO HAVE VARIABLE
CCCCC READING FUNCTION, SO HARD-CODE TO C:\DATAPLOT.
CCCCC
CCCCC OCTOBER 1996.  UPDATE FOR MICROSOFT COMPILER ON PC.  USE
CCCCC LIBRARY FUNCTION SETENVQQ (WORKS A LOT LIKE UNIX SETENV).
CCCCC APRIL 1997.  FOR IBM/PC SYSTEMS, CHECK FOR EXISTENCE OF:
CCCCC 1)  "BROWSER" SET VARIABLE.  THIS VARIABLE
CCCCC     IS USED BY THE "WEB HELP" COMMAND TO SPECIFY WHAT BROWSER
CCCCC     WILL BE USED TO EXAMINE THE DATAPLOT REFERENCE MANUAL.
CCCCC     DEFAULTS TO NETSCAPE.
CCCCC 2)  "DP_URL" SET VARIABLE.  THIS
CCCCC     VARIABLE SPECIFIES THE LOCATION OF THE DATAPLOT REFERENCE
CCCCC     MANUAL.  DEFUALTS TO THE NIST SITE.  INCLUDED TO ALLOW
CCCCC     SITES TO INSTALL THE REFERENCE MANUAL LOCALLY.
C
CCCCC 12/2002: CHANGE DEFAULT TO "C:\PROGRAM FILES\NIST\DATAPLOT\"
C
      ELSE IF(IHOST1.EQ.'IBM-')THEN
        IF(ICOMPI.EQ.'LAHE')THEN
CCCCC     IPATH1='C:\DATAPLOT\'
CCCCC     NCP1=12
          IPATH1='C:\PROGRAM FILES\NIST\DATAPLOT\'
          NCP1=31
CCCCC     ICDIR='C:\FED\'
CCCCC     NCEDT1=7
CCCCC     ICDIR='C:\DATAPLOT\'
CCCCC     NCEDT1=12
          ICDIR='C:\PROGRAM FILES\NIST\DATAPLOT\'
          NCEDT1=31
        ELSE IF(ICOMPI.EQ.'MS-F')THEN
          IRESLT=GETENVQQ('DATAPLO$',ICDIR)
          IF(IRESLT.LE.0)THEN
CCCCC       ICDIR='C:\DATAPLOT\'
            ICDIR='C:\PROGRAM FILES\NIST\DATAPLOT\'
            NCP1=31
            NCDIR=31
          ELSE
            NCDIR=80
            CALL DPDB80(ICDIR,NCDIR,IBUGIN,ISUBRO,IERROR)
            NCP1=NCDIR
          ENDIF
          IF(NCDIR.LE.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1111)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1112)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1113)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1114)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1115)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1116)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1121)ICDIR(1:40)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1122)NCDIR
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          IPATH1(1:NCP1)=ICDIR(1:NCP1)
C
          IRESLT=GETENVQQ('FED$',ICDIR)
          IF(IRESLT.EQ.0)THEN
CCCCC       ICDIR='C:\FED\'
CCCCC       NCEDT1=7
CCCCC       NCDIR=7
            ICDIR='C:\PROGRAM FILES\NIST\DATAPLOT\'
            NCEDT1=31
            NCDIR=31
          ELSE
            NCDIR=80
            CALL DPDB80(ICDIR,NCDIR,IBUGIN,ISUBRO,IERROR)
            NCEDT1=NCDIR
          ENDIF
C
          IF(NCDIR.LE.0)THEN
             WRITE(ICOUT,999)
             CALL DPWRST('XXX','BUG ')
             WRITE(ICOUT,1211)
             CALL DPWRST('XXX','BUG ')
             WRITE(ICOUT,1212)
             CALL DPWRST('XXX','BUG ')
             WRITE(ICOUT,1213)
             CALL DPWRST('XXX','BUG ')
             WRITE(ICOUT,1214)
             CALL DPWRST('XXX','BUG ')
             WRITE(ICOUT,1215)
             CALL DPWRST('XXX','BUG ')
             WRITE(ICOUT,1216)
             CALL DPWRST('XXX','BUG ')
             WRITE(ICOUT,1221)ICDIR(1:40)
             CALL DPWRST('XXX','BUG ')
             WRITE(ICOUT,1222)NCDIR
             CALL DPWRST('XXX','BUG ')
             IERROR='YES'
             GOTO9000
          ENDIF
C
          IBROWS=' '
          IDPURL=' '
          IRESLT=GETENVQQ('BROWSER',IBROWS)
          IF(IRESLT.EQ.0)THEN
            IBROWS(1:45)='"C:\Program Files\NETSCAPE\NAVIGATOR\PROGRAM\'
            IBROWS(46:58)='netscape.exe"'
          ENDIF
C
          IRESLT=GETENVQQ('DP_URL',IDPURL)
          IF(IRESLT.EQ.0)THEN
            IDPURL(1:24)='http://www.itl.nist.gov/'
            IDPURL(25:49)='div898/software/dataplot/'
          ENDIF
C
          IRESLT=GETENVQQ('URL',IDPURL)
          IF(IRESLT.EQ.0)THEN
            IURL(1:20)='http://www.nist.gov/'
          ENDIF
C
        ELSE IF(ICOMPI.EQ.'OTG ')THEN
COTG      CALL DOSPARAM@('DATAPLO$',ICDIR)
          NCDIR=80
          CALL DPDB80(ICDIR,NCDIR,IBUGIN,ISUBRO,IERROR)
          NCP1=NCDIR
C
CCCCC THE FOLLOWING ERROR CHECK & WRITE WAS ENTERED    JANUARY 1994
          IF(NCDIR.LE.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1111)
 1111       FORMAT('***** ERROR IN INITFO--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1112)
 1112       FORMAT('      ERROR IN DEFINING THE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1113)
 1113       FORMAT('      DATAPLOT DIRECTORY')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1114)
 1114       FORMAT('      PROBABLE CAUSE--BAD  AUTOEXEC.BAT  FILE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1115)
 1115       FORMAT('      MISSING OR INCORRECT    SET   STATEMENT:')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1116)
 1116       FORMAT('      SET DATAPLO$ = etc.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1121)ICDIR(1:40)
 1121       FORMAT('ICDIR(1:40) = ',A40)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1122)NCDIR
 1122       FORMAT('NCDIR = ',I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          IPATH1(1:NCP1)=ICDIR(1:NCP1)
C
COTG      CALL DOSPARAM@('FED$',ICDIR)
          NCDIR=80
          CALL DPDB80(ICDIR,NCDIR,IBUGIN,ISUBRO,IERROR)
          NCEDT1=NCDIR
C
CCCCC THE FOLLOWING ERROR CHECK & WRITE WAS ENTERED      JANUARY 1994
          IF(NCDIR.LE.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1211)
 1211       FORMAT('***** ERROR IN INITFO--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1212)
 1212       FORMAT('      ERROR IN DEFINING THE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1213)
 1213       FORMAT('      FED (= THE DATAPLOT EDITOR) DIRECTORY')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1214)
 1214       FORMAT('      PROBABLE CAUSE--BAD  AUTOEXEC.BAT  FILE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1215)
 1215       FORMAT('      INCORRECT OR MISSING    SET   STATEMENT:')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1216)
 1216       FORMAT('      SET FED$ = etc.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1221)ICDIR(1:40)
 1221       FORMAT('ICDIR(1:40) = ',A40)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1222)NCDIR
 1222       FORMAT('NCDIR = ',I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
        ELSE
CCCCC     ICDIR='C:\FED\'
CCCCC     NCEDT1=7
          ICDIR='C:\PROGRAM FILES\NIST\DATAPLOT\'
          NCEDT1=31
CCCCC     IPATH1='C:\DATAPLOT\'
CCCCC     NCP1=12
          IPATH1='C:\PROGRAM FILES\NIST\DATAPLOT\'
          NCP1=31
        ENDIF
C
        IEDDIR(1:NCEDT1)=ICDIR(1:NCEDT1)
CCCCC APRIL 1996.  SET PATH, NCPATH
        PATH(1:NCP1)=IPATH1(1:NCP1)
        NCPATH=NCP1
        IPATH1=' '
        NCP1=0
        IPATH2=' '
        NCP2=0
        IEXT1='.TEX'
        NCEXT1=4
        IEXT2='.DAT'
        NCEXT2=4
        ICASFL='UPPE'
C
C  INSERT CODE FOR UNSUPPORTED HOST HERE!!!
CXXXX ELSE IF(IHOST1.EQ.'XXXX')THEN
CXXXX   IPATH1=' '
CXXXX   NCP1=0
CXXXX   IPATH2=' '
CXXXX   NCP2=0
CXXXX   IEXT1='.TEX'
CXXXX   NCEXT1=4
CXXXX   IEXT2='.DAT'
CXXXX   NCEXT2=4
CXXXX   ICASFL='LOWE'
C
      ELSE
        IPATH1=' '
        NCP1=0
        IEDDIR=IPATH1
        NCEDT1=NCP1
        IPATH2=' '
        NCP2=0
        IEXT1=' '
        NCEXT1=0
        IEXT2=' '
        NCEXT2=0
        ICASFL='UPPE'
      END IF
C  END USER CHANGES!!!!
C
C --------------------
C
CCCCC AUGUST 1992.  DEFINE DIRECTORY AND EXTENSION FOR EDIT COMMAND
      IEDEXT=IEXT1
      IEDCAS=ICASFL
      NCEDT2=NCEXT1
C
      IMESNU=21
C  NOVEMBER 1991.
      INAME='DPMESF'
      IF(ICASFL.EQ.'LOWE')INAME='dpmesf'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IMESNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IMESST='OLD'
      IMESFO='FORMATTED'
      IMESAC='SEQUENTIAL'
      IMESPR='READ'
      IMESCS='CLOSED'
C
      INEWNU=22
C  NOVEMBER 1991.
      INAME='DPNEWF'
      IF(ICASFL.EQ.'LOWE')INAME='dpnewf'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,INEWNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      INEWST='OLD'
      INEWFO='FORMATTED'
      INEWAC='SEQUENTIAL'
      INEWPR='READ'
      INEWCS='CLOSED'
C
      IMAINU=23
C  NOVEMBER 1991.
      INAME='DPMAIF'
      IF(ICASFL.EQ.'LOWE')INAME='dpmaif'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IMAINA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IMAIST='OLD'
      IMAIFO='FORMATTED'
      IMAIAC='SEQUENTIAL'
      IMAIPR='READ'
      IMAICS='CLOSED'
C
      IHELNU=24
C  NOVEMBER 1991.
      INAME='DPHELF'
      IF(ICASFL.EQ.'LOWE')INAME='dphelf'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHELNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHELST='OLD'
      IHELFO='FORMATTED'
      IHELAC='SEQUENTIAL'
      IHELPR='READ'
      IHELCS='CLOSED'
C
      IBUGNU=25
C  NOVEMBER 1991.
      INAME='DPBUGF'
      IF(ICASFL.EQ.'LOWE')INAME='dpbugf'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IBUGNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IBUGST='OLD'
      IBUGFO='FORMATTED'
      IBUGAC='SEQUENTIAL'
      IBUGPR='READ'
      IBUGCS='CLOSED'
C
      IQUENU=26
C  NOVEMBER 1991.
      INAME='DPQUEF'
      IF(ICASFL.EQ.'LOWE')INAME='dpquef'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IQUENA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IQUEST='OLD'
      IQUEFO='FORMATTED'
      IQUEAC='SEQUENTIAL'
      IQUEPR='READWRITE'
      IQUECS='CLOSED'
C
      ISYSNU=27
C  NOVEMBER 1991.
      INAME='DPSYSF'
      IF(ICASFL.EQ.'LOWE')INAME='dpsysf'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,ISYSNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
CCCCC ISYSST='NONE'
      ISYSST='OLD'
      ISYSFO='FORMATTED'
      ISYSAC='SEQUENTIAL'
CCCCC ISYSPR='READWRITE'
      ISYSPR='READ'
      ISYSCS='CLOSED'
C
      ILOGNU=28
C  NOVEMBER 1991.
      INAME='DPLOGF'
      IF(ICASFL.EQ.'LOWE')INAME='dplogf'
      NC=6
CCCCC JUNE 1996.  FOR UNIX, PATH DEPENDS ON "HOME" ENVIRONMENT VARIABLE
      IF(IFHOME.EQ.'YES')THEN
        CALL INITF2(INAME,NC,IPATH3,NCP3,IEXT1,NCEXT1,ILOGNA,IBUGIN)
      ELSE
        CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT1,NCEXT1,ILOGNA,IBUGIN)
      ENDIF
      IF(IHOST1.EQ.'NVE')ILOGNA='DPLOGF'
C  END OF NOVEMBER 1991 CHANGE
CCCCC ILOGST='NONE'
      ILOGST='OLD'
      ILOGFO='FORMATTED'
      ILOGAC='SEQUENTIAL'
CCCCC ILOGPR='READWRITE'
      ILOGPR='READ'
      ILOGCS='CLOSED'
C
      IDIRNU=29
C  NOVEMBER 1991.
      INAME='DPDIRF'
      IF(ICASFL.EQ.'LOWE')INAME='dpdirf'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IDIRNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IDIRST='OLD'
      IDIRFO='FORMATTED'
      IDIRAC='SEQUENTIAL'
      IDIRPR='READ'
      IDIRCS='CLOSED'
C
      IDICNU=30
C  NOVEMBER 1991.
      INAME='DPDICF'
      IF(ICASFL.EQ.'LOWE')INAME='dpdicf'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IDICNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IDICST='OLD'
      IDICFO='FORMATTED'
      IDICAC='SEQUENTIAL'
      IDICPR='READ'
      IDICCS='CLOSED'
C
C --------------------
C
      IREANU=31
      IREANA='-999'
CCCCC IREAST='UNKNOWN'
      IREAST='OLD'
      IREAFO='FORMATTED'
      IREAAC='SEQUENTIAL'
CCCCC IREAPR='READWRITE'
      IREAPR='READ'
      IREACS='CLOSED'
C
      IWRINU=32
      IWRINA='-999'
      IWRIST='UNKNOWN'
      IWRIFO='FORMATTED'
      IWRIAC='SEQUENTIAL'
      IWRIPR='READWRITE'
      IWRICS='CLOSED'
C
      ISAVNU=33
C  NOVEMBER 1991.
      INAME='DPSAVF'
      IF(ICASFL.EQ.'LOWE')INAME='dpsavf'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT1,NCEXT1,ISAVNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      ISAVST='UNKNOWN'
      ISAVFO='UNFORMATTED'
      ISAVAC='SEQUENTIAL'
      ISAVPR='READWRITE'
      ISAVCS='CLOSED'
C
      ILISNU=34
      ILISNA='-999'
CCCCC ILISST='UNKNOWN'
      ILISST='OLD'
      ILISFO='FORMATTED'
      ILISAC='SEQUENTIAL'
CCCCC ILISPR='READWRITE'
      ILISPR='READ'
      ILISCS='CLOSED'
C
CCCCC FIX BUG, HAVE CREATE COMMAND USE DIFFERNT UNIT NUMBER THAN
CCCCC MACRO.  THIS AVOIDS HANG WHEN "CREATE FILE." ENCOUNTERS A
CCCCC A CALL COMMAND.
      ICRENU=35
      ICREN2=98
      ICRENA='-999'
      ICREST='UNKNOWN'
      ICREFO='FORMATTED'
      ICREAC='SEQUENTIAL'
      ICREPR='READWRITE'
      ICRECS='CLOSED'
C
C     ICAPNU=36
C  DECEMBER, 1989.  UNIT CONFLICT IF HAVE NESTED CALLS.
C  THIS IS AN UNRESOLVED BUG.
      ICAPNU=40
      ICAPNA='-999'
      ICAPST='UNKNOWN'
      ICAPFO='FORMATTED'
      ICAPAC='SEQUENTIAL'
      ICAPPR='READWRITE'
      ICAPCS='CLOSED'
C
C --------------------
C
      ISCRNU=41
C  NOVEMBER 1991.
      INAME='DPSCRF'
      IF(ICASFL.EQ.'LOWE')INAME='dpscrf'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT1,NCEXT1,ISCRNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      ISCRST='UNKNOWN'
      ISCRFO='UNFORMATTED'
      ISCRAC='SEQUENTIAL'
      ISCRPR='READWRITE'
      ISCRCS='CLOSED'
C
      IDATNU=42
C  NOVEMBER 1991.
      INAME='DPDATF'
      IF(ICASFL.EQ.'LOWE')INAME='dpdatf'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT1,NCEXT1,IDATNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
CCCCC IDATST='NONE'
      IDATST='UNKNOWM'
      IDATFO='UNFORMATTED'
      IDATAC='SEQUENTIAL'
      IDATPR='READWRITE'
      IDATCS='CLOSED'
C
      IPL1NU=43
CCCCC IPL1ST='UNKNOWN'
C  NOVEMBER 1991.
      INAME='DPPL1F'
      IF(ICASFL.EQ.'LOWE')INAME='dppl1f'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT2,NCEXT2,IPL1NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IPL1ST='NEW'
      IF(IHOST1.EQ.'HONE')IPL1ST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')IPL1ST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')IPL1ST='UNKNOWN'
      IF(IHOST1.EQ.'CONV')IPL1ST='UNKNOWN'
      IF(IHOST1.EQ.'CRAY')IPL1ST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')IPL1ST='UNKNOWN'
      IF(IHOST1.EQ.'205')IPL1ST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')IPL1ST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      IF(IHOST1.EQ.'IBM-')IPL1ST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1991
      IF(IOPSY1.EQ.'UNIX')IPL1ST='UNKNOWN'
      IPL1FO='FORMATTED'
      IPL1AC='SEQUENTIAL'
CCCCC IPL1PR='READWRITE'
      IPL1PR='WRITE'
      IPL1CS='CLOSED'
C
      IPL2NU=44
C  NOVEMBER 1991.
      INAME='DPPL2F'
      IF(ICASFL.EQ.'LOWE')INAME='dppl2f'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT2,NCEXT2,IPL2NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
CCCCC IPL2ST='UNKNOWN'
      IPL2ST='NEW'
      IF(IHOST1.EQ.'HONE')IPL2ST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')IPL2ST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')IPL2ST='UNKNOWN'
      IF(IHOST1.EQ.'CONV')IPL2ST='UNKNOWN'
      IF(IHOST1.EQ.'CRAY')IPL2ST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')IPL2ST='UNKNOWN'
      IF(IHOST1.EQ.'205')IPL2ST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')IPL2ST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      IF(IHOST1.EQ.'IBM-')IPL2ST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1991
      IF(IOPSY1.EQ.'UNIX')IPL2ST='UNKNOWN'
      IPL2FO='FORMATTED'
      IPL2AC='SEQUENTIAL'
CCCCC IPL2PR='READWRITE'
      IPL2PR='WRITE'
      IPL2CS='CLOSED'
C
      IPRONU=45
C  NOVEMBER 1991.
      INAME='DPPROF'
      IF(ICASFL.EQ.'LOWE')INAME='dpprof'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT1,NCEXT1,IPRONA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IPROST='UNKNOWN'
      IPROFO='FORMATTED'
      IPROAC='SEQUENTIAL'
      IPROPR='READWRITE'
      IPROCS='CLOSED'
C
      ICONNU=46
CCCCC ICONST='UNKNOWN'
C  NOVEMBER 1991.
      INAME='DPCONF'
      IF(ICASFL.EQ.'LOWE')INAME='dpconf'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT1,NCEXT1,ICONNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      ICONST='NEW'
      IF(IHOST1.EQ.'HONE')ICONST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')ICONST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')ICONST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')ICONST='UNKNOWN'
      IF(IHOST1.EQ.'205')ICONST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')ICONST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      IF(IHOST1.EQ.'IBM-')ICONST='UNKNOWN'
CCCCC THE FOLLOWING LINE W AS ADDED NOVEMBER 1991
      IF(IOPSY1.EQ.'UNIX')ICONST='UNKNOWN'
      ICONFO='FORMATTED'
      ICONAC='SEQUENTIAL'
      ICONPR='READWRITE'
      ICONCS='CLOSED'
C
      ISACNU=47
C  NOVEMBER 1991.
      INAME='DPSACF'
      IF(ICASFL.EQ.'LOWE')INAME='dpsacf'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT1,NCEXT1,ISACNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
CCCCC ISACST='UNKNOWN'
      ISACST='NEW'
      IF(IHOST1.EQ.'HONE')ISACST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')ISACST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')ISACST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')ISACST='UNKNOWN'
      IF(IHOST1.EQ.'205')ISACST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')ISACST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      IF(IHOST1.EQ.'IBM-')ISACST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1990.
      IF(IOPSY1.EQ.'UNIX')ISACST='UNKNOWN'
      ISACFO='FORMATTED'
      ISACAC='SEQUENTIAL'
      ISACPR='READWRITE'
      ISACCS='CLOSED'
C
CCCCC THE FOLLOWING SECTION WAS ADDED      MARCH 1992
CCCCC TO DEFINE THE GENERAL OUTPUT FILE     MARCH 1992
      IOUTNU=49
C  NOVEMBER 1991.
      INAME='DPOUTF'
      IF(ICASFL.EQ.'LOWE')INAME='dpoutf'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT1,NCEXT1,IOUTNA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
CCCCC IOUTST='UNKNOWN'
      IOUTST='NEW'
      IF(IHOST1.EQ.'HONE')IOUTST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')IOUTST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')IOUTST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')IOUTST='UNKNOWN'
      IF(IHOST1.EQ.'205')IOUTST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')IOUTST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      IF(IHOST1.EQ.'IBM-')IOUTST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1990.
      IF(IOPSY1.EQ.'UNIX')IOUTST='UNKNOWN'
      IOUTFO='FORMATTED'
      IOUTAC='SEQUENTIAL'
      IOUTPR='READWRITE'
      IOUTCS='CLOSED'
C
C --------------------
C
      IEX1NU=51
C  NOVEMBER 1991.
      INAME='DPEX1F'
      IF(ICASFL.EQ.'LOWE')INAME='dpex1f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IEX1NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IEX1ST='OLD'
      IEX1FO='FORMATTED'
      IEX1AC='SEQUENTIAL'
      IEX1PR='READ'
      IEX1CS='CLOSED'
C
      IEX2NU=52
C  NOVEMBER 1991.
      INAME='DPEX2F'
      IF(ICASFL.EQ.'LOWE')INAME='dpex2f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IEX2NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IEX2ST='OLD'
      IEX2FO='FORMATTED'
      IEX2AC='SEQUENTIAL'
      IEX2PR='READ'
      IEX2CS='CLOSED'
C
      IEX3NU=53
      IEX3ST='OLD'
C  NOVEMBER 1991.
      INAME='DPEX3F'
      IF(ICASFL.EQ.'LOWE')INAME='dpex3f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IEX3NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IEX3FO='FORMATTED'
      IEX3AC='SEQUENTIAL'
      IEX3PR='READ'
      IEX3CS='CLOSED'
C
      IEX4NU=54
      IEX4ST='OLD'
C  NOVEMBER 1991.
      INAME='DPEX4F'
      IF(ICASFL.EQ.'LOWE')INAME='dpex4f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IEX4NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IEX4FO='FORMATTED'
      IEX4AC='SEQUENTIAL'
      IEX4PR='READ'
      IEX4CS='CLOSED'
C
      IEX5NU=55
      IEX5ST='OLD'
C  NOVEMBER 1991.
      INAME='DPEX5F'
      IF(ICASFL.EQ.'LOWE')INAME='dpex5f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IEX5NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IEX5FO='FORMATTED'
      IEX5AC='SEQUENTIAL'
      IEX5PR='READ'
      IEX5CS='CLOSED'
C
      IHHBNU=59
      IHHBST='OLD'
      INAME='HANDBK'
      IF(ICASFL.EQ.'LOWE')INAME='handbk'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHHBNA,IBUGIN)
      IHHBFO='FORMATTED'
      IHHBAC='SEQUENTIAL'
      IHHBPR='READ'
      IHHBCS='CLOSED'
C
      IHRMNU=60
      IHRMST='OLD'
      INAME='REFMAN'
      IF(ICASFL.EQ.'LOWE')INAME='refman'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHRMNA,IBUGIN)
      IHRMFO='FORMATTED'
      IHRMAC='SEQUENTIAL'
      IHRMPR='READ'
      IHRMCS='CLOSED'
C
      IHE1NU=61
      IHE1ST='OLD'
C  NOVEMBER 1991.
      INAME='DPHE1F'
      IF(ICASFL.EQ.'LOWE')INAME='dphe1f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHE1NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHE1FO='FORMATTED'
      IHE1AC='SEQUENTIAL'
      IHE1PR='READ'
      IHE1CS='CLOSED'
C
      IHE2NU=62
      IHE2ST='OLD'
C  NOVEMBER 1991.
      INAME='DPHE2F'
      IF(ICASFL.EQ.'LOWE')INAME='dphe2f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHE2NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHE2FO='FORMATTED'
      IHE2AC='SEQUENTIAL'
      IHE2PR='READ'
      IHE2CS='CLOSED'
C
      IHE3NU=63
      IHE3ST='OLD'
C  NOVEMBER 1991.
      INAME='DPHE3F'
      IF(ICASFL.EQ.'LOWE')INAME='dphe3f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHE3NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHE3FO='FORMATTED'
      IHE3AC='SEQUENTIAL'
      IHE3PR='READ'
      IHE3CS='CLOSED'
C
      IHE4NU=64
      IHE4ST='OLD'
C  NOVEMBER 1991.
      INAME='DPHE4F'
      IF(ICASFL.EQ.'LOWE')INAME='dphe4f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHE4NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHE4FO='FORMATTED'
      IHE4AC='SEQUENTIAL'
      IHE4PR='READ'
      IHE4CS='CLOSED'
C
      IHE5NU=65
      IHE5ST='OLD'
C  NOVEMBER 1991.
      INAME='DPHE5F'
      IF(ICASFL.EQ.'LOWE')INAME='dphe5f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHE5NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHE5FO='FORMATTED'
      IHE5AC='SEQUENTIAL'
      IHE5PR='READ'
      IHE5CS='CLOSED'
C
      IHE6NU=66
      IHE6ST='OLD'
C  NOVEMBER 1991.
      INAME='DPHE6F'
      IF(ICASFL.EQ.'LOWE')INAME='dphe6f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHE6NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHE6FO='FORMATTED'
      IHE6AC='SEQUENTIAL'
      IHE6PR='READ'
      IHE6CS='CLOSED'
C
      IHE7NU=67
      IHE7ST='OLD'
C  NOVEMBER 1991.
      INAME='DPHE7F'
      IF(ICASFL.EQ.'LOWE')INAME='dphe7f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHE7NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHE7FO='FORMATTED'
      IHE7AC='SEQUENTIAL'
      IHE7PR='READ'
      IHE7CS='CLOSED'
C
      IHE8NU=68
      IHE8ST='OLD'
C  NOVEMBER 1991.
      INAME='DPHE8F'
      IF(ICASFL.EQ.'LOWE')INAME='dphe8f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHE8NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHE8FO='FORMATTED'
      IHE8AC='SEQUENTIAL'
      IHE8PR='READ'
      IHE8CS='CLOSED'
C
      IHE9NU=69
      IHE9ST='OLD'
C  NOVEMBER 1991.
      INAME='DPHE9F'
      IF(ICASFL.EQ.'LOWE')INAME='dphe9f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IHE9NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IHE9FO='FORMATTED'
      IHE9AC='SEQUENTIAL'
      IHE9PR='READ'
      IHE9CS='CLOSED'
C
CCCCC THE FOLLOWING 9 MENU SECTIONS WERE ADDED JUNE 1990
C
      IME1NU=71
      IME1ST='OLD'
C  NOVEMBER 1991.
      INAME='DPME1F'
      IF(ICASFL.EQ.'LOWE')INAME='dpme1f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IME1NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IME1FO='FORMATTED'
      IME1AC='SEQUENTIAL'
      IME1PR='READ'
      IME1CS='CLOSED'
C
      IME2NU=72
      IME2ST='OLD'
C  NOVEMBER 1991.
      INAME='DPME2F'
      IF(ICASFL.EQ.'LOWE')INAME='dpme2f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IME2NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IME2FO='FORMATTED'
      IME2AC='SEQUENTIAL'
      IME2PR='READ'
      IME2CS='CLOSED'
C
      IME3NU=73
      IME3ST='OLD'
C  NOVEMBER 1991.
      INAME='DPME3F'
      IF(ICASFL.EQ.'LOWE')INAME='dpme3f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IME3NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IME3FO='FORMATTED'
      IME3AC='SEQUENTIAL'
      IME3PR='READ'
      IME3CS='CLOSED'
C
      IME4NU=74
      IME4ST='OLD'
C  NOVEMBER 1991.
      INAME='DPME4F'
      IF(ICASFL.EQ.'LOWE')INAME='dpme4f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IME4NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IME4FO='FORMATTED'
      IME4AC='SEQUENTIAL'
      IME4PR='READ'
      IME4CS='CLOSED'
C
      IME5NU=75
      IME5ST='OLD'
C  NOVEMBER 1991.
      INAME='DPME5F'
      IF(ICASFL.EQ.'LOWE')INAME='dpme5f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IME5NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IME5FO='FORMATTED'
      IME5AC='SEQUENTIAL'
      IME5PR='READ'
      IME5CS='CLOSED'
C
      IME6NU=76
      IME6ST='OLD'
C  NOVEMBER 1991.
      INAME='DPME6F'
      IF(ICASFL.EQ.'LOWE')INAME='dpme6f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IME6NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IME6FO='FORMATTED'
      IME6AC='SEQUENTIAL'
      IME6PR='READ'
      IME6CS='CLOSED'
C
      IME7NU=77
      IME7ST='OLD'
C  NOVEMBER 1991.
      INAME='DPME7F'
      IF(ICASFL.EQ.'LOWE')INAME='dpme7f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IME7NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IME7FO='FORMATTED'
      IME7AC='SEQUENTIAL'
      IME7PR='READ'
      IME7CS='CLOSED'
C
      IME8NU=78
      IME8ST='OLD'
C  NOVEMBER 1991.
      INAME='DPME8F'
      IF(ICASFL.EQ.'LOWE')INAME='dpme8f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IME8NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IME8FO='FORMATTED'
      IME8AC='SEQUENTIAL'
      IME8PR='READ'
      IME8CS='CLOSED'
C
      IME9NU=79
      IME9ST='OLD'
C  NOVEMBER 1991.
      INAME='DPME9F'
      IF(ICASFL.EQ.'LOWE')INAME='dpme9f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IME9NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IME9FO='FORMATTED'
      IME9AC='SEQUENTIAL'
      IME9PR='READ'
      IME9CS='CLOSED'
C
CCCCC THE FOLLOWING 11 SECTIONS (10 TO 20) WERE ADDED AUGUST 1990
      IM10NU=80
      IM10ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM10F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm10f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM10NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM10FO='FORMATTED'
      IM10AC='SEQUENTIAL'
      IM10PR='READ'
      IM10CS='CLOSED'
C
      IM11NU=81
      IM11ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM11F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm11f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM11NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM11FO='FORMATTED'
      IM11AC='SEQUENTIAL'
      IM11PR='READ'
      IM11CS='CLOSED'
C
      IM12NU=82
      IM12ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM12F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm12f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM12NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM12FO='FORMATTED'
      IM12AC='SEQUENTIAL'
      IM12PR='READ'
      IM12CS='CLOSED'
C
      IM13NU=83
      IM13ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM13F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm13f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM13NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM13FO='FORMATTED'
      IM13AC='SEQUENTIAL'
      IM13PR='READ'
      IM13CS='CLOSED'
C
      IM14NU=84
      IM14ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM14F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm14f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM14NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM14FO='FORMATTED'
      IM14AC='SEQUENTIAL'
      IM14PR='READ'
      IM14CS='CLOSED'
C
      IM15NU=85
      IM15ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM15F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm15f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM15NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM15FO='FORMATTED'
      IM15AC='SEQUENTIAL'
      IM15PR='READ'
      IM15CS='CLOSED'
C
      IM16NU=86
      IM16ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM16F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm16f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM16NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM16FO='FORMATTED'
      IM16AC='SEQUENTIAL'
      IM16PR='READ'
      IM16CS='CLOSED'
C
      IM17NU=87
      IM17ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM17F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm17f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM17NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM17FO='FORMATTED'
      IM17AC='SEQUENTIAL'
      IM17PR='READ'
      IM17CS='CLOSED'
C
      IM18NU=88
      IM18ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM18F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm18f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM18NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM18FO='FORMATTED'
      IM18AC='SEQUENTIAL'
      IM18PR='READ'
      IM18CS='CLOSED'
C
      IM19NU=89
      IM19ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM19F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm19f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM19NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM19FO='FORMATTED'
      IM19AC='SEQUENTIAL'
      IM19PR='READ'
      IM19CS='CLOSED'
C
      IM20NU=90
      IM20ST='OLD'
C  NOVEMBER 1991.
      INAME='DPM20F'
      IF(ICASFL.EQ.'LOWE')INAME='dpm20f'
      NC=6
      CALL INITF2(INAME,NC,IPATH1,NCP1,IEXT1,NCEXT1,IM20NA,IBUGIN)
C  END OF NOVEMBER 1991 CHANGE
      IM20FO='FORMATTED'
      IM20AC='SEQUENTIAL'
      IM20PR='READ'
      IM20CS='CLOSED'
C
C --------------------
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED OCTOBER 1991
CCCCC MODIFIED MARCH 1992
CCCCC FOR STORAGE OF SELECTED OUTPUT FROM FIT, ANOVA, YATES, ETC.
C
      IST1NU=91
CCCCC IST1ST='UNKNOWN'
      IST1ST='NEW'
      IF(IHOST1.EQ.'HONE')IST1ST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')IST1ST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')IST1ST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')IST1ST='UNKNOWN'
      IF(IHOST1.EQ.'205')IST1ST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')IST1ST='UNKNOWN'
      IF(IHOST1.EQ.'IBM-')IST1ST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED MARCH 1992
      IF(IOPSY1.EQ.'UNIX')IST1ST='UNKNOWN'
C  MARCH 1992.
      INAME='DPST1F'
      IF(ICASFL.EQ.'LOWE')INAME='dpst1f'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT2,NCEXT2,IST1NA,IBUGIN)
C  END OF MARCH 1992 CHANGE
      IST1FO='FORMATTED'
      IST1AC='SEQUENTIAL'
CCCCC AUGUST 1992.  FILE PERMISSION SHOULD BE READ/WRITE
CCCCC IST1PR='READONLY'
      IST1PR='READWRITE'
      IST1CS='CLOSED'
C
      IST2NU=92
CCCCC IST2ST='UNKNOWN'
      IST2ST='NEW'
      IF(IHOST1.EQ.'HONE')IST2ST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')IST2ST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')IST2ST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')IST2ST='UNKNOWN'
      IF(IHOST1.EQ.'205')IST2ST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')IST2ST='UNKNOWN'
      IF(IHOST1.EQ.'IBM-')IST2ST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED MARCH 1992
      IF(IOPSY1.EQ.'UNIX')IST2ST='UNKNOWN'
C  MARCH 1992.
      INAME='DPST2F'
      IF(ICASFL.EQ.'LOWE')INAME='dpst2f'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT2,NCEXT2,IST2NA,IBUGIN)
C  END OF MARCH 1992 CHANGE
      IST2FO='FORMATTED'
      IST2AC='SEQUENTIAL'
CCCCC AUGUST 1992.  FILE PERMISSION SHOULD BE READ/WRITE
CCCCC IST2PR='READONLY'
      IST2PR='READWRITE'
      IST2CS='CLOSED'
C
      IST3NU=93
CCCCC IST3ST='UNKNOWN'
      IST3ST='NEW'
      IF(IHOST1.EQ.'HONE')IST3ST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')IST3ST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')IST3ST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')IST3ST='UNKNOWN'
      IF(IHOST1.EQ.'205')IST3ST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')IST3ST='UNKNOWN'
      IF(IHOST1.EQ.'IBM-')IST3ST='UNKNOWN'
CCCCC THE FOLLOWING LINE WAS ADDED MARCH 1992
      IF(IOPSY1.EQ.'UNIX')IST3ST='UNKNOWN'
C  MARCH 1992.
      INAME='DPST3F'
      IF(ICASFL.EQ.'LOWE')INAME='dpst3f'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT2,NCEXT2,IST3NA,IBUGIN)
C  END OF MARCH 1992 CHANGE
      IST3FO='FORMATTED'
      IST3AC='SEQUENTIAL'
CCCCC AUGUST 1992.  FILE PERMISSION SHOULD BE READ/WRITE
CCCCC IST3PR='READONLY'
      IST3PR='READWRITE'
      IST3CS='CLOSED'
C
C
      IST4NU=94
CCCCC IST4ST='UNKNOWN'
      IST4ST='NEW'
      IF(IHOST1.EQ.'HONE')IST4ST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')IST4ST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')IST4ST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')IST4ST='UNKNOWN'
      IF(IHOST1.EQ.'205')IST4ST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')IST4ST='UNKNOWN'
      IF(IHOST1.EQ.'IBM-')IST4ST='UNKNOWN'
      IF(IOPSY1.EQ.'UNIX')IST4ST='UNKNOWN'
      INAME='DPST4F'
      IF(ICASFL.EQ.'LOWE')INAME='dpst4f'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT2,NCEXT2,IST4NA,IBUGIN)
      IST4FO='FORMATTED'
      IST4AC='SEQUENTIAL'
      IST4PR='READWRITE'
      IST4CS='CLOSED'
C
      IST5NU=95
CCCCC IST5ST='UNKNOWN'
      IST5ST='NEW'
      IF(IHOST1.EQ.'HONE')IST5ST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')IST5ST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')IST5ST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')IST5ST='UNKNOWN'
      IF(IHOST1.EQ.'205')IST5ST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')IST5ST='UNKNOWN'
      IF(IHOST1.EQ.'IBM-')IST5ST='UNKNOWN'
      IF(IOPSY1.EQ.'UNIX')IST5ST='UNKNOWN'
      INAME='DPST5F'
      IF(ICASFL.EQ.'LOWE')INAME='dpst5f'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT2,NCEXT2,IST5NA,IBUGIN)
      IST5FO='FORMATTED'
      IST5AC='SEQUENTIAL'
      IST5PR='READWRITE'
      IST5CS='CLOSED'
C
      IZCHNU=97
CCCCC IZCHST='UNKNOWN'
      IZCHST='NEW'
      IF(IHOST1.EQ.'HONE')IZCHST='UNKNOWN'
      IF(IHOST1.EQ.'PERK')IZCHST='UNKNOWN'
      IF(IHOST1.EQ.'SUN')IZCHST='UNKNOWN'
      IF(IHOST1.EQ.'NVE')IZCHST='UNKNOWN'
      IF(IHOST1.EQ.'205')IZCHST='UNKNOWN'
      IF(IHOST1.EQ.'CDC')IZCHST='UNKNOWN'
      IF(IHOST1.EQ.'IBM-')IZCHST='UNKNOWN'
      IF(IOPSY1.EQ.'UNIX')IZCHST='UNKNOWN'
      INAME='DPZCHF'
      IF(ICASFL.EQ.'LOWE')INAME='dpzchf'
      NC=6
      CALL INITF2(INAME,NC,IPATH2,NCP2,IEXT2,NCEXT2,IZCHNA,IBUGIN)
      IZCHFO='FORMATTED'
      IZCHAC='SEQUENTIAL'
      IZCHPR='READWRITE'
      IZCHCS='CLOSED'
C
C
C --------------------
C
C     DEFINE THE CHARACTER WHICH
C     (IF FOUND IN A WORD)
C     SPECIFIES THAT WORD TO BE A FILE NAME
C     (AS OPPOSED TO A DATAPLOT
C     VARIABLE, PARAMETER, COMMAND, ETC.).
C     THE DEFAULT CHARACTER IS . (= PERIOD)
C
      IFCHAR='.'
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGIN.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF INITFO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IMESNU,IMESST
 9021 FORMAT('IMESNU,IMESST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)INEWNU,INEWST
 9022 FORMAT('INEWNU,INEWST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IMAINU,IMAIST
 9023 FORMAT('IMAINU,IMAIST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IHELNU,IHELST
 9024 FORMAT('IHELNU,IHELST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IBUGNU,IBUGST
 9025 FORMAT('IBUGNU,IBUGST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IQUENU,IQUEST
 9026 FORMAT('IQUENU,IQUEST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ISYSNU,ISYSST
 9027 FORMAT('ISYSNU,ISYSST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)ILOGNU,ILOGST
 9028 FORMAT('ILOGNU,ILOGST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IDIRNU,IDIRST
 9029 FORMAT('IDIRNU,IDIRST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)IDICNU,IDICST
 9030 FORMAT('IDICNU,IDICST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IREANU,IREAST
 9031 FORMAT('IREANU,IREAST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IWRINU,IWRIST
 9032 FORMAT('IWRINU,IWRIST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)ISAVNU,ISAVST
 9033 FORMAT('ISAVNU,ISAVST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)ICRENU,ICREST
 9034 FORMAT('ICRENU,ICREST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)ISCRNU,ISCRST
 9035 FORMAT('ISCRNU,ISCRST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IDATNU,IDATST
 9036 FORMAT('IDATNU,IDATST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)IPL1NU,IPL1ST
 9037 FORMAT('IPL1NU,IPL1ST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)IPL2NU,IPL2ST
 9038 FORMAT('IPL2NU,IPL2ST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IPRONU,IPROST
 9039 FORMAT('IPRONU,IPROST = ',I8,2X,A2)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9040)ICONNU,ICONST
 9040 FORMAT('ICONNU,ICONST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IOUTNU,IOUTST
 9042 FORMAT('IOUTNU,IOUTST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
CCCCC AUGUST 1992.  ADD FOLLOWING LINES
      WRITE(ICOUT,9043)IEDDIR
 9043 FORMAT('IEDDIR=',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)NCEDT1,NCEDT2
 9044 FORMAT('NCEDT1,NCEDT2=',I4,1X,I4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)IEDEXT,IEDCAS
 9045 FORMAT('IEDEXT,IEDCAS = ',A4,1X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE INITF2(INAME,NC1,IPATH,NC2,IEXT,NC3,INAME2,IBUGIN)
C
C     PURPOSE--THIS IS SUBROUTING INITF2.  IT IS A UTILITY ROUTINE
C              FOR INITFO.  IT ADDS A FILE PATH AND EXTENSION TO
C              A FILE NAME.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--NOVEMBER  1991.
C     UPDATED         --APRIL     1992.   INPUT DEBUG STATMENTS (JJF)
C     UPDATED         --MAY       1992.   INITIALIZE INAME2
C     UPDATED         --JULY      1995.   IF PC--DO NOT ADD PATH
C     UPDATED         --APRIL     1996.   UNDO JULY 1995 CHANGE (FIX IN
C                                         DPOPFI FOR NON-C: DRIVE)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGIN
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C  NOVEMBER 1991.  FOLLOWING BLOCK ADDED
C
      CHARACTER*(*) IPATH
      CHARACTER*(*) INAME
      CHARACTER*(*) INAME2
      CHARACTER*(*) IEXT
CCCCC THE FOLLOWING LINE WAS ADDED    JULY 1995
      INCLUDE 'DPCOHO.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='INIT'
      ISUBN2='F2  '
C
      IF(IBUGIN.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF INITF2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NC1,INAME,NC1
   52 FORMAT('NC1,INAME,NC1 = ',I3,1X,A,1X,I3)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NC2,IPATH,NC2
   53 FORMAT('NC2,IPATH,NC2= ',I3,1X,A,1X,I3)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NC3,IEXT,NC3
   54 FORMAT('NC3,IEXT,NC3 = ',I3,1X,A,1X,I3)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************
C               **  STEP 1---  **
C               **  ADD THE FILE*
C               **  PATH        *
C               *****************
C
CCCCC THE FOLLOWING LINE WAS ADDED   MAY 1992  (JJF)
      INAME2=' '
C
CCCCC THE FOLLOWING EXCEPTION FOR PC'S WAS ADDED     JULY 1995
      NCSTR=0
CCCCC APRIL 1996.  CHANGE NOT NEEDED.
CCCCC IF(IHOST1.NE.'IBM-')THEN
         IF(NC2.GT.0)THEN
            INAME2(1:NC2)=IPATH(1:NC2)
            NCSTR=NC2
         END IF
CCCCC END IF
C
C               *****************
C               **  STEP 2---  **
C               **  ADD THE FILE*
C               **  NAME        *
C               *****************
C
      IF(NC1.GT.0)THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+NC1-1
        INAME2(NCSTR:NCSTR2)=INAME(1:NC1)
        NCSTR=NCSTR2
      END IF
C
C               *****************
C               **  STEP 3---  **
C               **  ADD THE FILE*
C               **  EXTENSION   *
C               *****************
C
      IF(NC3.GT.0)THEN
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+NC3-1
        INAME2(NCSTR:NCSTR2)=IEXT(1:NC3)
        NCSTR=NCSTR2
      END IF
 
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGIN.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF INITF2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)INAME,NC1
 9021 FORMAT('INAME,NC1 = ',A,1X,I3)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IPATH,NC2
 9022 FORMAT('IPATH,NC2= ',A,1X,I3)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IEXT,NC3
 9023 FORMAT('IEXT,NC3 = ',A,1X,I3)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)INAME2,NCSTR
 9024 FORMAT('INAME2,NCSTR = ',A,1X,I3)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE INITWI(IBUGIN)
C
C     PURPOSE--THIS IS SUBROUTING INITWI.
C              (THE   WI    AT THE END OF    INITWI   STANDS FOR    WINDOW SYSTE
C              THIS SUBROUTINE INITIALIZES WINDOW SYSTEM VARIABLES AND PARAMETER
C     NOTE--
C           IBUGWI = BUG SWITCH FOR WINDOWS
C           ISUBWI = SUBROUTINE TRACE SWITCH FOR WINDOWS
C           IERRWI = ERROR SWITCH FOR WINDOWS
C
C           IDEFWS = DEFAULT WINDOW SYSTEM
C           IWINSY = WINDOW SYSTEM
C           IDEFWP = DEFAULT WINDOW POINTER
C           IWINPO = WINDOW POINTER
C
C           IWERIN    = ERASE WHEN INITIALIZE THE WINDOW SYSTEM?
C
C           MAXWIN    = MAXIMUM NUMBER OF WINDOWS
C           IWINCW    = CURRENT WINDOW
C           IWEROP(I) = ERASE WHEN OPEN A WINDOW?
C           IWINBC(I) = BACKGROUND COLOR FOR A WINDOW
C           IWINFC(I) = FOREGROUND COLOR FOR A WINDOW
C           IWINTY(I) = TYPE OF WINDOW (POP/PERM)
C           IWINFR(I) = FRAME FOR A WINDOW?
C           IWINWR(I) = WRAP/NO WRAP WITHIN A WINDOW?
C           IWINX1(I) = UPPER LEFT  CORNER X VALUE FOR WINDOW
C           IWINY1(I) = UPPER LEFT  CORNER Y VALUE FOR WINDOW
C           IWINXL(I) = HORIZONTAL LENGTH FOR THE WINDOW
C           IWINYL(I) = VERTICAL   LENGTH FOR THE WINDOW
C           IWINX2(I) = LOWER RIGHT CORNER X VALUE FOR WINDOW
C           IWINY2(I) = LOWER RIGHT CORNER Y VALUE FOR WINDOW
C           IWERCL(I) = ERASE WHEN CLOSE A WINDOW?
C           IWWRPR(I) = WRITE PREVIOUS SCREEN AFTER CLOSE WINDOW?
C
C           IWEREX    = ERASE WHEN EXIT THE WINDOW SYSTEM?
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--90.9
C     ORIGINAL VERSION--SEPTEMBER 1990.
C     UPDATED         --NOVEMBER  1990.  IWINSY FROM OTG TO NONE
C     UPDATED         --JANUARY   1991.  IWINSY FROM NONE TO C
C     UPDATED         --AUGUST    1993.  COMPILE ERROR (RS-6000)
C
C-----NON-COMMON VARIABLES----------------------------------
C
      CHARACTER*4 IBUGIN
CCCCC AUGUST 1993.  COMPILE ERROR ON RS-6000, ADD FOLLOWING LINE
      CHARACTER*4 IWINPO
C
C-----COMMON (FOR WINDOW SYSTEM)----------------------------
C
      INCLUDE 'DPCOWI.INC'
C
C-----COMMON VARIABLES (GENERAL)----------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGIN.EQ.'OFF')GOTO99
      WRITE(ICOUT,90)
   90 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,95)
   95 FORMAT('***** AT THE BEGINNING OF INITWI--')
      CALL DPWRST('XXX','BUG ')
   99 CONTINUE
C
      IBUGWI='OFF'
      ISUBWI='XXXX'
      IERRWI='NO'
C
      IDEFWS='NONE'
CCCCC THE FOLLOWING LINE WAS CHANGED NOVEMBER 1990
CCCCC IWINSY='OTG'
CCCCC THE FOLLOWING LINE WAS FIXED JANUARY 1991
CCCCC IWINSY='NONE'
CCCCC IWINSY='C'
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1991
      IWINSY='NONE'
      IDEFWP='NUMB'
      IWINPO='NUMB'
C
      MAXWIN=10
      IWINCW=0
C
      IWERIN='OFF'
C
      DO1000I=1,10
      IWEROP(I)='OFF'
      IWINBC(I)='BLUE'
      IWINFC(I)='WHIT'
      WIPOP(I)='POP'
      IWINTY(I)='POP'
      IWINFR(I)='OFF'
      IWINWR(I)='OFF'
      IWINX1(I)=1
      IWINY1(I)=1
      IWINXL(I)=80
      IWINYL(I)=24
      IWINX2(I)=80
      IWINY2(I)=24
      IWERCL(I)='OFF'
      IWWRPR(I)='OFF'
 1000 CONTINUE
C
      IWEREX='OFF'
C
C               *******************************
C               **  EXIT AND RETURN TO MAIN  **
C               *******************************
C
 9000 CONTINUE
      IF(IBUGIN.EQ.'OFF')GOTO9999
      WRITE(ICOUT,9990)
 9990 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9995)
 9995 FORMAT('***** AT THE END       OF INITWI--')
      CALL DPWRST('XXX','BUG ')
 9999 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--OPEN A FILE
C              (BUT THERE MAY BE SOME SMALL DIFFERENCES
C              IN HOW THAT IS DONE FOR DIFFERENT COMPUTERS).
C     NOTE--A REMARK TO THE CDC, PERKIN-ELMER, HONEYWELL, ETC. IMPLEMENTORS--
C           YOUR SECTIONS BELOW MUST HAVE A FEW MORE LINES MANUALLY
C           INSERTED IF YOU WISH YOUR USERS TO HAVE THE ABILITY
C           OF ACCESSING DATAPLOT'S REFERENCE/DATA/MAP/FRACTAL/MACRO
C           FILES AUTOMATICALLY WITHOUT EXPLICITLY PREFIXING
C           THE FILE NAME WITH THE HOME DIRECTORY WHERE DATAPLOT RESIDES.
C           SEE FOR EXAMPLE THE GENERAL SECTION BELOW AND THE VAX SECTION
C           BELOW WHERE SUCH LOGIC HAS BEEN BUILT IN.
C           IF YOU OMIT THIS ADDITION, THEN NOTHING IS LOST PER SE
C           BUT THE USERS WILL HAVE TO SPELL OUT FULLY DATAPLOT'S
C           HOME DIRECTORY WHEN REFERENCING THESE ACCESSORY
C           REFERENCE/DATA/MAP/FRACTAL/MACRO/ETC. FILES.
C           E.G., LIST TEXAS.DAT              VERSUS
C                 LIST DATAPLO$:TEXAS.DAT
C
C     DANGER--THE INPUT ARGUMENT IFILE MAY UNDER CERTAIN
C             CIRCUMSTANCES BE CHANGED WITHIN THIS SUBROUTINE.
C     WRITTEN BY--JAMES J. FILLIBEN
C     LANGUAGE--ANSI FORTRAN (1977)
C     ORIGINAL VERSION--NOVEMBER  1985.
C     UPDATED         --SEPTEMBER 1986.
C     UPDATED         --OCTOBER   1987.  (FORM LOWER AND UPPER CASE NAMES)
C     UPDATED         --NOVEMBER  1987.  (CLOSE BEFORE OPEN FOR HONEYWELL)
C     UPDATED         --DECEMBER  1988.  (AUTO PREFIX OF DP'S HOME DIREC.)
C     UPDATED         --FEBRUARY  1989.  CYBER/CDC CASE (ALAN)
C     UPDATED         --FEBRUARY  1988.  CYBER/CDC DATAPLOT REF. FILES (ALAN)
C     UPDATED         --JULY      1989.  FIXED POSITION VALIUES FOR IFILE2(.:.)
C     UPDATED         --MAY       1990.  FOR UNIX (I.E., GENERAL CASE), TRY TO
C                                        OPEN FILES WITH TRAILING PERIOD
C                                        STRIPPED OFF.
C     UPDATED         --NOVEMBER  1991.  CHANGES MADE FOR EASIER IMPLEMENTING
C     UPDATED         --DECEMBER  1993.  ACTIVATE 3 CUNIX LINES
C     UPDATED         --AUGUST    1994.  COMMENT OUT WRITE STATEMENTS
C     UPDATED         --JUNE      1995.  AUTO-READ FROM DP SUB-DIRECTORIES
C     UPDATED         --APRIL     1996.  EXTEND 6/95 CHANGE TO UNIX,
C     UPDATED         --APRIL     1996.  ALLOW PATH NAME FOR UNIX TO
C                                        BE SET FROM ENVIRONMENT VARIABLE,
C                                        SOFT-CODE BACKSLASH FOR PC
C                                        TO AVOID UNIX COMPILATION 
C                                        ERRORS
C     UPDATED         --JUNE      1996.  LAHEY COMPILER FOR PC
C     UPDATED         --JULY      2002.  CHECK FOR QUOTED FILE NAME
C     UPDATED         --MARCH     2006.  USE THE "PROT" OPTION FOR
C                                        WINDOWS OPTION.
C
C---------------------------------------------------------------------
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*80 IFILEL
      CHARACTER*80 IFILEU
      CHARACTER*80 IFILE2
      CHARACTER*80 FTEMP
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC APRIL 1996.  SOFT-CODE BACKSLASH CHARACTER
      CHARACTER*4 IBSLC
C
      LOGICAL IOPPLO
      COMMON/OPNPLT/IOPPLO
C
C-----COMMON------------------------------------------------
C
      INCLUDE 'DPCOHO.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='DPOP'
      ISUBN2='FI  '
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'OPFI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOPFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IOUNIT
   61 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IFILE
   62 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ISTAT
   63 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IFORM
   64 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IACCES
   65 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)IPROT
   66 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICURST
   67 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)IREWIN
   68 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)ISUBN0
   69 FORMAT('ISUBN0 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)IERRFI
   70 FORMAT('IERRFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)IHOST1
   71 FORMAT('IHOST1 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
CCCCC APRIL 1996.  SOFT-CODE BACKSLASH CHARACTER
      CALL DPCONA(92,IBSLC)
C
C               *******************
C               **  STEP 1--     **
C               **  OPEN A FILE  **
C               *******************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'OPFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IHOST1.EQ.'VAX')GOTO2100
C
      IF(IHOST1.EQ.'CDC')GOTO2200
      IF(IHOST1.EQ.'CYBE')GOTO2200
      IF(IHOST1.EQ.'205')GOTO2200
      IF(IHOST1.EQ.'NVE')GOTO2200
C
CCCCC IF(IHOST1.EQ.'PERK')GOTO2300
C
CCCCC IF(IHOST1.EQ.'HONE')GOTO2400
C
      GOTO1100
C
C-----TREAT THE GENERAL CASE (E.G., UNIX)-------------------------------------
C
C  MODIFIED MAY, 1990.  IF CAN NOT OPEN FILE, STRIP OFF TRAILING PERIOD
C  (IF FILE NAME ENDS WITH PERIOD) AND TRY TO OPEN.  THIS FIXES UNIX BUG
C  (DATAPLOT COULD NOT OPEN A FILE THAT DID NOT CONTAIN A SUFFIX, I.E.
C  READ TEST.  FAILED FOR A FILE NAMED "TEST".  NOTE THAT ON UNIX, THE
C  FILE "TEST" AND "TEST." ARE NOT THE SAME.  DATAPLOT WILL NOW TRY TO
C  OPEN BOTH WAYS).
C
C     1. SEE IF CAN OPEN THE FILE WITH THE NAME LITERALLY AS GIVEN
C
 1100 CONTINUE
      FTEMP=IFILE
CCCCC JULY 2002: CHECK FOR LEADING QUOTE.
C
      IF(IFILE(1:1).EQ.'"')THEN
        DO1102I=2,80
          IF(IFILE(I:I).EQ.'"')THEN
            FTEMP=' '
            FTEMP(1:I-2)=IFILE(2:I-1) 
            GOTO1103
          ENDIF
 1102   CONTINUE
 1103   CONTINUE
      ENDIF
C
      IFLAG=0
      IF(IHOST1.EQ.'HONE')CLOSE(IOUNIT)
C
 1110 CONTINUE
      IOSTA2=0
CCCCC OPEN(UNIT=IOUNIT,FILE=IFILE,STATUS=ISTAT,FORM=IFORM,
      OPEN(UNIT=IOUNIT,FILE=FTEMP,STATUS=ISTAT,FORM=IFORM,
     1ACTION=IPROT,
     1IOSTAT=IOSTA2)
      IOST1=IOSTA2
      IF(IOSTA2.NE.0)GOTO1120
      GOTO1190
C
C     2. IF CANNOT OPEN THE FILE WITH NAME LITERALLY AS GIVEN,
C        THEN CONVERT THE FILE NAME TO LOWER CASE (E.G., UNIX)
C        AND SEE IF CAN OPEN THAT
C
 1120 CONTINUE
C
      IFILEL=FTEMP
      CALL DPLO80(IFILEL,IFILEL,IBUGS2,IERROR)
      IOSTA2=0
      OPEN(UNIT=IOUNIT,FILE=IFILEL,STATUS=ISTAT,FORM=IFORM,
     1ACTION=IPROT,
     1IOSTAT=IOSTA2)
      IOST2=IOSTA2
      IF(IOSTA2.NE.0)GOTO1130
      IFILE=IFILEL
      GOTO1190
C
C     3. IF CANNOT OPEN THE FILE WITH NAME LITERALLY AS GIVEN,
C        AND IF CANNOT OPEN THE FILE WITH NAME CONVERTED TO LOWER CASE,
C        THEN CONVERT THE FILE NAME TO UPPER CASE AND SEE IF CAN OPEN THAT
C
 1130 CONTINUE
CCCCC IFILEU=IFILE
      IFILEU=FTEMP
      CALL DPUP80(IFILEU,IFILEU,IBUGS2,IERROR)
      IOSTA2=0
      OPEN(UNIT=IOUNIT,FILE=IFILEU,STATUS=ISTAT,FORM=IFORM,
     1ACTION=IPROT,
     1IOSTAT=IOSTA2)
      IOST3=IOSTA2
      IF(IOSTA2.NE.0)GOTO1140
      IFILE=IFILEU
      GOTO1190
C
C      4. IF STILL CANNOT OPEN THE FILE
C        THEN PERHAPS THE ANALYST IS TRYING TO OPEN
C        A FILE NOT IN HIS OWN DIRECTORY, BUT A FILE RESIDING
C        IN DATAPLOT'S DIRECTORY (E.G., ONE OF DATAPLOT'S
C        REFRENCE, DATA, MAP, FRACTAL, MACRO, ETC. FILES).
C        TO CHECK THIS CONTINGENCY, INSERT THE
C        NAME OF DATAPLOT'S DIRECTORY IN FRONT OF
C        THE SPECIFIED FILE NAME, AND TRY TO OPEN THAT
C        BY REPEATING THE ABOVE 3 STEPS.
C
 1140 CONTINUE
C     A NOTE TO THE IMPLEMENTOR--
C     THE NEXT 2 LINES MUST BE CHANGED TO REFLECT THE
C     ACTUAL NAME OF THE DIRECTORY WHERE DATAPLOT'S
C     REFERENCE/DATA/MAP/FRACTAL/MACRO/ETC. FILES RESIDE.
C     USE "/usr/local/lib/dataplot/" SINCE THIS IS THE DEFAULT
C     DIRECTORY FOR UNIX SYSTEMS FOR DATAPLOT'S FILES.
CCCCC THE FOLLOWING 2 LINES WERE FIXED JULY 1989
C  FOLLOWING BLOCK UPDATED NOVEMBER 1991 (FOR EASE OF UPDATING)
CCCCC APRIL 1996.  IN FOLLOWING:
CCCCC              1) PC, VAX USE UPPERCASE ONLY FOR FILE NAMES.
CCCCC                 GO DIRECTLY TO "1160" BLOCK, COMMENT OUT THEIR
CCCCC                 SECTIONS HERE.
CCCCC              2) SOFT-CODE BACKSLASH, THIS IS SIMPLY TO AVOID
CCCCC                 UNIX COMPILATION ERRORS (\ IS AN ESCAPE CHARACTER
CCCCC                 IN UNIX.
CCCCC              3) EXTEND SUB-DIRECTORY SEARCH FOR UNIX.  ALSO, ADD
CCCCC                 AN ADDITIONAL SECTION FOR FINDING THE FILE IN
CCCCC                 THE MASTER DIRECTORY.  THIS WILL ALLOW SAME CODE
CCCCC                 TO WORK REGARDLESS OF WHETHER THE FILES ARE
CCCCC                 ALL STORED IN A SINGLE DIRECTORY OR STORED IN
CCCCC                 SUBDIRECTORIES.
CCCCC IF(IHOST1.EQ.'VAX')THEN
      IF(IOPPLO)THEN
        ICURST='CLOSED'
        IERRFI='YES'
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IHOST1.EQ.'VAX')GOTO1160
      IF(IHOST1.EQ.'IBM-')GOTO1160
      IF(IOPSY1.NE.'UNIX')GOTO1160
CCCCC APRIL 1996. UNIX IS ONLY CURRENTLY SUPPORTED OPERATING SYSTEM
CCCCC THAT IS CASE SENSITIVE
CCCCC   IFILE2(11:80)=IFILE(1:70)
CCCCC   IFILE2(1:10)='DATAPLO$:'
CCCCC ELSE IF (IOPSY1.EQ.'UNIX') THEN
      IF (IOPSY1.EQ.'UNIX') THEN
CCCCC   IFILE2(25:80)=IFILE(1:56)
CCCCC   IFILE2(1:24)='/usr/local/lib/dataplot/'
        IFILE2(1:IUNXNC)=UNIXPN(1:IUNXNC)
        NC1=IUNXNC+1
        NC2=80
        NC3=1
        NC4=80-IUNXNC
        DO1141K=1,7
           IF(K.EQ.1)THEN
              IFILE2(NC1:NC2)=IFILE(1:NC4)
           ELSE IF(K.EQ.2)THEN
              NC5=NC1
              NC6=NC5+4
              IFILE2(NC5:NC6)='help/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILE(NC3:NC8)
           ELSE IF(K.EQ.3)THEN
              NC5=NC1
              NC6=NC5+4
              IFILE2(NC5:NC6)='data/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILE(NC3:NC8)
           ELSE IF(K.EQ.4)THEN
              NC5=NC1
              NC6=NC5+3
              IFILE2(NC5:NC6)='dex/'
              NC7=NC6
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILE(NC3:NC8)
           ELSE IF(K.EQ.5)THEN
              NC5=NC1
              NC6=NC5+6
              IFILE2(NC5:NC6)='macros/'
              NC7=NC6
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILE(NC3:NC8)
           ELSE IF(K.EQ.6)THEN
              NC5=NC1
              NC6=NC5+8
              IFILE2(NC5:NC6)='programs/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILE(NC3:NC8)
           ELSE IF(K.EQ.7)THEN
              NC5=NC1
              NC6=NC5+4
              IFILE2(NC5:NC6)='text/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(18:80)=IFILE(1:63)
              IFILE2(NC7:NC2)=IFILE(NC3:NC8)
           END IF
           IOSTA2=0
           OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM,
     1          ACTION=IPROT,
     1          IOSTAT=IOSTA2)
           IOST3=IOSTA2
           IF(IOSTA2.NE.0)GOTO1141
           IFILE=IFILE2
           GOTO1190
 1141   CONTINUE
      ENDIF
CCCCC   ENDIF
CCCCC ELSE IF(IHOST1.EQ.'IBM-')THEN
CCCCC   IFILE2(13:80)=IFILE(1:68)
CUNIX   IFILE2(1:12)='C:\DATAPLOT\'
CCCCC ELSE
CCCCC   IFILE2(1:80)=IFILE(1:80)
CCCCC END IF
CCCCCD CHANGE
CCCCC IOSTA2=0
CCCCC OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM,
CCCCC1IOSTAT=IOSTA2)
CCCCC IOST1=IOSTA2
CCCCC IF(IOSTA2.NE.0)GOTO1150
CCCCC IFILE=IFILE2
CCCCC GOTO1190
C
 1150 CONTINUE
C     A NOTE TO THE IMPLEMENTOR--
C     THE NEXT 2 LINES MUST BE CHANGED TO REFLECT THE
C     ACTUAL NAME OF THE DIRECTORY WHERE DATAPLOT'S
C     REFERENCE/DATA/MAP/FRACTAL/MACRO/ETC. FILES RESIDE.
CCCCC THE FOLLOWING 2 LINES WERE FIXED JULY 1989
C  FOLLOWING BLOCK UPDATED NOVEMBER 1991 (FOR EASE OF UPDATING)
CCCCC IF(IHOST1.EQ.'VAX')THEN
CCCCC   IFILE2(11:80)=IFILEL(1:70)
CCCCC   IFILE2(1:10)='DATAPLO$:'
CCCCC ELSE IF(IOPSY1.EQ.'UNIX')THEN
CCCCC   IFILE2(25:80)=IFILEL(1:56)
CCCCC   IFILE2(1:24)='/usr/local/lib/dataplot/'
CCCCC ELSE IF(IHOST1.EQ.'IBM-')THEN
CCCCC   IFILE2(13:80)=IFILEL(1:68)
CUNIX   IFILE2(1:12)='C:\DATAPLOT\'
CCCCC ELSE
CCCCC   IFILE2(1:80)=IFILEL(1:80)
CCCCC END IF
C  END CHANGE
CCCCC IOSTA2=0
CCCCC OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM,
CCCCC1IOSTAT=IOSTA2)
CCCCC IOST2=IOSTA2
CCCCC IF(IOSTA2.NE.0)GOTO1160
CCCCC IFILE=IFILE2
CCCCC GOTO1190
      IF (IOPSY1.EQ.'UNIX') THEN
        NC1=IUNXNC+1
        NC2=80
        NC3=1
        NC4=80-IUNXNC
        IFILE2(1:IUNXNC)=UNIXPN(1:IUNXNC)
        DO1151K=1,7
           IF(K.EQ.1)THEN
              IFILE2(NC1:NC2)=IFILEL(1:NC4)
           ELSE IF(K.EQ.2)THEN
              NC5=NC1
              NC6=NC5+4
              IFILE2(NC5:NC6)='help/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEL(NC3:NC8)
           ELSE IF(K.EQ.3)THEN
              NC5=NC1
              NC6=NC5+4
              IFILE2(NC5:NC6)='data/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEL(NC3:NC8)
           ELSE IF(K.EQ.4)THEN
              NC5=NC1
              NC6=NC5+3
              IFILE2(NC5:NC6)='dex/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEL(NC3:NC8)
           ELSE IF(K.EQ.5)THEN
              NC5=NC1
              NC6=NC5+6
              IFILE2(NC5:NC6)='macros/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEL(NC3:NC8)
           ELSE IF(K.EQ.6)THEN
              NC5=NC1
              NC6=NC5+8
              IFILE2(NC5:NC6)='programs/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEL(NC3:NC8)
           ELSE IF(K.EQ.7)THEN
              NC5=NC1
              NC6=NC5+4
              IFILE2(NC5:NC6)='text/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(18:80)=IFILEL(1:63)
              IFILE2(NC7:NC2)=IFILEL(NC3:NC8)
           END IF
           IOSTA2=0
           OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM,
     1          ACTION=IPROT,
     1          IOSTAT=IOSTA2)
           IOST3=IOSTA2
           IF(IOSTA2.NE.0)GOTO1151
           IFILE=IFILE2
           GOTO1190
 1151   CONTINUE
      ENDIF
C
 1160 CONTINUE
C     A NOTE TO THE IMPLEMENTOR--
C     THE NEXT 2 LINES MUST BE CHANGED TO REFLECT THE
C     ACTUAL NAME OF THE DIRECTORY WHERE DATAPLOT'S
C     REFERENCE/DATA/MAP/FRACTAL/MACRO/ETC. FILES RESIDE.
CCCCC THE FOLLOWING 2 LINES WERE FIXED JULY 1989
C  FOLLOWING BLOCK UPDATED NOVEMBER 1991 (FOR EASE OF UPDATING)
      IF(IHOST1.EQ.'VAX')THEN
        IFILE2(11:80)=IFILEU(1:70)
        IFILE2(1:10)='DATAPLO$:'
      ELSE IF(IOPSY1.EQ.'UNIX')THEN
CCCCC   IFILE2(25:80)=IFILEU(1:56)
CCCCC   IFILE2(1:24)='/usr/local/lib/dataplot/'
        NC1=IUNXNC+1
        NC2=80
        NC3=1
        NC4=80-IUNXNC
        IFILE2(1:IUNXNC)=UNIXPN(1:IUNXNC)
        DO1181K=1,7
           IF(K.EQ.1)THEN
              IFILE2(NC1:NC2)=IFILEU(1:NC4)
           ELSE IF(K.EQ.2)THEN
              NC5=NC1
              NC6=NC5+4
              IFILE2(NC5:NC6)='help/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
           ELSE IF(K.EQ.3)THEN
              NC5=NC1
              NC6=NC5+4
              IFILE2(NC5:NC6)='data/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
           ELSE IF(K.EQ.4)THEN
              NC5=NC1
              NC6=NC5+3
              IFILE2(NC5:NC6)='dex/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
           ELSE IF(K.EQ.5)THEN
              NC5=NC1
              NC6=NC5+6
              IFILE2(NC5:NC6)='macros/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
           ELSE IF(K.EQ.6)THEN
              NC5=NC1
              NC6=NC5+8
              IFILE2(NC5:NC6)='programs/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
           ELSE IF(K.EQ.7)THEN
              NC5=NC1
              NC6=NC5+4
              IFILE2(NC5:NC6)='text/'
              NC7=NC6+1
              NC8=80-NC6
              IFILE2(18:80)=IFILEU(1:63)
              IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
           END IF
           IOSTA2=0
           OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM,
     1          ACTION=IPROT,
     1          IOSTAT=IOSTA2)
           IOST3=IOSTA2
           IF(IOSTA2.NE.0)GOTO1181
           IFILE=IFILE2
           GOTO1190
 1181   CONTINUE
CCCCC THE FOLLOWING IBM SECTION (32 LINES) WAS CHANGED    JUNE 1995
CCCCC TO ALLOW FOR SUBDIRECTORIES UNDER                   JUNE 1995
CCCCC THE DATAPLOT DIRECTORY                              JUNE 1995
CCCCC SOFT-CODE "\"                                       APRIL 1996
      ELSE IF(IHOST1.EQ.'IBM-')THEN
        NC1=NCPATH+1
        NC2=80
        NC3=1
        NC4=80-NCPATH
CCCCC   IFILE2(1:12)='C:\DATAPLOT\'
CCCCC   IFILE2(1:12)='C: DATAPLOT '
CCCCC   IFILE2(3:3)=IBSLC
CCCCC   IFILE2(12:12)=IBSLC
        IFILE2(1:NCPATH)=PATH(1:NCPATH)
        DO1161K=1,7
         IF(K.EQ.1)THEN
CCCCC       IFILE2(13:80)=IFILEU(1:68)
            IFILE2(NC1:NC2)=IFILEU(1:NC4)
         ELSE IF(K.EQ.2)THEN
CCCCC       IFILE2(13:17)='HELP\'
CCCCC       IFILE2(13:17)='HELP '
CCCCC       IFILE2(17:17)=IBSLC
CCCCC       IFILE2(18:80)=IFILEU(1:63)
            NC5=NC1
            NC6=NC5+4
            IFILE2(NC5:NC6)='HELP '
            IFILE2(NC6:NC6)=IBSLC
            NC7=NC6+1
            NC8=80-NC6
            IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
         ELSE IF(K.EQ.3)THEN
CCCCC       IFILE2(13:17)='DATA\'
CCCCC       IFILE2(13:17)='DATA '
CCCCC       IFILE2(17:17)=IBSLC
CCCCC       IFILE2(18:80)=IFILEU(1:63)
            NC5=NC1
            NC6=NC5+4
            IFILE2(NC5:NC6)='DATA '
            IFILE2(NC6:NC6)=IBSLC
            NC7=NC6+1
            NC8=80-NC6
            IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
         ELSE IF(K.EQ.4)THEN
CCCCC       IFILE2(13:16)='DEX\'
CCCCC       IFILE2(13:16)='DEX '
CCCCC       IFILE2(16:16)=IBSLC
CCCCC       IFILE2(17:80)=IFILEU(1:64)
            NC5=NC1
            NC6=NC5+3
            IFILE2(NC5:NC6)='DEX  '
            IFILE2(NC6:NC6)=IBSLC
            NC7=NC6+1
            NC8=80-NC6
            IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
         ELSE IF(K.EQ.5)THEN
CCCCC       IFILE2(13:19)='MACROS\'
CCCCC       IFILE2(13:19)='MACROS '
CCCCC       IFILE2(19:19)=IBSLC
CCCCC       IFILE2(20:80)=IFILEU(1:61)
            NC5=NC1
            NC6=NC5+6
            IFILE2(NC5:NC6)='MACROS '
            IFILE2(NC6:NC6)=IBSLC
            NC7=NC6+1
            NC8=80-NC6
            IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
         ELSE IF(K.EQ.6)THEN
CCCCC       IFILE2(13:21)='PROGRAMS\'
CCCCC       IFILE2(13:21)='PROGRAMS '
CCCCC       IFILE2(21:21)=IBSLC
CCCCC       IFILE2(22:80)=IFILEU(1:59)
            NC5=NC1
            NC6=NC5+8
            IFILE2(NC5:NC6)='PROGRAMS '
            IFILE2(NC6:NC6)=IBSLC
            NC7=NC6+1
            NC8=80-NC6
            IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
         ELSE IF(K.EQ.7)THEN
CCCCC       IFILE2(13:17)='TEXT\'
CCCCC       IFILE2(13:17)='TEXT '
CCCCC       IFILE2(17:17)=IBSLC
CCCCC       IFILE2(18:80)=IFILEU(1:63)
            NC5=NC1
            NC6=NC5+4
            IFILE2(NC5:NC6)='TEXT '
            IFILE2(NC6:NC6)=IBSLC
            NC7=NC6+1
            NC8=80-NC6
            IFILE2(NC7:NC2)=IFILEU(NC3:NC8)
         END IF
         IOSTA2=0
         OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM,
     1          ACTION=IPROT,
     1          IOSTAT=IOSTA2)
         IOST3=IOSTA2
         IF(IOSTA2.NE.0)GOTO1161
         IFILE=IFILE2
         GOTO1190
 1161 CONTINUE
      ELSE
        IFILE2(1:80)=IFILEU(1:80)
      END IF
C  END CHANGE
      IOSTA2=0
      OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM,
     1          ACTION=IPROT,
     1          IOSTAT=IOSTA2)
      IOST3=IOSTA2
CCCCC IF(IOSTA2.NE.0)GOTO8000
      IF(IOSTA2.NE.0)GOTO1170
      IFILE=IFILE2
      GOTO1190
C
C  MAY, 1990.  CHECK IF FILE ENDS WITH PERIOD (OR THE FILE CHARACTER).  IF
C  SO, STRIP IT OFF AND REPEAT THE ABOVE SEQUENCE OF OPEN COMMANDS.
C
 1170 CONTINUE
      IFLAG=IFLAG+1
      IF(IFLAG.GT.1)GOTO8000
      FTEMP=IFILE
      DO1175I=80,1,-1
      IF(FTEMP(I:I).EQ.' ')GOTO1175
      IF(FTEMP(I:I).EQ.IFCHAR)FTEMP(I:I)=' '
      GOTO1179
 1175 CONTINUE
 1179 CONTINUE
      GOTO1110
C
 1190 CONTINUE
      ICURST='OPEN'
      IERRFI='NO'
      IERROR='NO'
      IF(IREWIN.EQ.'ON')REWIND IOUNIT
      GOTO9000
C
C-----TREAT THE VAX 11/7XX VMS CASE-----------------------------------
C     (NOTE--IF HAVE    READONLY   ARGUMENT,
C     THEN THE VAX WILL ONLY ALLOW    STATUS='OLD'   ;
C     STATUS = ANYTHING ELSE ('UNKNOWN' OR 'NEW')
C     WILL RESULT IN THE FILE NOT BEING OPENED
C     AND AN ERROR CONDITION RESULTING.)
C
 2100 CONTINUE
      IF(IPROT.EQ.'READONLY')GOTO2110
      GOTO2120
C
 2110 CONTINUE
      IOSTA2=0
CVAX  OPEN(UNIT=IOUNIT,FILE=IFILE,STATUS='OLD',FORM=IFORM,
CVAX 1IOSTAT=IOSTA2,ACCESS=IACCES,CARRIAGE CONTROL='LIST',READONLY)
      IF(IOSTA2.EQ.0)GOTO2190
      IOSTA2=0
CCCCC THE FOLLOWING 2 LINES WERE FIXED JULY 1989
CVAX  IFILE2(10:80)=IFILE(1:70)
CVAX  IFILE2(1:9)='DATAPLO$:'
      IFILE2(10:80)=IFILE(1:71)
      IFILE2(1:9)='DATAPLO$:'
CVAX  OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS='OLD',FORM=IFORM,
CVAX 1IOSTAT=IOSTA2,ACCESS=IACCES,CARRIAGE CONTROL='LIST',READONLY)
      IF(IOSTA2.EQ.0)IFILE=IFILE2
      IF(IOSTA2.EQ.0)GOTO2190
      GOTO8000
C
 2120 CONTINUE
      IOSTA2=0
CVAX  OPEN(UNIT=IOUNIT,FILE=IFILE,STATUS=ISTAT,FORM=IFORM,
CVAX 1ERR=8000,ACCESS=IACCES,CARRIAGE CONTROL='LIST')
      GOTO2190
C
 2190 CONTINUE
      ICURST='OPEN'
      IERRFI='NO'
      IERROR='NO'
      IF(IREWIN.EQ.'ON')REWIND IOUNIT
      GOTO9000
C
C-----TREAT THE CDC CASE------------------------------------------
C     REFERENCE--ALAN HECKERT, 2899
C
 2200 CONTINUE
      IOSTA2=0
C
C     FOR CDC, NOS AND NOS/VE, STRIP OFF THE TRAILING '.'
C     SINCE THIS CAUSES THE OPEN TO FAIL
C
      FTEMP=IFILE
      DO 2250 I=80,1,-1
      IF(FTEMP(I:I).EQ.' ')GOTO 2250
      IF(FTEMP(I:I).EQ.IFCHAR) FTEMP(I:I)=' '
      GOTO 2260
 2250 CONTINUE
 2260 CONTINUE
      IF(IOUNIT.EQ.IRD.AND.IHOST1.NE.'NVE')
     1OPEN(UNIT=IOUNIT,FILE='INPUT',STATUS='OLD')
      IF(IOUNIT.EQ.IPR.AND.IHOST1.NE.'NVE')
     1OPEN(UNIT=IOUNIT,FILE='OUTPUT',STATUS='OLD')
      IF(IOUNIT.EQ.IRD.AND.IHOST1.EQ.'NVE')
     1OPEN(UNIT=IOUNIT,FILE='$INPUT',STATUS='OLD')
      IF(IOUNIT.EQ.IPR.AND.IHOST1.EQ.'NVE')
     1OPEN(UNIT=IOUNIT,FILE='$OUTPUT',STATUS='OLD')
      IF(IOUNIT.NE.IRD.AND.IOUNIT.NE.IPR)
     1OPEN(UNIT=IOUNIT,FILE=FTEMP,STATUS=ISTAT,FORM=IFORM,
     1IOSTAT=IOSTA2)
C
C     JANUARY,1989: CHECK FOR REFERENCE FILES.  HANDLE FOR NOS/VE CASE AT
C     NBS.  NOTE THAT DATAPLOT IS INSTALLED AS A "SYSTEM APPLICATION" AT
C     NBS.  OTHER NOS/VE SITES MAY OR MAY NOT HAVE IT INSTALLED THIS WAY.
C
      IF(IOSTA2.EQ.0)GOTO2290
      IOSTA2=0
      IFILE2(42:80)=FTEMP(1:39)
      IFILE2(1:41)='.CS2.APPLICATIONS.DATAPLOT.VER_2.SAMPLES.'
      OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM,
     1IOSTAT=IOSTA2)
      IF(IOSTA2.NE.0)GOTO8000
 2290 CONTINUE
      ICURST='OPEN'
      IERRFI='NO'
      IERROR='NO'
      IF(IREWIN.EQ.'ON')REWIND IOUNIT
      GOTO9000
C
C-----TREAT THE PERKIN-ELMER CASE-----------------------------------
C     REFERENCE--LARRY KAETZEL, 2650
C
C2300 CONTINUE
CCCCC IOSTA2=0
CCCCC OPEN(UNIT=IOUNIT,FILE=IFILE,STATUS=ISTAT,FORM=IFORM,
CCCCC1IOSTAT=IOSTA2,RECL=132,SIZE=8)
CCCCC IF(IOSTA2.NE.0)GOTO8000
CCCCC ICURST='OPEN'
CCCCC IERRFI='NO'
CCCCC IERROR='NO'
CCCCC IF(IREWIN.EQ.'ON')REWIND IOUNIT
CCCCC GOTO9000
C
C-----TREAT THE HONEYWELL-MULTICS CASE-----------------------------------
C2400 CONTINUE
CCCCC IOSTA2=0
CCCCC IF(IPROT.EQ.'READONLY')
CCCCC1OPEN(UNIT=IOUNIT,FILE=IFILE,STATUS='OLD',FORM=IFORM,
CCCCC1IOSTAT=IOSTA2,ACCESS=IACCES,MODE='INPUT')
CCCCC IF(IOSTA2.NE.0)GOTO8000
CCCCC
CCCCC IF(IPROT.NE.'READONLY')
CCCCC1OPEN(UNIT=IOUNIT,FILE=IFILE,STATUS=ISTAT,FORM=IFORM,
CCCCC1ERR=8000,ACCESS=IACCES)
CCCCC
CCCCC ICURST='OPEN'
CCCCC IERRFI='NO'
CCCCC IERROR='NO'
CCCCC IF(IREWIN.EQ.'ON')REWIND IOUNIT
CCCCC GOTO9000
C
C               ************************************
C               **  STEP 80--                     **
C               **  GENERATE AN ERROR MESSAGE     **
C               **  IF THE FILE CANNOT BE OPENED  **
C               ************************************
C
 8000 CONTINUE
      IERRFI='YES'
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('***** ERROR IN DPOPFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)
 8012 FORMAT('      ERROR IN ATTEMPTING TO OPEN A FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8021)IOUNIT
 8021 FORMAT('I/O UNIT    = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8022)IFILE
 8022 FORMAT('FILE NAME   = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8023)ISTAT
 8023 FORMAT('FILE STATUS = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8024)IFORM
 8024 FORMAT('FILE FORMAT = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8025)IACCES
 8025 FORMAT('FILE ACCESS = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8026)IPROT
 8026 FORMAT('FILE PROTECTION         = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8027)ICURST
 8027 FORMAT('FILE CURRENT STATUS     = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8028)ISUBN0
 8028 FORMAT('PREVIOUS (= CALLING) SUBROUTINE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8029)IERRFI
 8029 FORMAT('FILE-FINDING ERROR FLAG = ',A4)
      CALL DPWRST('XXX','BUG ')
      IF(IHOST1.EQ.'VAX')WRITE(ICOUT,8030)IOSTA2
 8030 FORMAT('IOSTAT FLAG             = ',I8)
      IF(IHOST1.EQ.'VAX')CALL DPWRST('XXX','BUG ')
      IF(IHOST1.NE.'VAX')WRITE(ICOUT,8031)IOST1,IOST2,IOST3
 8031 FORMAT('IOSTAT FLAGS            = ',3I8)
      IF(IHOST1.NE.'VAX')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8032)IHOST1
 8032 FORMAT('HOST COMPUTER           = ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'OPFI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOPFI--')
      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)IREWIN
 9028 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)ISUBN0
 9029 FORMAT('ISUBN0 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)IERRFI
 9030 FORMAT('IERRFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IOSTA2
 9031 FORMAT('IOSTAT FLAG             = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IHOST1
 9032 FORMAT('IHOST1 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)IFILEL
 9041 FORMAT('IFILEL  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IFILEU
 9042 FORMAT('IFILEU  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IFILE2
 9043 FORMAT('IFILE2  = ',A80)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKCLAR(ITEMNU,ITEMNA,ITEMST,ITEMFO,
     1ITEMAC,ITEMPR,ITEMCS,ITEMEF,ITEMRW,
     1NUMCLA,CLARG1,CLARG2,ISUBN0,IBUGS2,ISUBRO,IERRFI)
C
C     PURPOSE--CHECK THE COMMAND LINE (IN DOS) TO INVOKE DATAPLOT,
C              DETERMINE IF THE COMMAND LINE HAS ATTACHED ARGUMENTS,
C              AND RECORD SUCH ARGUMENTS.
C     ORIGINAL VERSION--FEBRUARY 1992
C     UPDATED         --APRIL    1992  ADD OPERATING SYSTEM SPECIFIC
C                                      SUPPORT (ALAN)
C     UPDATED         --MAY      2001  COMMAND LINE ARGUMENT FOR
C                                      MICROSOFT FORTRAN.  NOTE
C                                      THIS ACTUALLY DONE IN 
C                                      "MSFORT.F", THIS ROUTINE JUST
C                                      EXTRACTS FROM A COMMON BLOCK.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*80 ITEMNA
      CHARACTER*12 ITEMST
      CHARACTER*12 ITEMFO
      CHARACTER*12 ITEMAC
      CHARACTER*12 ITEMPR
      CHARACTER*12 ITEMCS
      CHARACTER*4 ITEMEF
      CHARACTER*4 ITEMRW
C
      CHARACTER*80 CLARG1
      CHARACTER*4 CLARG2
C  ADD FOLLOWING LINE APRIL 1992.  (FOR NOS/VE CASE)
      CHARACTER*80 ITEMP
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERRFI
C
      CHARACTER*4 IERROR
C
      CHARACTER*4 IEXIST
C
C-----COMMON VARIABLES (GENERAL)-----------------------------------------------
C  APRIL 1992.  ADD FOLLOWING INCLUDE FILE
      INCLUDE 'DPCOHO.INC'
C  APRIL 1992.  ADD FOLLOWING FOR UNIX
      INTEGER iargc
C  APRIL 1992.  ADD FOLLOWING FOR CRAY UNICOS
CCRAY INTEGER GETOARG
C  APRIL 1992.  ADD FOLLOWING FOR VAX
CVAX  INTEGER*2 NCTEMP
C
      CHARACTER*4 IECHO
      CHARACTER*80 FTEMP
      COMMON/QUICKW2/IECHO,FTEMP
      COMMON/QUICKW3/NCFTMP
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C
C               ********************************
C               **  STEP 1--                  **
C               **  STEP THROUGH EACH HOST    **
C               ********************************
C
C  INSTALLERS NOTE:  FOR THOSE OPERATING SYSTEMS THAT SUPPORT
C  A LIBRARY ROUTINE FOR EXTRACTING ARGUMENTS FROM THE COMMAND
C  LINE, PUT IN A BRANCH AND USE THAT MECHANISM.  FOR THOSE THAT
C  DON'T, READ THE ARGUMENTS FROM THE FILE "DPARGS.DAT".
C
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO1600
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG')GOTO1000
      IF(IHOST1.EQ.'NVE')GOTO2000
      IF(IHOST1.EQ.'CRAY')GOTO4000
      IF(IOPSY1.EQ.'UNIX')GOTO3000
      IF(IHOST1.EQ.'VAX')GOTO5000
      GOTO1000
C
C               ********************************
C               **  STEP 2A--                 **
C               **  IBM/PC 386 WITH OTG COMPILER
C               **  ALSO FOR HOSTS WITH NO    **
C               **  SPECIFIC MECHANISM FOR    **
C               **  CAPTURING COMMAND LINE    **
C               **  ARGUMENTS                 **
C               ********************************
C
 1000 CONTINUE
      NUMCLA=0
      NC1=0
      CLARG2(1:1)=' '
C  APRIL 1992.  CHECK FOR OPERATING HOST.  READ FROM FILE DPARGS.DAT
C  IF NO OPERATING SPECIFIC MECHANISM SUPPORTED.
C
 
C
C     STEP 1--
C     INQUIRE TO SEE IF THE FILE EXISTS
C
      CALL DPINFI(ITEMNA,IEXIST,ISUBN0,IBUGS2,ISUBRO,IERRFI)
      IF(IEXIST.EQ.'YES')GOTO1100
      GOTO9000
C
C     STEP 2--
C     IF EXISTS, THEN OPEN THE FILE
C     AND READ THE FIRST (ONLY) LINE FROM THE FILE INTO CLARG1
C
 1100 CONTINUE
      CALL DPOPFI(ITEMNU,ITEMNA,ITEMST,ITEMFO,ITEMAC,ITEMPR,ITEMCS,
     1ITEMRW,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
      READ(ITEMNU,1120)CLARG1
 1120 FORMAT(A80)
C
C     STEP 3--
C     CLOSE THE FILE
C
      CALL DPCLFI(ITEMNU,ITEMNA,ITEMST,ITEMFO,ITEMAC,ITEMPR,ITEMCS,
     1ITEMEF,ITEMRW,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C     STEP 4--
C     EXTRACT THE (1 OR 2) ARGUMENTS FROM THE FILE
C
      IF(CLARG1(1:4).EQ.'    ')GOTO9000
      IF(CLARG1(1:4).EQ.'ECHO')GOTO9000
C
      NCALL=80
      DO1130I=1,NCALL
      I2=I
      IF(CLARG1(I:I).EQ.' ')GOTO1135
 1130 CONTINUE
      NC1=NCALL
      GOTO1139
 1135 CONTINUE
      NC1=I2-1
 1139 CONTINUE
C
      IF(NC1.GE.NCALL-1)GOTO1141
      IF(NC1.LE.0)GOTO1142
      IF(CLARG1(NC1+2:NC1+2).EQ.' ')GOTO1143
      GOTO1144
C
 1141 CONTINUE
      NUMCLA=1
      GOTO9000
 1142 CONTINUE
      NUMCLA=0
      GOTO9000
 1143 CONTINUE
      NUMCLA=1
      GOTO9000
 1144 CONTINUE
      CLARG2(1:1)=CLARG1(NC1+2:NC1+2)
      NUMCLA=2
      DO1145I=NC1+1,NCALL
      CLARG1(I:I)=' '
 1145 CONTINUE
      GOTO9000
C
C               ********************************
C               **  STEP 2A1-                 **
C               **  IBM/PC USING MICROSOFT    **
C               **  COMPILER.  THE MSFORT.F   **
C               **  ROUTINE ACTUALLY DOES THE **
C               **  EXTRACTION, SIMPLY GET OUT**
C               **  OF COMMON HERE.           **
C               ********************************
C
 1600 CONTINUE
      NUMCLA=0
      CLARG1=' '
      NC1=0
      NC2=0
      CLARG2=' '
      IF(NCFTMP.GT.0)THEN
        NUMCLA=NUMCLA+1
        CLARG1(1:NCFTMP)=FTEMP(1:NCFTMP)
        NC1=NCFTMP
      ENDIF
      IF(IECHO(1:4).EQ.'ECHO')THEN
        NUMCLA=NUMCLA+1
        IF(NUMCLA.EQ.1)CLARG1(1:4)='ECHO'
        IF(NUMCLA.EQ.2)CLARG2(1:4)='ECHO'
        NC1=4
      ENDIF
      GOTO9000
C
C               ********************************
C               **  STEP 2B--                 **
C               **  CYBER WITH NOS/VE         **
C               **  USE PARAM FUNCTION.  NOTE **
C               **  THAT PARAMETER MUST BE    **
C               **  NAMED (USE F FOR FILE AND **
C               **  B FOR BANNER OPTION.      **
C               **  NOTE THAT A C$   PARAM    **
C               **  STATEMENT APPEARS IN THE  **
C               **  MAIN PROGRAM (THIS IS     **
C               **  REQUIRED).                **
C               ********************************
C
 2000 CONTINUE
      NUMCLA=0
CNVE  IF(TSTPARM('F')) THEN
CNVE    CALL GETCVAL('F',1,1,,'LOW',NC1,CLARG1)
CNVE    IF(CLARG1(1:4).EQ.'    ')GOTO9000
CNVE    IF(CLARG1(1:4).EQ.'ECHO')GOTO9000
CNVE    NUMCLA=1
CNVE  ENDIF
CNVE  IF(TSTPARM('B')) THEN
CNVE    CALL GETCVAL('B',1,1,'LOW',NC2,ITEMP)
CNVE    CLARG2(1:1)=ITEMP(1:1)
CNVE    NUMCLA=2
CNVE  ENDIF
      GOTO9000
C
C               ********************************
C               **  STEP 2C--                 **
C               **  UNIX OPERATING SYSTEM     **
C               **  USE argv AND iargc CALLS. **
C               **  MAY NEED TO CHECK THAT THESE
C               **  ARE VALID ON YOUR UNIX    **
C               **  SYSTEM.                   **
C               ********************************
C
 3000 CONTINUE
      NUMCLA=0
CUNIX NUMCLA=iargc()
CUNIX IF(NUMCLA.GE.1)THEN
CUNIX   IJUNK=1
CUNIX   CALL getarg(IJUNK,CLARG1)
CUNIX   IF(CLARG1(1:4).EQ.'    ')GOTO9000
CUNIX   IF(CLARG1(1:4).EQ.'ECHO')GOTO9000
CUNIX   CALL STRLEN(CLARG1,NC1)
CUNIX ENDIF
CUNIX IF(NUMCLA.GE.2)THEN
CUNIX   IJUNK=2
CUNIX   CALL getarg(IJUNK,ITEMP)
CUNIX   CLARG2(1:1)=ITEMP(1:1)
CUNIX ENDIF
      GOTO9000
C
C               ********************************
C               **  STEP 2C.1--               **
C               **  CRAY UNIX USES A DIFFERENT**
C               **  USE GETOARG CALL.         **
C               ********************************
C
 4000 CONTINUE
      NUMCLA=0
CCRAY IRET=GETOARG(CLARG1)
CCRAY IF(IRET.EQ.0)THEN
CCRAY   CLARG1=' '
CCRAY   GOTO9000
CCRAY ELSE
CCRAY   IF(CLARG1(1:4).EQ.'    ')GOTO9000
CCRAY   IF(CLARG1(1:4).EQ.'ECHO')GOTO9000
CCRAY   CALL STRLEN(CLARG1,NC1)
CCRAY   NUMCLA=1
CCRAY ENDIF
CCRAY IRET=GETOARG(ITEMP)
CCRAY IF(IRET.EQ.0)THEN
CCRAY   CLARG2(1:1)=' '
CCRAY ELSE
CCRAY   CLARG2(1:1)=ITEMP(1:1)
CCRAY   NUMCLA=2
CCRAY ENDIF
      GOTO9000
C
C               ********************************
C               **  STEP 2D--                 **
C               **  VAX/VMS                   **
C               **  USE CLI$PRESENT AND       **
C               **  CLI$GET_VALUE LIBRARY CALLS*
C               **  DEFAULT PARAMETER NAMES ARE*
C               **  P1 AND P2.                **
C               ********************************
C  IMPLEMENTORS NOTE.  THIS CODE HAS NOT BEEN TESTED!!!
C  IT LOOKS RIGHT ACCORDING TO VAX FORTRAN MANUAL, BUT IT
C  MAY NEED TO BE DEBUGGED.  ALSO, UNCOMMENT "INTEGER*2 NCTEMP"
C  LINE IN DECLARATION.
C
 5000 CONTINUE
      NUMCLA=0
CVAX  IF(CLI$PRESENT('P1'))THEN
CVAX    ISTATUS=CLI$GET_VALUE('P1',CLARG1,NCTEMP)
CVAX    IF(CLARG1(1:4).EQ.'    ')GOTO9000
CVAX    IF(CLARG1(1:4).EQ.'ECHO')GOTO9000
CVAX    NC1=NCTEMP
CVAX    NUMCLA=1
CVAX  ENDIF
CVAX  IF(CLI$PRESENT('P2'))THEN
CVAX    ISTATUS=CLI$GET_VALUE('P1',ITEMP,NCTEMP)
CVAX    CLARG2(1:1)=ITEMP(1:1)
CVAX    NUMCLA=2
CVAX  ENDIF
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'CLAR')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF SUBROUTINE CKCLAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IEXIST
 9012 FORMAT('IEXIST = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMCLA,NC1
 9013 FORMAT('NUMCLA,NC1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)CLARG1
 9014 FORMAT('CLARG1 = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)CLARG2
 9015 FORMAT('CLARG2 = ',A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSYST(IANS,IANSLC,IWIDTH,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--ENTER AN OPERATING SYSTEM COMMAND.  NOTE THAT THIS COMMAND
C              IS SITE AND HOST DEPENDENT.  IT IS PROVIODED TO ACCOMODATE
C              THOSE OPERATING SYSTEMS THAT ALLOW HOOKS INTO THE OPERATING
C              SYSTEM.  IT IS LEFT UP TO THE LOCAL IMPLEMENTOR AS TO HOW
C              THIS COMMAND WILL BE USED.
C
C              THE CALL TO THE OPERATING SYSTEM IS DONE BELOW IN
C                    CALL SCLCMD
C              IF YOUR COMPUTER DOES NOT ALLOW SUCH A HOOK, DO NOTHING.
C              IF YOUR COMPUTER DOES ALLOW SUCH A HOOK, THEN THE
C              IMPLEMENTER SHOULD REPLACE THE CALL TO SCLCMD
C              (WHICH IS APPROPRIATE ONLY FOR CDC CYBER NOS/VE)
C              WITH THE APPROPRIATE SYSTEM CALL;
C              THE LINE SHOULD ALSO BE UN-COMMENTED OUT.
C
C              NOTE THAT IF A COMMAND IS PASSED TO THE OPERATING SYSTEM,
C              DATAPLOT WILL DO NO ERROR CHECKING.  IT WILL SIMPLY PASS
C              THE COMMAND AS GIVEN.
C
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C               HOST DEPENDENT
C     VERSION NUMBER--89.3
C     ORIGINAL VERSION--FEBRUARY   1989.
C     UPDATED         --MARCH      1990.  USE "IANSLC" SINCE SOME SYSTEMS
C                                         ARE CASE SENSITIVE (E.G., UNIX)
C     UPDATED         --APRIL      1992.  DO OPERATING SPECIFIC CALL IN DPSYS2
C     UPDATED         --APRIL      1992.  ADD ISUBRO IN CALL TO DPSYS2
C     UPDATED         --APRIL      1992.  ADD UNIX & DOS
C     UPDATED         --APRIL      1992.  ADD OTG CHECK
C     UPDATED         --APRIL      1992.  AUGMENT ERROR INFO
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 IANSLC
C
      CHARACTER*4 ITEXTE
      CHARACTER*4 ITEXTF
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
C
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IFUNC
      CHARACTER*4 IREPCH
C
      DIMENSION IANS(*)
      DIMENSION IANSLC(*)
C
      PARAMETER(MAXCH=256)
      DIMENSION ITEXTE(MAXCH)
      DIMENSION ITEXTF(MAXCH)
      CHARACTER*256 ITEXT2
      CHARACTER*256 ITEXT3
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IFUNC(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.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
C
      IFOUND='NO'
      IERROR='NO'
C
      J2=0
C
      IF(IBUGD2.EQ.'OFF'.AND.ISUBRO.NE.'SYST')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSYST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH= ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IANS(I),I=1,IWIDTH)
   54 FORMAT('(IANS(I),I=1,IWIDTH) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)NUMNAM
   75 FORMAT('NUMNAM= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO76I=1,NUMNAM
      WRITE(ICOUT,77)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
   77 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)= ',
     1I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   76 CONTINUE
      WRITE(ICOUT,81)IBUGD2,ISUBRO
   81 FORMAT('IBUGD2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)IFOUND,IERROR
   82 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************************************
C               **  STEP 1--                                       **
C               **  EXTRACT THE TEXT STRING FROM THE COMMAND LINE  **
C               *****************************************************
C
C               *****************************************
C               **  STEP 1.1--                         **
C               **  DETERMINE THE COMMAND              **
C               **  (SYSTEM OR SYST) AND ITS LOCATION  **
C               **  ON THE LINE.                       **
C               **  DETERMINE THE START POSITION       **
C               **  (XSTART) OF THE FIRST CHARACTER    **
C               **  FOR THE STRING TO BE PRINTED.      **
C               *****************************************
C
C  CHECK FOR "SYSTEM" FIRST
C
      DO1115I=1,IWIDTH
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
C
      IF(IP6.GT.IWIDTH)GOTO1115
      ISTART=IP6+1
      IF(IANS(I).EQ.'S'.AND.IANS(IP1).EQ.'Y'.AND.
     1IANS(IP2).EQ.'S'.AND.IANS(IP3).EQ.'T'.AND.
     1IANS(IP4).EQ.'E'.AND.IANS(IP5).EQ.'M'.AND.
     1IANS(IP6).EQ.' ')GOTO1190
 1115 CONTINUE
C
C  CHECK FOR "SYST"
C
 1120 CONTINUE
      DO1125I=1,IWIDTH
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
C
      IF(IP4.GT.IWIDTH)GOTO1125
      ISTART=IP5
      IF(IANS(I).EQ.'S'.AND.IANS(IP1).EQ.'Y'.AND.
     1IANS(IP2).EQ.'S'.AND.IANS(IP3).EQ.'T'.AND.
     1IANS(IP4).EQ.' ')GOTO1190
 1125 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED   APRIL 1992
C  CHECK FOR "UNIX"
C
 1130 CONTINUE
      DO1135I=1,IWIDTH
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
C
      IF(IP4.GT.IWIDTH)GOTO1135
      ISTART=IP5
      IF(IANS(I).EQ.'U'.AND.IANS(IP1).EQ.'N'.AND.
     1IANS(IP2).EQ.'I'.AND.IANS(IP3).EQ.'X'.AND.
     1IANS(IP4).EQ.' ')GOTO1190
 1135 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED   APRIL 1992
C  CHECK FOR "DOS"
C
 1140 CONTINUE
      DO1145I=1,IWIDTH
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
C
      IF(IP3.GT.IWIDTH)GOTO1145
      ISTART=IP4
      IF(IANS(I).EQ.'D'.AND.IANS(IP1).EQ.'O'.AND.
     1IANS(IP2).EQ.'S'.AND.IANS(IP3).EQ.' ')GOTO1190
 1145 CONTINUE
C
C  NO MATCH
C
 1180 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('***** ERROR IN DPSYST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('      COMMAND NOT EQUAL ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('      SYSTEM, SYST, UNIX, OR DOS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1190 CONTINUE
C
C               **********************************************************
C               **  STEP 1.2--                                          **
C               **  DEFINE THE STOP  POSITION (ISTOP) FOR THE STRING.   **
C               **********************************************************
C
      IFOUND='YES'
C
      ISTOP=0
      IF(ISTART.GT.IWIDTH)GOTO1229
      DO1220I=ISTART,IWIDTH
      IREV=IWIDTH-I+ISTART
      IF(IANS(IREV).NE.' ')GOTO1225
 1220 CONTINUE
      GOTO1229
 1225 CONTINUE
      ISTOP=IREV
 1229 CONTINUE
C
C               *****************************************
C               **  STEP 1.3--                         **
C               **  COPY OVER THE STRING OF INTEREST.  **
C               *****************************************
C
      IF(ISTART.GT.ISTOP)GOTO1380
      IF(ISTOP.EQ.0)GOTO1380
      ITEMP=ISTOP-ISTART+1
      IF(ITEMP.GT.MAXCH)ITEMP=MAXCH
      ISTOP=ISTART+ITEMP-1
C
      J=0
      DO1310I=ISTART,ISTOP
      J=J+1
      J2=J
      ITEXTE(J)=IANS(I)
      ITEXTF(J)=IANSLC(I)
 1310 CONTINUE
      NCTEX=J2
      GOTO1390
 1380 CONTINUE
      NCTEX=0
 1390 CONTINUE
C
C               ******************************************************
C               **  STEP 1.4--                                    **
C               **  CALL THE SUBROUTINE DPREPL                      **
C               **  WHICH WILL SCAN THE STRING FOR ALL OCCURRANCES  **
C               **  OF THE SUBSTRING VALU()                         **
C               **  AND REPLACE THEM BY THEIR LITERAL VALUES.       **
C               ******************************************************
C
      NCTEXT=NCTEX
      IF(NCTEXT.GE.1)CALL DPREPL(ITEXTE,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGD2,IERROR)
      IF(NCTEXT.LT.1)GOTO1590
      DO1510I=1,NCTEXT
      ITEXT2(I:I)=ITEXTE(I)(1:1)
 1510 CONTINUE
 1590 CONTINUE
C
      NCTEXT=NCTEX
      IF(NCTEXT.GE.1)CALL DPREPL(ITEXTF,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGD2,IERROR)
      IF(NCTEXT.LT.1)GOTO1690
      DO1610I=1,NCTEXT
      ITEXT3(I:I)=ITEXTF(I)(1:1)
 1610 CONTINUE
 1690 CONTINUE
C
C               ********************************
C               **  STEP 2--                  **
C               **  STEP THROUGH EACH HOST    **
C               ********************************
C
      IF(IHOST1.EQ.'NVE')GOTO2100
      IF(IHOST1.EQ.'VAX')GOTO2200
      IF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'OS38')GOTO2400
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO2400
CCCCC THE FOLLOWING LINE WAS ADDED   JUNE 1996
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')GOTO2400
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO2400
      IF(IOPSY1.EQ.'UNIX')GOTO2300
      GOTO8000
C
C     *********************************************************
C     *  CDC - NOS/VE OPERATING SYSTEM.  USE "SCLCMD" TO PASS *
C     *  COMMANDS TO THE OPERATING SYSTEM.                    *
C     *  DATAPLOT WILL DO NO ERROR CHECKING ON THE COMMAND    *
C     *********************************************************
C
 2100 CONTINUE
      CALL DPSYS2(ITEXT2,NCTEXT,ISUBRO,IERROR)
      GOTO9000
C
C     *********************************************************
C     *  VAX/VMS - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
 2200 CONTINUE
      CALL DPSYS2(ITEXT2,NCTEXT,ISUBRO,IERROR)
      GOTO9000
C
C     *********************************************************
C     *  UNIX    - LEFT TO IMPLEMENTOR                        *
C     *  CODE ADDED MARCH, 1990 BY ALAN HECKERT.  USE THE     *
C     *  LIBRARY ROUTINE "system".  NOTE THAT UNIX CALLS ARE  *
C     *  CASE SENSITIVE, SO LEAVE CODE IN LOWER CASE.         *
C     *********************************************************
C
 2300 CONTINUE
      CALL DPSYS2(ITEXT3,NCTEXT,ISUBRO,IERROR)
      GOTO9000
C
C     *********************************************************
C     *  IBM/PC 386 - OTG COMPILER                            *
C     *********************************************************
C
 2400 CONTINUE
      CALL DPSYS2(ITEXT2,NCTEXT,ISUBRO,IERROR)
      GOTO9000
C
C
C     *********************************************************
C     *  OTHER   - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
CCCCC THE FOLLOWING SECTION WAS AUGMENTED    APRIL 1992
 8000 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('***** ERROR IN DPSYST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)
 8012 FORMAT('      THE INTERFACE TO SYSTEM OPERATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8013)
 8013 FORMAT('      HAS NOT YET BEEN DONE FOR THIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8014)
 8014 FORMAT('      COMPUTER/MODEL/OP-SYS/COMPILER/SITE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8021)IHOST1
 8021 FORMAT(' HOST     = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8022)IHMOD1
 8022 FORMAT(' MODEL    = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8023)IOPSY1
 8023 FORMAT(' OP-SYS   = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8024)ICOMPI
 8024 FORMAT(' COMPILER = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8025)ISITE
 8025 FORMAT(' SITE     = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF'.AND.ISUBRO.NE.'SYST')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSYST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NCTEX
 9015 FORMAT('NCTEX  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(ITEXTE(I),I=1,NCTEX)
 9016 FORMAT('(ITEXTE(I),I =1,NCTEX) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)NCTEXT
 9017 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)(ITEXT2(J:J),J=1,NCTEXT)
 9018 FORMAT('(ITEXT2(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IBUGD2,ISUBRO
 9031 FORMAT('IBUGD2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IFOUND,IERROR
 9032 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)IREPCH
 9041 FORMAT('IREPCH = ',A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSYS2(ITEXT,IWIDTH,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE IS USED BY DPSYST AND A FEW OTHER ROUTINES
C              TO ENTER AN OPERATING SYSTEM COMMAND. IT WAS ISOLATED
C              FROM DPSYST SO THAT THERE IS ONLY ONE ROUTINE THAT
C              ACTUALLY ISSUES AN OPERATING DEPENDENDENT CALL.
C     TO THE IMPLEMENTER--
C              SOME (SIMPLE) EDITING MUST BE DONE ONE THIS
C              ROUTINE BEFORE IT WILL RUN ON ANY COMPUTER.
C              IN GENERAL, ACTIVATE ALL LINES
C              RELATING TO YOUR COMPUTER BY
C              REMOVING ALL PREFIXES
C              DESIGNATING YOUR COMPUTER.
C              FOR EXAMPLE, FOR THE IBM-PC, ACTIVATE
C              ALL (3) LINES WITH THE PREFIX CIBM      .
C              FOR THE VAX, ACTIVATE
C              ALL LINES WITH THE PREFIX CVAX      .
C              ALSO--COMMENT OUT ALL "NOT YET IMPLEMENTED"
C                    WRITE STATEMENTS IN THE SECTION
C                    DEALING WITH YOUR COMPUTER.
C
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C               HOST DEPENDENT
C     VERSION NUMBER--89.3
C     ORIGINAL VERSION--APRIL      1992.
C     UPDATED         --APRIL      1992. ISUBRO & DEBUG STATEMENTS
C     UPDATED         --APRIL      1992. COMPILER=OTG
C     UPDATED         --JANUARY    1994. COMMENTS ABOVE
C     UPDATED         --JUNE       1996. LAHEY COMPILER FOR PC.
C     UPDATED         --OCTOBER    1996. MICROSOFT COMPILER FOR PC.
C     UPDATED         --NOVEMBER   2002. FOR MICROSOFT COMPILER,
C                                        OPTION TO USE EITHER
C                                        SYSTEMQQ OR WinExec
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      USE DFLIB
      USE DFWIN
C
      CHARACTER*(*) ITEXT
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
C  UNCOMMENT FOLLOWING TWO LINES FOR VAX/VMS
CVAX  INTEGER LIB$SPAWN
CVAX  INTEGER ISTATUS
C  COMMENT OUT FOLLOWING 2 LINES FOR NON-UNIX SYSTEM
CUNIX LOGICAL system
      LOGICAL ISTATUS
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C
      IERROR='NO'
C
      IF(ISUBRO.NE.'SYS2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSYS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH= ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(ITEXT(I:I),I=1,MIN(IWIDTH,132))
   54 FORMAT('(ITEXT(I:I),I=1,IWIDTH) = ',132A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)ISUBRO,IERROR
   59 FORMAT('ISUBRO,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IHOST1,IHOST2
   61 FORMAT('IHOST1,IHOST2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IHMOD1,IHMOD2
   62 FORMAT('IHMOD1,IHMOD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IOPSY1,IOPSY2
   63 FORMAT('IOPSY1,IOPSY2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ICOMPI,ISITE
   64 FORMAT('ICOMPI,ISITE = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************
C               **  STEP 1--                  **
C               **  STEP THROUGH EACH HOST    **
C               ********************************
C
C  ALL UNIX HOSTS TESTED BY OPERATING SYSTEM RATHER THAN HOST.
C  THE CRAY DOES NOT SUPPORT THE STANDARD UNIX CALL "SYSTEM", SO
C  EXPLICITLY TEST FOR IT.
C
      IF(IHOST1.EQ.'NVE')GOTO2100
      IF(IHOST1.EQ.'VAX')GOTO2200
      IF(IHOST1.EQ.'CRAY')GOTO8000
      IF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'OS38')GOTO2400
CCCCC THE FOLLOWING LINE WAS ADDED    APRIL 1992
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO2400
CCCCC JUNE 1996. ADD FOLLOWING LINE.
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')GOTO2500
CCCCC OCTOBER 1996. ADD FOLLOWING LINE.
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO2600
      IF(IOPSY1.EQ.'UNIX')GOTO2300
      GOTO8000
C
C     *********************************************************
C     *  CDC - NOS/VE OPERATING SYSTEM.  USE "SCLCMD" TO PASS *
C     *  COMMANDS TO THE OPERATING SYSTEM.                    *
C     *  DATAPLOT WILL DO NO ERROR CHECKING ON THE COMMAND    *
C     *********************************************************
C
 2100 CONTINUE
CNVE  CALL SCLCMD(ITEXT(1:IWIDTH))
      GOTO9000
C
C     *********************************************************
C     *  VAX/VMS - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
C  NOTE TO IMPLEMENTOR.  USE OF LIB$SPAWN HAS NOT BEEN TESTED,
C  BUT SHOULD WORK ACCORDING TO VAX FORTRAN GUIDE.  BE SURE TO
C  UNCOMMENT "INTEGER LIB$SPAWN" IN DECLARATIONS.
C
 2200 CONTINUE
      WRITE(ICOUT,2210)
 2210 FORMAT(1X,'THE SYSTEM COMMAND HAS NOT BEEN IMPLEMENTED AT THIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2220)
 2220 FORMAT(1X,'SITE FOR A VAX HOST.')
      CALL DPWRST('XXX','BUG ')
CVAX  ISTATUS=LIB$SPAWN(ITEXT(1:IWIDTH))
      GOTO9000
C
C     *********************************************************
C     *  UNIX    - LEFT TO IMPLEMENTOR                        *
C     *  CODE ADDED MARCH, 1990 BY ALAN HECKERT.  USE THE     *
C     *  LIBRARY ROUTINE "system".  NOTE THAT UNIX CALLS ARE  *
C     *  CASE SENSITIVE, SO LEAVE CODE IN LOWER CASE.         *
C     *********************************************************
C
 2300 CONTINUE
CUNIX WRITE(ICOUT,2310)
 2310 FORMAT(1X,'THE SYSTEM COMMAND HAS NOT BEEN IMPLEMENTED AT THIS')
CUNIX CALL DPWRST('XXX','BUG ')
CUNIX WRITE(ICOUT,2320)
 2320 FORMAT(1X,'SITE FOR A UNIX HOST.')
CUNIX CALL DPWRST('XXX','BUG ')
CUNIX ISTATUS=system(ITEXT(1:IWIDTH))
CUNIX IF(ISTATUS)IERROR='YES'
      GOTO9000
C
C     *********************************************************
C     *  IBM PC 386 - OTG COMPILER                            *
C     *  USE THE OTG "CISSUE" CALL                            *
C     *********************************************************
C
 2400 CONTINUE
      IFAIL=0
COTG  CALL CISSUE(ITEXT(1:IWIDTH),IFAIL)
      IERROR='NO'
      IF(IFAIL.EQ.1)IERROR='YES'
      GOTO9000
C
C     *********************************************************
C     *  PC USING OTG COMPILER                                *
C     *  USE LAHEY ROUTINE SYSTEM                             *
C     *********************************************************
C
 2500 CONTINUE
CLAHE CALL SYSTEM(ITEXT(1:IWIDTH))
      GOTO9000
C
C     *********************************************************
C     *  PC USING MICROSOFT COMPILER                          *
C     *  USE SYSTEMQQ ROUTINE                                 *
C     *  (SWITCH TO SYSTEM FROM PORT LIB, SYSTEMQQ DOES NOT   *
C     *  KEEP WINDOW UP FOR USER TO EXAMINE)                  *
C     *********************************************************
C
CCCCC NOVEMBER 2002.  OPTION TO USE WinExec.  WinExec RETURNS
CCCCC CONTROL BACK TO DATAPLOT BEFORE COMMAND COMPLETES, WHICH IS
CCCCC USEFUL FOR COMMANDS SUCH AS WEB HELP (I.E., YOU CAN BOTH
CCCCC BROWSE AND ENTER ADDITIONAL DATAPLOT COMMANDS).  HOWEVER, IT
CCCCC DOES NOT WORK FOR DOS TYPE COMMANDS (E.G., SYSTEM DIR | MORE).
C
 2600 CONTINUE
      IF(IQWNSY.EQ.'WINE')THEN
        ISTATUS=WinExec(ITEXT(1:IWIDTH)//' 'C,SW_SHOW)
      ELSE
        ISTATUS=SYSTEMQQ(ITEXT(1:IWIDTH))
      ENDIF
      GOTO9000
C
C
C     *********************************************************
C     *  OTHER   - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
 8000 CONTINUE
      WRITE(ICOUT,8010)
 8010 FORMAT(1X,'THE SYSTEM COMMAND HAS NOT BEEN IMPLEMENTED AT THIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8020)IHOST1
 8020 FORMAT(1X,'SITE FOR A ',A4,' HOST.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(ISUBRO.NE.'SYS2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSYS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IWIDTH
 9015 FORMAT('IWIDTH  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(ITEXT(I:I),I=1,MIN(IWIDTH,80))
 9016 FORMAT('(ITEXT(I:I),I =1,IWIDTH) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)ISUBRO,IERROR
 9019 FORMAT('ISUBRO,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IHOST1,IHOST2
 9021 FORMAT('IHOST1,IHOST2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IHMOD1,IHMOD2
 9022 FORMAT('IHMOD1,IHMOD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IOPSY1,IOPSY2
 9023 FORMAT('IOPSY1,IOPSY2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ICOMPI,ISITE
 9024 FORMAT('ICOMPI,ISITE = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTIME(CURRTIME,NCURRTIM,CURRDATE,NCURRDAT,
CCCCC SUBROUTINE DPTIME(IBUGS2,ISUBRO,IFOUND,IERROR)
     1IBUGS2,ISUBRO,IFOUND,IERROR)
CCCCC THE ABOVE SUBROUTINE CALL WAS CHANGED FEBRUARY 1993
C
C     PURPOSE--PRINT OUT TIME AND DATE INFORMATION.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1986.
C     UPDATED         --SEPTEMBER 1990. TIME AND DATE FOR IBM-PC(JJF)
C     UPDATED         --APRIL     1992. FOR UNIX,VAX,CRAY,ETC. (ALAN)
C     UPDATED         --FEBRUARY  1993. ALSO BRANCH IF IMB- OTG
C     UPDATED         --FEBRUARY  1993. TIME & DATE AS OUTPUT ARGUMENT
C     UPDATED         --FEBRUARY  1993. CONDITIONAL WRITE OF TIME/DATE
C     UPDATED         --AUGUST    1993. FOR UNIX, VAX, NOS/VE (ALAN)
C     UPDATED         --AUGUST    1994. FOR UNIX, CURRDATE AND CURRTIME
C     UPDATED         --JUNE      1996. SUPPORT LAHEY COMPILER ON PC
C     UPDATED         --OCTOBER   1996. SUPPORT MS-FORTRAN COMPILER ON PC
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*24 CURRTIME
      CHARACTER*24 CURRDATE
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
CCCCC THE FOLLOWING SECTIONS WERE ADDED          APRIL 1992 (ALAN)
CCCCC FOR HOST-DEPENDENT DECLARATIONS.           APRIL 1992 (ALAN)
CCCCC THE INSTALLER MUST COMMENT/UNCOMMENT OUT   APRIL 1992 (ALAN)
CCCCC APPROPRIATELY.                             APRIL 1992 (ALAN)
      CHARACTER*24 ADATE
      CHARACTER*24 ATIME
C
CCCCC FOR THE IBM/PC USING OTG COMPILER    SEPTEMBER 1990 (JJF)
CIBM- CHARACTER*8 TIME
CIBM- CHARACTER*8 DATE
C
CCCCC FOR THE VAX--
CVAX  CHARACTER*23 DATETIME
CVAX  INTEGER LIB$DATE_TIME
CVAX  EXTERNAL LIB$DATE_TIME
C
CCCCC FOR NOS/VE--
CNVE  CHARACTER*10 DATE
CNVE  CHARACTER*8 TIME
C
CCCCC FOR UNIX--
      CHARACTER*24 fdate
C
CCCCC FOR CRAY UNICOS--
CCRAY REAL DATE
CCRAY INTEGER TIME
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
CCCCC THE FOLLOWING LINE WAS ADDED    SEPTEMBER 1990 (JJF)
      INCLUDE 'DPCOHO.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='DPTI'
      ISUBN2='ME  '
C
      IFOUND='YES'
      IERROR='NO'
C
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992 (ALAN)
CCCCC IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'OPMS')GOTO90
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'TIME')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************************
C               **  STEP 14--                               **
C               **  IF THE NEEDED SYSTEM CALL               **
C               **  EXISTS AT THIS COMPUTER INSTALLATION,   **
C               **  THEN HAVE THE DATAPLOT IMPLEMENTOR      **
C               **  ENTER THE CODE FOR SUCH A CALL.         **
C               **  IF THE NEEDED SYSTEM CALL               **
C               **  DOES NOT EXIST (THE DEFAULT) AT THIS    **
C               **  COMPUTER INSTALLATION,                  **
C               **  THEN WRITE OUT AN ERROR MESSAGE.        **
C               **********************************************
C
      ISTEPN='12'
CCCCC IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'OPMS')
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'TIME')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C  APRIL 1992.  FOLLOWING CODE EXTENSIVELY MODIFIED.
C
      IF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'OS38')GOTO1000
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO1000
CCCCC THE FOLLOWING LINE WAS ADDED   JUNE 1996
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')GOTO6000
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO7000
      IF(IHOST1.EQ.'NVE')GOTO2000
      IF(IHOST1.EQ.'CRAY')GOTO4000
      IF(IOPSY1.EQ.'UNIX')GOTO3000
      IF(IHOST1.EQ.'VAX')GOTO5000
      GOTO8000
C
CCCCC THE FOLLOWING SECTION WAS ADDED FOR IBM-PC SEPTEMBER 1990 (JJF)
CCCCC NOTE--TIME@() AND DATE@() ARE OTG RUN TIME LIBRARY ROUT. (JJF)
C               ********************************
C               **  STEP 2A--                 **
C               **  IBM/PC 386 WITH OTG COMPILER
C               ********************************
C
 1000 CONTINUE
      ADATE='NULL'
      ATIME='NULL'
CIBM- ADATE(1:8)=DATE@()
CIBM- ATIME(1:8)=TIME@()
CCCCC THE FOLLOWING LINE (& ENDIF) WAS ADDED FEBRUARY 1993
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,1011)
 1011    FORMAT('THE CURRENT DATE AND TIME ARE:')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1012)ADATE(1:8)
 1012    FORMAT(A8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1013)ATIME(1:8)
 1013    FORMAT(A8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
CCCCC THE FOLLOWING 4 LINES WERE ADDED FEBRUARY 1993
      CURRTIME(1:8)=ATIME(1:8)
      NCURRTIM=8
      CURRDATE(1:8)=ADATE(1:8)
      NCURRDAT=8
      GOTO9000
C
C               ********************************
C               **  STEP 2B--                 **
C               **  CYBER WITH NOS/VE         **
C               **  USE TEH DATE AND TIME     **
C               **  CALLS.  CHECK THE DECLARATIONS
C               **  FOR SOME LINES THAT NEED  **
C               **  TO BE UNCOMMENTED.        **
C               ********************************
C
 2000 CONTINUE
      ADATE='NULL'
      ATIME='NULL'
C  UNCOMMENT THE FOLLOWING 2 LINES FOR NOS/VE.
CNVE  ADATE(1:10)=DATE()
CNVE  ATIME(1:10)=TIME()
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,2011)
 2011   FORMAT('THE CURRENT DATE AND TIME ARE:')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2012)ADATE(1:10)
 2012   FORMAT(A10)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2013)ATIME(1:8)
 2013   FORMAT(A8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
CCCCC THE FOLLOWING 4 LINES WERE ADDED JULY 1993
      CURRTIME(1:10)=ATIME(1:10)
      NCURRTIM=10
      CURRDATE(1:10)=ADATE(1:10)
      NCURRDAT=10
      GOTO9000
C
C               ********************************
C               **  STEP 2C--                 **
C               **  UNIX OPERATING SYSTEM     **
C               **  USE fdate CALL.           **
C               **  CHECK THE DECLARATIONS    **
C               **  FOR SOME LINES THAT NEED  **
C               **  TO BE UNCOMMENTED.        **
C               **  MAY NEED TO CHECK THAT fdate
C               **  IS VALID ON YOUR UNIX     **
C               **  SYSTEM.                   **
C               ********************************
C
 3000 CONTINUE
      ADATE='NULL'
      ATIME='NULL'
C  UNCOMMENT THE FOLLOWING 2 LINES FOR UNIX
CLAHE ADATE(1:24)=fdate()
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,3011)
 3011   FORMAT('THE CURRENT DATE AND TIME ARE:')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3012)ADATE(1:11),ADATE(21:24)
 3012   FORMAT(A11,1X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3013)ADATE(12:19)
 3013   FORMAT(A8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
CCCCC THE FOLLOWING 4 LINES WERE ADDED JULY 1993
CCCCC CURRTIME(1:4)=ADATE(21:24)
CCCCC NCURRTIM=4
CCCCC JULY 1994.  FIX CURRDATE, CURRTIME STRINGS
      CURRDATE(1:11)=ADATE(1:11)
      CURRDATE(12:15)=ADATE(21:24)
      NCURRDAT=15
      CURRTIME(1:8)=ADATE(12:19)
      NCURRTIM=8
      GOTO9000
C
C               ********************************
C               **  STEP 2C.1--               **
C               **  CRAY UNIX USES DATE AND   **
C               **  TIME CALLS.               **
C               **  CHECK THE DECLARATIONS    **
C               **  FOR SOME LINES THAT NEED  **
C               **  TO BE UNCOMMENTED.        **
C               ********************************
C
 4000 CONTINUE
      ADATE='NULL'
      ATIME='NULL'
C  UNCOMMENT THE FOLLOWING LINE FOR CRAY
CCRAY ATEMP=DATE()
CCRAY WRITE(ADATE(1:8),'(A8)')ATEMP
CCRAY ITEMP=TIME()
CCRAY WRITE(ATIME(1:8),'(A8)')ITEMP
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,4011)
 4011   FORMAT('THE CURRENT DATE AND TIME ARE:')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4012)ADATE(1:8)
 4012   FORMAT(A8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4013)ATIME(1:8)
 4013   FORMAT(A8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
CCCCC THE FOLLOWING 4 LINES WERE ADDED FEBRUARY 1993
      CURRTIME(1:8)=ATIME(1:8)
      NCURRTIM=8
      CURRDATE(1:8)=ADATE(1:8)
      NCURRDAT=8
      GOTO9000
C
C               ********************************
C               **  STEP 2D--                 **
C               **  VAX/VMS                   **
C               **  USE LIB$DATE_TIME         **
C               ********************************
C  IMPLEMENTORS NOTE.  THIS CODE HAS NOT BEEN TESTED!!!
C  IT LOOKS RIGHT ACCORDING TO VAX FORTRAN MANUAL, BUT IT
C  MAY NEED TO BE DEBUGGED.
C
 5000 CONTINUE
      ADATE='NULL'
      ATIME='NULL'
C  UNCOMMENT THE FOLLOWING LINE FOR CRAY
CVAX  ISTATUS=LIB$DATE_TIME(DATETIME)
CVAX  ISTATUS PROBABLY NEEDS TO BE DECLARED ABOVE
CVAX  ADATE(1:11)=DATETIME(1:11)
CVAX  ATIME(1:8)=DATETIME(13:20)
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,5011)
 5011   FORMAT('THE CURRENT DATE AND TIME ARE:')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5012)ADATE(1:8)
 5012   FORMAT(A8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5013)ATIME(1:8)
 5013   FORMAT(A8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
CCCCC THE FOLLOWING 4 LINES WERE ADDED FEBRUARY 1993
      CURRTIME(1:8)=ATIME(1:8)
      NCURRTIM=8
      CURRDATE(1:11)=ADATE(1:11)
      NCURRDAT=11
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED JUNE 1996 FOR LAHEY COMPILER
C               ********************************
C               **  STEP 2E--                 **
C               **  IBM/PC 386 WITH LAHEY COMPILER
C               ********************************
C
 6000 CONTINUE
      ADATE='NULL'
      ATIME='NULL'
CLAHE CALL DATE(ADATE(1:8))
CLAHE CALL TIME(ATIME(1:11))
CCCCC THE FOLLOWING LINE (& ENDIF) WAS ADDED FEBRUARY 1993
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,6011)
 6011    FORMAT('THE CURRENT DATE AND TIME ARE:')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,6012)ADATE(1:8)
 6012    FORMAT(A8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,6013)ATIME(1:8)
 6013    FORMAT(A8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
CCCCC THE FOLLOWING 4 LINES WERE ADDED FEBRUARY 1993
CLAHE CURRTIME(1:11)=ATIME(1:11)
      NCURRTIM=11
CLAHE CURRDATE(1:8)=ADATE(1:8)
      NCURRDAT=8
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED OCTOBER 1996 FOR MS-FORTRAN COMPILER
C               ********************************
C               **  STEP 2F--                 **
C               **  IBM/PC 386 WITH MICROSOFT COMPILER
C               ********************************
C
 7000 CONTINUE
      ADATE='NULL'
      ATIME='NULL'
      CALL DATE_AND_TIME(DATE=ADATE, TIME=ATIME)
      CALL TIME(ATIME(1:11))
CCCCC THE FOLLOWING LINE (& ENDIF) WAS ADDED FEBRUARY 1993
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,7011)
 7011    FORMAT('THE CURRENT DATE AND TIME ARE:')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,7012)ADATE(1:8)
 7012    FORMAT(A8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,7013)ATIME(1:8)
 7013    FORMAT(A8)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      CURRTIME(1:10)=ATIME(1:10)
      NCURRTIM=10
      CURRDATE(1:8)=ADATE(1:8)
      NCURRDAT=8
      GOTO9000
C
C               ********************************
C               **  STEP 2B--                 **
C               **  CYBER WITH NOS/VE         **
C               **  USE TEH DATE AND TIME     **
C               **  CALLS.  CHECK THE DECLARATIONS
C               **  FOR SOME LINES THAT NEED  **
C
C               ********************************
C               **  STEP 2E--                 **
C               **  UNSUPPORTED SYSTEMS.      **
C               ********************************
C
 8000 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('***** ERROR IN DPTIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)
 8012 FORMAT('      THE DESIRED TIME ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8013)
 8013 FORMAT('      CANNOT BE SHOWN BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8014)
 8014 FORMAT('      THE REQUIRED CALL TO A SYSTEM-DEPENDENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8015)
 8015 FORMAT('      ROUTINE TO SHOW SUCH TIME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8016)
 8016 FORMAT('      HAS NOT BEEN IMPLEMENTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8017)
 8017 FORMAT('      AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8021)
 8021 FORMAT('      PLEASE REQUEST THE IMPLEMENTOR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8022)
 8022 FORMAT('      TO ENTER THE CODE INTO THIS SUBROUTINE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8023)
 8023 FORMAT('      (DPTIME) TO CALL SUCH A SYSTEM-DEPENDENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8024)
 8024 FORMAT('      ROUTINE.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C1290 CONTINUE
C
CCCCC CALL XXX(ISTRIN,NCSTRI)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
CCCCC IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'OPMS')GOTO9090
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'TIME')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9031)ISUBN0
C9031 FORMAT('ISUBN0 = ',A12)
CCCCC CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPEDIT(ICOM,IANSLC,IWIDTH,IBUGMA,ISUBRO,IERROR)
C
C     PURPOSE--EDIT A FILE
C     ORIGINAL VERSION--JULY       1992
C
      CHARACTER*4 ICOM
      CHARACTER*4 IANSLC
      CHARACTER*4 IBUGMA
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IC4
      CHARACTER*4 ISOURC
      CHARACTER*80 IEDINA
CCCCC TEH FOLLOWING LINE WAS ADDED    JULY 1993
      CHARACTER*4 IDATAP
C
      DIMENSION IANSLC(*)
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
      ISTART=6
      IF(ICOM.EQ.'FED')ISTART=5
C
      IEDINA=' '
      IF(ISTART.LE.IWIDTH)THEN
         J=0
         DO1000I=ISTART,IWIDTH
            J=J+1
            IC4=IANSLC(I)
            IEDINA(J:J)=IC4(1:1)
 1000    CONTINUE
      ENDIF
C
C     ISOURC IS THE SOURCE OF THE NAME OF THE FILE TO BE EDITED.
C     IF THE FILE NAME IS IN C:\FED\FEDARG.TEX,
C     THEN ISOURC = 'FILE'
C     IF THE FILE NAME IS PASSED ON VIA A SUBROUTINE ARGUMENT,
C     THEN ISOURC = 'SUBR'
C
      ISOURC='SUBR'
C
C     IDATAP IS THE DATAPLOT-CONNECTION SWITCH.
C     IF FED IS CONNECTED TO DATAPLOT,
C     THEN IDATAP = 'ON'
C     IF FED IS STAND-ALONE,
C     THEN IDATAP = 'OFF'
C
CCCCC THE FOLLOWING LINE WAS ADDED    JULY 1993
      IDATAP='ON'
C
CCCCC THE FOLLOWING LINE WAS CHANGED    JULY 1993
CCCCC CALL EDMAI2(ISOURC,IEDINA)
      CALL EDMAI2(ISOURC,IEDINA,IDATAP)
C
      RETURN
      END
      SUBROUTINE DPWRST(ISUBN0,TYPE)
C
C     PURPOSE--WRITE OUT THE NCOUT ELEMENTS OF THE
C              CHARACTER*240 STRING ICOUT(.:.)
C              TO A GENERAL GRAPHICS DEVICE.
C              THE VALUE OF THE VARIABLE    NCOUT
C     ICOUT AND NCOUT RESIDE IN COMMON   /TEXTOU/
C     INPUT ARGUMENTS--ICOUT (IN COMMON)
C     ISUBN0 = 6-CHARACTER NAME OF SUBROUTINE WHICH CALLED DPWRST.
C              (AND THEREBY HAVE WALKBACK INFORMATION).
C     TYPE--4 CHARACTER DEFINITION OF TYPE OF INPUT
C              1) TEXT
C              2) BUG
C              3) ERRO
C              4) LIST
C              5) HELP
C              6) WRIT (= ALWAYS WRITE EVEN IF FEEDBACK OFF)
C              7) ...
C     OUTPUT ARGUMENTS--NCOUT (DETERMINED HEREIN)
C     NOTE--ALL DATAPLOT TEXT OUTPUT IS FUNNELED THROUGH
C           THIS ONE SUBROUTINE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--93.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1993.
C     UPDATED            --SEPTEMBER 1993. ALWAYS WRITE IF TYPE = WRIT
C     UPDATED            --SEPTEMBER 1993. OMIT IBUGG4 AS BUG SWITCH
C     UPDATED            --FEBRUARY  2005. FOR RTF OUTPUT, SUPPRESS
C                                          LEADING SPACE.  NEED TO
C                                          ADD DPCOSU.INC.
C     UPDATED            --JANUARY   2006. ALLOW CAPTURE OUTPUT TO
C                                          BE OPTIONALLY WRITTEN TO
C                                          BOTH SCREEN AND CAPTURE
C                                          FILE
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CCCCC MUST EVENTUALLY CHANGE THE FOLLOWING LINE FORM *3 TO *?
      CHARACTER*3 ISUBN0
      CHARACTER*4 TYPE
C
      CHARACTER*4 IBRANC
      CHARACTER*1 IBASLC
C
C-----COMMON----------------------------------------------------------
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOTR.INC'
      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
      IERRG4='NO'
C  MAY,1988.
CCCCC NCOUT=ABS(NCOUT)  JJF
C
CCCCC THE FOLLOWING LINE WAS CHANGED    SEPTEMBER 1993
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'WRST')THEN
      IF(ISUBG4.EQ.'WRST')THEN
         WRITE(IPR,999)
  999    FORMAT(1H )
         WRITE(IPR,51)
   51    FORMAT(1H ,'***** AT THE BEGINNING OF DPWRST--')
         WRITE(IPR,52)ISUBN0
   52    FORMAT(1H ,'THE CALLING ROUTINE (ISUBN0) WAS ',A3)
         WRITE(IPR,53)TYPE
   53    FORMAT(1H ,'TYPE = ',A4)
         WRITE(IPR,55)IFEEDB,IHOST1
   55    FORMAT(1H ,'IFEEDB,IHOST1 = ',A4,2X,A4)
         WRITE(IPR,56)NCOUT,ILOUT
   56    FORMAT(1H ,'NCOUT,ILOUT = ',2I8)
         WRITE(IPR,61)
   61    FORMAT(1H ,'          123456789.123456789.123456789.123456')
         WRITE(IPR,62)ICOUT(1:40)
   62    FORMAT(1H ,'ICOUT = ',40A1)
         WRITE(IPR,63)ICOUT
   63    FORMAT(1H ,'ICOUT = ',A230)
   90    CONTINUE
      ENDIF
C
C               *********************************************
C               **  STEP 11--                              **
C               **  IF CALLED FOR,                         **
C               **  CARRY OUT ANY SUB-STRING TRANSLATIONS  **
C               *********************************************
C
CCCCC IF(NUMTRA.GE.1)
CCCCC1CALL GRTRST(ICOUT,NCOUT,
CCCCC1ICTRA1,NCTRA1,ICTRA2,NCTRA2,NUMTRA,
CCCCC1IBUGG4,ISUBG4,IERRG4)
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  DETERMINE THE LENGTH OF THE STRING          **
C               **  (BY IGNORING BLANK CHARACTERS AT THE END)   **
C               **************************************************
C
CCCCC IF(NCOUT.LE.-1)THEN
CCCCC THE FOLLOWING LINE WAS CHANGED SEPTEMBER 1993
CCCCC    DO1200I=1,240
         DO1200I=1,240
CCCCC THE FOLLOWING LINE WAS CHANGED SEPTEMBER 1993
CCCCC       J=240-I+1
            J=240-I+1
            IF(ICOUT(J:J).NE.' ')GOTO1250
 1200    CONTINUE
         NCOUT=1
         GOTO1290
 1250    CONTINUE
         NCOUT=J
 1290    CONTINUE
CCCCC ENDIF
C
C               ****************************
C               **  STEP 13--             **
C               **  WRITE OUT THE STRING  **
C               ****************************
C
CCCCC IOUNIT=6
CCCCC NOTE--IPR BELOW IS USUALLY 6
CCCCC       BUT COULD BE SET TO 7 IN TCSHME.FOR WITHIN TCDRIV.FOR
      IOUNIT=IPR
C
      IBRANC='NOWR'
CCCCC THE FOLLOWING LINE WAS CHANGED     SEPTEMBER 1993
CCCCC TO ALLOW ALWAYS-WRITING FOR L, WRITE, HELP, STAT SEPTEMBER 1993
CCCCC IF(IFEEDB.EQ.'ON')THEN
      IF(IFEEDB.EQ.'ON'.OR.TYPE.EQ.'WRIT')THEN
         IF(1.LE.NCOUT.AND.NCOUT.LE.230)THEN
            IBRANC='WRIT'
            IF(IHOST1.EQ.'VAX'.AND.ICOUT(1:1).EQ.'$')THEN
               WRITE(IOUNIT,1311)(ICOUT(I:I),I=1,NCOUT)
 1311          FORMAT(230A1)
            ELSEIF(ICAPTY.EQ.'RTF ')THEN
               CALL DPCONA(92,IBASLC)
               WRITE(IOUNIT,1311)(ICOUT(I:I),I=1,NCOUT)
               IF(IRTFMD.EQ.'VERB')THEN
                 WRITE(IOUNIT,1319)IBASLC
 1319            FORMAT(A1,'line')
               ENDIF
            ELSEIF(ICAPSC.EQ.'ON  ' .AND. IOUNIT.NE.6 .AND.
     1             ICAPTY.NE.'HTML' .AND. ICAPTY.NE.'LATE')THEN
               WRITE(IOUNIT,1312)(ICOUT(I:I),I=1,NCOUT)
               WRITE(6,1312)(ICOUT(I:I),I=1,NCOUT)
            ELSE
               WRITE(IOUNIT,1312)(ICOUT(I:I),I=1,NCOUT)
 1312          FORMAT(1X,230A1)
C1312          FORMAT(230A1)
            ENDIF
         ENDIF
      ENDIF
C
C               ******************************
C               **  STEP 14--               **
C               **  RESET STRING VARIABLES  **
C               ******************************
C
      ICOUT=' '
      NCOUT=(-999)
      ILOUT=(-999)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGED    SEPTEMBER 1993
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'WRST')THEN
      IF(ISUBG4.EQ.'WRST')THEN
         WRITE(IPR,999)
         WRITE(IPR,9011)
 9011    FORMAT(1H ,'***** AT THE END       OF DPWRST--')
         WRITE(IPR,9012)ISUBN0
 9012    FORMAT(1H ,'THE CALLING ROUTINE (ISUBN0) WAS ',A3)
         WRITE(IPR,9013)TYPE
 9013    FORMAT(1H ,'TYPE = ',A4)
         WRITE(IPR,9015)IFEEDB,IHOST1
 9015    FORMAT(1H ,'IFEEDB,IHOST1 = ',A4,2X,A4)
         WRITE(IPR,9016)NCOUT,ILOUT
 9016    FORMAT(1H ,'NCOUT,ILOUT = ',2I8)
         WRITE(IPR,9021)
 9021    FORMAT(1H ,'          123456789.123456789.123456789.123456')
         WRITE(IPR,9022)ICOUT(1:40)
 9022    FORMAT(1H ,'ICOUT = ',40A1)
         WRITE(IPR,9023)ICOUT
 9023    FORMAT(1H ,'ICOUT = ',A230)
C
         WRITE(IPR,9032)IBRANC
 9032    FORMAT(1H ,'IBRANC = ',A4)
         WRITE(IPR,9033)IOUNIT,IMANUF
 9033    FORMAT(1H ,'IOUNIT,IMANUF = ',I8,2X,A4)
         WRITE(IPR,9034)NCOUT
 9034    FORMAT(1H ,'NCOUT = ',I8)
         IF(NCOUT.LE.0)GOTO9037
         IF(NCOUT.LE.0)GOTO9037
         DO9035I=1,NCOUT
CCCCC    IASCNE=ICHAR(ICOUT(I:I))
         CALL DPCOAN(ICOUT(I:I),IASCNE)
         WRITE(IPR,9036)I,ICOUT(I:I),IASCNE
 9036    FORMAT(1H ,'I,ICOUT(I:I),IASCNE = ',I8,2X,A1,I8)
 9035    CONTINUE
 9037    CONTINUE
         WRITE(IPR,9039)IBUGG4,ISUBG4,IERRG4
 9039    FORMAT(1H ,'IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
         IF(NUMTRA.LE.0)GOTO9049
 9042    CONTINUE
 9049    CONTINUE
 9090    CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE GRWRST(ICSTR,NCSTR2,ISUBN0)
CCCCC SUBROUTINE GRWRST(ICSTR,NCSTR,ISUBN0)
C
C     PURPOSE--WRITE OUT THE NCSTR ELEMENTS OF THE
C              CHARACTER*130 STRING ICSTR(.:.)
C              OUT TO A GENERAL GRAPHICS DEVICE.
C              THE VALUE OF THE VARIABLE    NCSTR
C              IS THE NUMBER OF ELEMENTS IN ICSTR(.:.)
C              TO BE WRITTEN OUT.
C     NOTE--ISUBN0 = NAME OF SUBROUTINE WHICH CALLED GRWRST.
C                    (AND THEREBY HAVE WALKBACK INFORMATION).
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --MAY 1988.
C                       THE POSTSCRIPT DEVICE REQUIRES A "%!" TO BE FIRST
C                       16 BYTES, QUIC REQUIRES "^PY.." COMMAND TO START
C                       IN COLUMN 1.  ALSO, SOME DEVICES SUCH AS DICOMED,
C                       SHOUULD NOT CONTAIN LEADING SPACES IN THE FILE.
C                       FOR THESE CASE, SEND "NCSTR" AS NEGATIVE.  IF NCSTR
C                       IS NEGATIVE, THE LEADING SPACE FOR PRINT CONTROL
C                       WILL NOT BE ADDED.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1994. ALPHA: 1X IN FORMAT (JJF)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*130 ICSTR
C
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 IBRANC
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOTR.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
      IERRG4='NO'
C  MAY,1988.
      NCSTR=ABS(NCSTR2)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRST')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRWRST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ISUBN0
   52 FORMAT('ISUBN0 (NAME OF THE CALLING SUBROUTINE) = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IMANUF
   53 FORMAT('IGUNIT,IMANUF = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NCSTR
   54 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO57
      DO55I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,56)I,ICSTR(I:I),IASCNE
   56 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   57 CONTINUE
      WRITE(ICOUT,61)NUMTRA
   61 FORMAT('NUMTRA = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMTRA.LE.0)GOTO69
      DO62I=1,NUMTRA
      WRITE(ICOUT,63)I,NCTRA1(I),ICTRA1(I),NCTRA2(I),ICTRA2(I)
   63 FORMAT('I,NCTRA1(I),ICTRA1(I),NCTRA2(I),ICTRA2(I) = ',
     1I8,I8,2X,A30,I8,2X,A30)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   69 CONTINUE
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************************
C               **  STEP 11--                              **
C               **  IF CALLED FOR,                         **
C               **  CARRY OUT ANY SUB-STRING TRANSLATIONS  **
C               *********************************************
C
      IF(NUMTRA.GE.1)
     1CALL GRTRST(ICSTR,NCSTR,
     1ICTRA1,NCTRA1,ICTRA2,NCTRA2,NUMTRA,
     1IBUGG4,ISUBG4,IERRG4)
C
C               ****************************
C               **  STEP 21--             **
C               **  WRITE OUT THE STRING  **
C               ****************************
C
      IBRANC='NOWR'
      IF(1.LE.NCSTR.AND.NCSTR.LE.130)GOTO2100
      GOTO2190
C
 2100 CONTINUE
      IBRANC='WRIT'
      IF(IHOST1.EQ.'VAX'.AND.ICSTR(1:1).EQ.'$')GOTO2110
      IF(NCSTR2.LT.0)GOTO2110
      GOTO2120
C
 2110 CONTINUE
      WRITE(IGUNIT,2111)(ICSTR(I:I),I=1,NCSTR)
 2111 FORMAT(240A1)
CCCCC NOTE--THE FOLLOWING FORMAT SHOULD BE USED  JANUARY 1994
CCCCC       INSTEAD ON SOME COMPUTERS            JANUARY 1994
CCCCC       (E.G., DEC ALPHA COMPUTERS)          JANUARY 1994
CCCCC       WHICH NEED A LEADING SPACE BEFORE    JANUARY 1994
CCCCC       ALL FORTRAN WRITE STATEMENTS--EVEN   JANUARY 1994
CCCCC       WRITE STATEMENTS WITH GRAPHICS       JANUARY 1994
CCCCC       DIRECTIVES.    JJF                   JANUARY 1994
C2111 FORMAT(1X,240A1)
      GOTO2190
C
 2120 CONTINUE
      WRITE(IGUNIT,2121)(ICSTR(I:I),I=1,NCSTR)
C2121 FORMAT(240A1)
CCCCC NOTE--THE FOLLOWING FORMAT SHOULD BE USED  JANUARY 1994
CCCCC       INSTEAD ON SOME COMPUTERS            JANUARY 1994
CCCCC       (E.G., DEC ALPHA COMPUTERS)          JANUARY 1994
CCCCC       WHICH NEED A LEADING SPACE BEFORE    JANUARY 1994
CCCCC       ALL FORTRAN WRITE STATEMENTS--EVEN   JANUARY 1994
CCCCC       WRITE STATEMENTS WITH GRAPHICS       JANUARY 1994
CCCCC       DIRECTIVES.    JJF                   JANUARY 1994
 2121 FORMAT(1X,240A1)
      GOTO2190
C
 2190 CONTINUE
C
C               *******************************************
C               **  STEP 31--                            **
C               **  IF CALLED FOR,                       **
C               **  CALL THE LINE TRANSLATOR SUBROUTINE  **
C               **  WHICH CONVERTS A TEKTRONIX LINE      **
C               **  INTO A SET OF CALLS FOR              **
C               **  ANOTHER GRAPHICS DEVICE              **
C               **  (SEE SUBROUTINE GRTRTK).             **
C               *******************************************
C
CCCCC IF(ITRANS.EQ.'ON')CALL GRTRTK(ICSTR,NCSTR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRST')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRWRST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBRANC
 9012 FORMAT('IBRANC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IMANUF
 9013 FORMAT('IGUNIT,IMANUF = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NCSTR
 9014 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9017
      IF(NCSTR.LE.0)GOTO9017
      DO9015I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9016)I,ICSTR(I:I),IASCNE
 9016 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9017 CONTINUE
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NUMTRA
 9021 FORMAT('NUMTRA = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMTRA.LE.0)GOTO9029
      DO9022I=1,NUMTRA
      WRITE(ICOUT,9023)I,ICTRA1(I),NCTRA1(I),NCTRA2(I),ICTRA2(I)
 9023 FORMAT('I,ICTRA1(I),NCTRA1(I),NCTRA2(I),ICTRA2(I) = ',
     1I8,2X,A30,I8,2X,A30,I8)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9029 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSLEE(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CAUSE DATAPLOT TO PAUSE FOR <X> SECONDS.  THIS COMMAND
C              IS SITE AND HOST DEPENDENT.  THE MAIN USAGE IS TO ALLOW
C              DELAY TO BE INSERTED IN MACROS AFTER A PLOT TO AVOID
C              THE HASSLE OF ENTERING A CARRIAGE RETURN AS NEEDED BY
C              THE PAUSE COMMAND.
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SLEEEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C               HOST DEPENDENT
C     VERSION NUMBER--97.8
C     ORIGINAL VERSION--AUGUST     1997.
C
C-----NON-COMMON VARIABLES (GRAPHICS)---------------------------------
C
      USE MSFLIB
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
      DIMENSION IARGT(*)
C
      INCLUDE 'DPCOHO.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
C
      IFOUND='YES'
      IERROR='NO'
C
      J2=0
C
      IF(IBUGD2.EQ.'OFF'.AND.ISUBRO.NE.'SLEE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSLEE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)IBUGD2,ISUBRO
   81 FORMAT('IBUGD2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)IFOUND,IERROR
   82 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************************************
C               **  STEP 1--                                       **
C               **  DETERMINE THE TIME VARIABLE                    **
C               *****************************************************
C
  100 CONTINUE
      IF(NUMARG.LE.0)THEN
        ASLEEP=5.0
      ELSE
        IF(IARGT(1).EQ.'NUMB')THEN
          ASLEEP=ARG(1)
        ELSE
          ASLEEP=5.0
        ENDIF
      ENDIF
C
C               ********************************
C               **  STEP 2--                  **
C               **  STEP THROUGH EACH HOST    **
C               ********************************
C
      IF(IHOST1.EQ.'NVE')GOTO2100
      IF(IHOST1.EQ.'VAX')GOTO2200
      IF(IOPSY1.EQ.'UNIX')GOTO2300
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO2400
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO2500
      GOTO8000
C
C     *********************************************************
C     *  CDC - NOS/VE LEFT TO IMPLEMENTOR                     *
C     *********************************************************
C
 2100 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPSLEE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)
 2112 FORMAT('      COMMAND NOT IMPLEMENTED FOR NOS/VE')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C     *********************************************************
C     *  VAX/VMS - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
 2200 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPSLEE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      COMMAND NOT IMPLEMENTED FOR VAX/VMS')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C     *********************************************************
C     *  UNIX    - LEFT TO IMPLEMENTOR                        *
C     *  CODE ADDED MARCH, 1990 BY ALAN HECKERT.  USE THE     *
C     *  LIBRARY ROUTINE "SLEEem".  NOTE THAT UNIX CALLS ARE  *
C     *  CASE SENSITIVE, SO LEAVE CODE IN LOWER CASE.         *
C     *********************************************************
C
 2300 CONTINUE
CUNIX CALL SLEEP(INT(ASLEEP+0.5))
      GOTO9000
C
C     *********************************************************
C     *  IBM/PC 386 - OTG COMPILER                            *
C     *********************************************************
C
 2400 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2411)
 2411 FORMAT('***** ERROR IN DPSLEE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2412)
 2412 FORMAT('      COMMAND NOT IMPLEMENTED FOR IBM OTG VERSION')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C     *********************************************************
C     *  IBM/PC 386 - MICROSOFT WINDOWS 95/NT COMPILER        *
C     *********************************************************
C
 2500 CONTINUE
      CALL SLEEPQQ(INT(ASLEEP*1000.))
      GOTO9000
C
C     *********************************************************
C     *  OTHER   - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
CCCCC THE FOLLOWING SECTION WAS AUGMENTED    APRIL 1992
 8000 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('***** ERROR IN DPSLEE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8013)
 8013 FORMAT('      THE SLEEP COMMAND HAS NOT YET BEEN DONE FOR THIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8014)
 8014 FORMAT('      COMPUTER/MODEL/OP-SYS/COMPILER/SITE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8021)IHOST1
 8021 FORMAT(' HOST     = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8022)IHMOD1
 8022 FORMAT(' MODEL    = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8023)IOPSY1
 8023 FORMAT(' OP-SYS   = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8024)ICOMPI
 8024 FORMAT(' COMPILER = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8025)ISITE
 8025 FORMAT(' SITE     = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF'.AND.ISUBRO.NE.'SLEE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSLEE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IBUGD2,ISUBRO
 9031 FORMAT('IBUGD2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IFOUND,IERROR
 9032 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCDIR(IANS,IANSLC,IWIDTH,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CHANGE THE CURRENT DIRECTORY.  NOTE THAT THIS COMMAND
C              IS SITE AND HOST DEPENDENT.  IT IS PROVIODED AS A
C              CONVENIENCE FUNCTION.  FOR EXAMPLE, THE WINDOWS NT
C              VERSION SETS THE CURRENT DIRECTORY TO THE DIRECTORY
C              WHERE THE DATAPLOT EXECUTABLE RESIDES.
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C               HOST DEPENDENT
C     VERSION NUMBER--97.8
C     ORIGINAL VERSION--AUGUST     1997.
C
C-----NON-COMMON VARIABLES -------------------------------------------
C
      USE MSFLIB
      LOGICAL ISTATUS
      CHARACTER*4 IANS
      CHARACTER*4 IANSLC
C
      CHARACTER*4 ITEXTE
      CHARACTER*4 ITEXTF
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
C
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IFUNC
      CHARACTER*4 IREPCH
C
      DIMENSION IANS(*)
      DIMENSION IANSLC(*)
C
      PARAMETER(MAXCH=256)
      DIMENSION ITEXTE(MAXCH)
      DIMENSION ITEXTF(MAXCH)
      CHARACTER*256 ITEXT2
      CHARACTER*256 ITEXT3
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IFUNC(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.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
C
      IFOUND='NO'
      IERROR='NO'
C
      ITEXT2=' '
      ITEXT3=' '
      J2=0
C
      IF(IBUGD2.EQ.'OFF'.AND.ISUBRO.NE.'CD  ')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH= ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IANS(I),I=1,IWIDTH)
   54 FORMAT('(IANS(I),I=1,IWIDTH) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)NUMNAM
   75 FORMAT('NUMNAM= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO76I=1,NUMNAM
      WRITE(ICOUT,77)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
   77 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)= ',
     1I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   76 CONTINUE
      WRITE(ICOUT,81)IBUGD2,ISUBRO
   81 FORMAT('IBUGD2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)IFOUND,IERROR
   82 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************************************
C               **  STEP 1--                                       **
C               **  EXTRACT THE TEXT STRING FROM THE COMMAND LINE  **
C               *****************************************************
C
C               *****************************************
C               **  STEP 1.1--                         **
C               **  DETERMINE THE COMMAND              **
C               **  (CD)  AND ITS LOCATION             **
C               **  ON THE LINE.                       **
C               **  DETERMINE THE START POSITION       **
C               **  (XSTART) OF THE FIRST CHARACTER    **
C               **  FOR THE STRING TO BE PRINTED.      **
C               *****************************************
C
C  CHECK FOR "CD" FIRST
C
      DO1115I=1,IWIDTH-1
C
      ISTART=I+2
      IF(IANS(I).EQ.'C'.AND.IANS(I+1).EQ.'D'.AND.
     1IANS(I+2).EQ.' ')GOTO1190
 1115 CONTINUE
C
C  NO MATCH
C
 1180 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('***** ERROR IN DPCD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('      COMMAND NOT EQUAL CD')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 1.2--                                       **
C               **  DEFINE THE STOP  POSITION (ISTOP) FOR THE STRING.**
C               *******************************************************
C
      IFOUND='YES'
C
      ISTOP=0
      IF(ISTART.GT.IWIDTH)GOTO1229
      DO1220I=ISTART,IWIDTH
      IREV=IWIDTH-I+ISTART
      IF(IANS(IREV).NE.' ')GOTO1225
 1220 CONTINUE
      GOTO1229
 1225 CONTINUE
      ISTOP=IREV
 1229 CONTINUE
C
C               *****************************************
C               **  STEP 1.3--                         **
C               **  COPY OVER THE STRING OF INTEREST.  **
C               *****************************************
C
      IF(ISTART.GT.ISTOP)GOTO1380
      IF(ISTOP.EQ.0)GOTO1380
      ITEMP=ISTOP-ISTART+1
      IF(ITEMP.GT.MAXCH)ITEMP=MAXCH
      ISTOP=ISTART+ITEMP-1
C
      J=0
      DO1310I=ISTART,ISTOP
      J=J+1
      J2=J
      ITEXTE(J)=IANS(I)
      ITEXTF(J)=IANSLC(I)
 1310 CONTINUE
      NCTEX=J2
      GOTO1390
 1380 CONTINUE
      NCTEX=0
 1390 CONTINUE
C
C               ******************************************************
C               **  STEP 1.4--                                    **
C               **  CALL THE SUBROUTINE DPREPL                      **
C               **  WHICH WILL SCAN THE STRING FOR ALL OCCURRANCES  **
C               **  OF THE SUBSTRING VALU()                         **
C               **  AND REPLACE THEM BY THEIR LITERAL VALUES.       **
C               ******************************************************
C
      NCTEXT=NCTEX
      IF(NCTEXT.GE.1)CALL DPREPL(ITEXTE,NCTEXT,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGD2,IERROR)
      IF(NCTEXT.LT.1)GOTO1590
      DO1510I=1,NCTEXT
      ITEXT2(I:I)=ITEXTE(I)(1:1)
 1510 CONTINUE
 1590 CONTINUE
C
      NCTEXT=NCTEX
CCCCC IF(NCTEXT.GE.1)CALL DPREPL(ITEXTF,NCTEXT,
CCCCC1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
CCCCC1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
CCCCC1IBUGD2,IERROR)
      IF(NCTEXT.LT.1)GOTO1690
      DO1610I=1,NCTEXT
      ITEXT3(I:I)=ITEXTF(I)(1:1)
 1610 CONTINUE
 1690 CONTINUE
C
C               ********************************
C               **  STEP 2--                  **
C               **  STEP THROUGH EACH HOST    **
C               ********************************
C
      IF(IHOST1.EQ.'NVE')GOTO2100
      IF(IHOST1.EQ.'VAX')GOTO2200
      IF(IOPSY1.EQ.'UNIX')GOTO2300
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO2400
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO2500
      GOTO8000
C
C     *********************************************************
C     *  CDC - NOS/VE OPERATING CD  EM.  USE "SCLCMD" TO PASS *
C     *  COMMANDS TO THE OPERATING CD  EM.                    *
C     *  DATAPLOT WILL DO NO ERROR CHECKING ON THE COMMAND    *
C     *********************************************************
C
 2100 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPCD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)
 2112 FORMAT('      THE INTERFACE TO CD OPERATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      HAS NOT YET BEEN IMPLEMEMNTED FOR THE ',
     1'NOS/VE VERSION')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C     *********************************************************
C     *  VAX/VMS - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
 2200 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPCD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE INTERFACE TO CD OPERATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      HAS NOT YET BEEN IMPLEMEMNTED FOR THE ',
     1'VAX/VMS VERSION')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C     *********************************************************
C     *  UNIX    -                                            *
C     *********************************************************
C
 2300 CONTINUE
      IRESLT=.TRUE.
CUNIX IRESLT=CHDIR(ITEXT3)
      IF(IRESLT)THEN
        WRITE(ICOUT,2301)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,2301)ITEXT3(1:80)
        CALL DPWRST('XXX','BUG')
      ELSE
        WRITE(ICOUT,2303)
        CALL DPWRST('XXX','BUG')
      ENDIF
 2301 FORMAT('THE CURRENT DIRECTORY HAS BEEN CHANGED TO ')
 2302 FORMAT(A80)
 2303 FORMAT('*****WARNING: DATAPLOT WAS UNSUCCESSFUL IN CHANGING',
     1' THE CURRENT DIRECTORY')
      GOTO9000
C
C     *********************************************************
C     *  IBM/PC 386 - OTG COMPILER                            *
C     *********************************************************
C
 2400 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2411)
 2411 FORMAT('***** ERROR IN DPCD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2412)
 2412 FORMAT('      THE INTERFACE TO CD OPERATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2413)
 2413 FORMAT('      HAS NOT YET BEEN IMPLEMEMNTED FOR THE OTG VERSION')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C     *********************************************************
C     *  IBM/PC 386 - MICROSOFT WINDOWS 95/NT COMPILER        *
C     *********************************************************
C
 2500 CONTINUE
      ISTATUS=.TRUE.
      DO2510I=1,NCTEXT
        ISTART=I
        IF(ITEXT3(I:I).NE.' ')GOTO2519
 2510 CONTINUE
 2519 CONTINUE
      DO2520I=NCTEXT,1,-1
        ISTOP=I
        IF(ITEXT3(I:I).NE.' ')GOTO2529
 2520 CONTINUE
 2529 CONTINUE
      ISTATUS=CHANGEDIRQQ(ITEXT3(ISTART:ISTOP))
      IF(ISTATUS)THEN
        WRITE(ICOUT,2501)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,2502)ITEXT3(1:80)
        CALL DPWRST('XXX','BUG')
      ELSE
        WRITE(ICOUT,2503)
        CALL DPWRST('XXX','BUG')
      ENDIF
 2501 FORMAT('THE CURRENT DIRECTORY HAS BEEN CHANGED TO ')
 2502 FORMAT(5X,A80)
 2503 FORMAT('*****WARNING: DATAPLOT WAS UNSUCCESSFUL IN CHANGING',
     1' THE CURRENT DIRECTORY')
      GOTO9000
C
C
C     *********************************************************
C     *  OTHER   - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
CCCCC THE FOLLOWING SECTION WAS AUGMENTED    APRIL 1992
 8000 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('***** ERROR IN DPCD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)
 8012 FORMAT('      THE INTERFACE TO CD OPERATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8013)
 8013 FORMAT('      HAS NOT YET BEEN DONE FOR THIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8014)
 8014 FORMAT('      COMPUTER/MODEL/OP-SYS/COMPILER/SITE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8021)IHOST1
 8021 FORMAT(' HOST     = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8022)IHMOD1
 8022 FORMAT(' MODEL    = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8023)IOPSY1
 8023 FORMAT(' OP-SYS   = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8024)ICOMPI
 8024 FORMAT(' COMPILER = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8025)ISITE
 8025 FORMAT(' SITE     = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF'.AND.ISUBRO.NE.'CD  ')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NCTEX
 9015 FORMAT('NCTEX  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(ITEXTE(I),I=1,NCTEX)
 9016 FORMAT('(ITEXTE(I),I =1,NCTEX) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)NCTEXT
 9017 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)(ITEXT2(J:J),J=1,NCTEXT)
 9018 FORMAT('(ITEXT2(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IBUGD2,ISUBRO
 9031 FORMAT('IBUGD2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IFOUND,IERROR
 9032 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)IREPCH
 9041 FORMAT('IREPCH = ',A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPFLSH(IUNIT,IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--ENTER A "FLUSH" COMMAND TO CLEAR STANDARD OUTPUT.
C              NEEDED BY FRONT-END TO GET RID OF EXPECT CODE.
C
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/FLSHEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C               HOST DEPENDENT
C     VERSION NUMBER--98.1
C     ORIGINAL VERSION--JANUARY    1998.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      USE PORTLIB
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.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
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF'.AND.ISUBRO.NE.'FLSH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPFLSH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)IBUGD2,ISUBRO
   81 FORMAT('IBUGD2,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)IFOUND,IERROR
   82 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************
C               **  STEP 2--                  **
C               **  STEP THROUGH EACH HOST    **
C               ********************************
C
      IF(IHOST1.EQ.'NVE')GOTO2100
      IF(IHOST1.EQ.'VAX')GOTO2200
      IF(IHOST1.EQ.'IBM-'.AND.IOPSY1.EQ.'OS38')GOTO2400
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'OTG ')GOTO2400
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO2500
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'LAHE')GOTO2600
      IF(IOPSY1.EQ.'UNIX')GOTO2300
      GOTO8000
C
C     *********************************************************
C     *  CDC - NOS/VE OPERATING SYSTEM.                       **
C     *********************************************************
C
 2100 CONTINUE
      GOTO9000
C
C     *********************************************************
C     *  VAX/VMS - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
 2200 CONTINUE
      GOTO9000
C
C     *********************************************************
C     *  UNIX    -                                            *
C     *********************************************************
C
 2300 CONTINUE
CUNIX CALL FLUSH(IUNIT)
      GOTO9000
C
C     *********************************************************
C     *  IBM/PC 386 - OTG COMPILER                            *
C     *********************************************************
C
 2400 CONTINUE
      GOTO9000
C
C     *********************************************************
C     *  IBM/PC 386 - MS-FORTRAN COMPILER                      *
C     *********************************************************
C
 2500 CONTINUE
      CALL FLUSH(IUNIT)
      GOTO9000
C
C     *********************************************************
C     *  IBM/PC 386 - LAHEY      COMPILER                      *
C     *********************************************************
C
 2600 CONTINUE
CLAHE CALL FLUSH(IUNIT)
      GOTO9000
C
C
C     *********************************************************
C     *  OTHER   - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
CCCCC THE FOLLOWING SECTION WAS AUGMENTED    APRIL 1992
 8000 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('***** ERROR IN DPFLSH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)
 8012 FORMAT('      THE INTERFACE TO FLUSH OPERATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8013)
 8013 FORMAT('      HAS NOT YET BEEN DONE FOR THIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8014)
 8014 FORMAT('      COMPUTER/MODEL/OP-SYS/COMPILER/SITE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8021)IHOST1
 8021 FORMAT(' HOST     = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8022)IHMOD1
 8022 FORMAT(' MODEL    = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8023)IOPSY1
 8023 FORMAT(' OP-SYS   = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8024)ICOMPI
 8024 FORMAT(' COMPILER = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8025)ISITE
 8025 FORMAT(' SITE     = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF'.AND.ISUBRO.NE.'FLSH')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPFLSH--')
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      REAL FUNCTION RANLP(IDUM)
C
      INTEGER TABPTJ
      INTEGER ITABLE(98)
C   LEWIS-PAYNE GFSR UNIFORM RANDOM NUMBER GENERATOR
C
C  T. G. LEWIS & W. H. PAYNE (1973) GENERALIZED FEEDBACK SHIFT REGISTER
C   PSEUDORANDOM NUMBERS, JOURNAL OF THE ACM, VOLUME 20, PP. 456-468
C
C  USES PRIMITIVE TRINOMIAL WITH P=98 AND Q=27
C
C  ARGUMENT IS A DUMMY AND NEVER USED
C
C  THE USE OF THE "IEOR" FUNCTION IS NOT STANDARD IN THE
C  FORTRAN 77 (IS STANDARD FOR FORTRAN 90), SO PLACE IN DP1.FOR
C  FILE IN CASE IT NEEDS MODIFICATION.
C
C  THIS IS FORTRAN 77 IMPLEMENTATION OF A FORTRAN 95 CODE
C  FOUND IN MONAHAN (2001), "NUMERICAL METHODS OF STATISTICS",
C  CAMBRIDGE UNIVERSITY PRESS.
C
      INTEGER IDUM
C  PARAMETERS OF TAUSWORTHE SEQUENCE
      INTEGER P
      INTEGER Q 
      INTEGER K
      REAL    FN
C
      SAVE TABPTJ
      SAVE ITABLE
C
      DATA P /98/
      DATA Q /27/
      DATA TABTJ /0/
C  FN = 2**31
      DATA FN / 2147483648. /
C
      DATA ITABLE /346256726,591599773,1943131421,1173234223,
     & 1776849374,1119416586,172236044,985756773,1554281477,
     & 1503137291,650397619,1618395655,639939067,1448259547,
     & 1046853128,659170036,1034934222,279813371,326930100,
     & 367002640,648480182,1909733845,618563844,845531267,
     & 292262469,299413367,2139821356,1005803337,390139420,
     & 1161028423,2034360736,334070487,565633315,124796253,
     & 2104169336,2009751844,1999687407,83223028,1591328966,
     & 646701838,1935362333,795013136,680356918,1771711842,
     & 1324935502,1869840308,356745634,1061920662,614951490,
     & 261876461,703987800,797463948,178239686,1641708282,
     & 1539695556,1334926802,940547749,1957646566,1878491364,
     & 2033904942,1711106005,2138438575,647734238,1555990485,
     & 1210108489,1793192836,1819829578,751843064,345621400,
     & 575445974,1640918761,1379191461,1617832156,542966103,
     & 1305854952,1476721677,1466811698,1842260101,1666639833,
     & 217007402,685228354,902087789,32432242,789712994,702791444,
     & 1081111755,1572116899,321512624,644413114,863989644,
     & 1348681739,84379947,1955819746,941474606,984690559,
     & 1794209263,1704575856,1253913135 /
C
C  START EXECUTABLE CODE
C
C                   UPDATE POINTER
C
      TABPTJ = TABPTJ + 1                                                   
      IF(TABPTJ.GT.P) TABPTJ = 1
C
C                   UPDATE DELAY POINTER
C
      K = TABPTJ + Q                                                        
      IF(K.GT.P) K = K - P                                                 
C
C                   COMPUTE EXCLUSIVE OR OF TWO TABLE ENTRIES
C                    AND REPLACE WITH NEW ONE
C
      ITABLE(TABPTJ) = IEOR( ITABLE(K), ITABLE(TABPTJ) )                                                   
C
C                   CONVERT BIG INTEGER TO FLOATING POINT NUMBER
C
      RANLP = REAL( ITABLE(TABPTJ) ) / FN
C
      RETURN
      END
      REAL FUNCTION RANFT(IDUM)
C
      INTEGER TABPTJ
      INTEGER ITABLE(521)
C
!   FUSHIMI-TEZUKA GFSR UNIFORM RANDOM NUMBER GENERATOR
!
!  USES PRIMITIVE TRINOMIAL WITH P=521 AND Q=32 AS USED BY BRIGHT &
!   ENISON AND ARVILLIAS & MARITSAS BUT WITH RANDOM SEED MATRIX
!  FUSHIMI & TEZUKA GIVE RULES FOR TESTING K-DISTRIBUTION OF
!   SEQUENCE -- THE ORIGINAL SEED TABLE HAS BEEN CHECKED AND
!   31 BIT NUMBERS ARE 16-DISTRIBUTED (BEST POSSIBLE)
!
!  M. FUSHIMI & S. TEZUKA (1983) THE K-DISTRIBUTION OF GENERALIZED
!   FEEDBACK SHIFT REGISTER PSEUDORANDOM NUMBERS, COMMUNICATIONS OF
!   THE ACM, VOLUME 26, NUMBER 7, PP. 516-523
!
C  ARGUMENT IS A DUMMY AND NEVER USED
C
C  THE USE OF THE "IEOR" FUNCTION IS NOT STANDARD IN THE
C  FORTRAN 77 (IS STANDARD FOR FORTRAN 90), SO PLACE IN DP1.FOR
C  FILE IN CASE IT NEEDS MODIFICATION.
C
C  THIS IS FORTRAN 77 IMPLEMENTATION OF A FORTRAN 95 CODE
C  FOUND IN MONAHAN (2001), "NUMERICAL METHODS OF STATISTICS",
C  CAMBRIDGE UNIVERSITY PRESS.
C
      INTEGER IDUM
C  PARAMETERS OF TAUSWORTHE SEQUENCE
      INTEGER P
      INTEGER Q 
      INTEGER K
      REAL    FN
C
      SAVE TABPTJ
      SAVE ITABLE
C
      DATA P /521/
      DATA Q /32/
      DATA TABTJ /0/
C  FN = 2**31
      DATA FN / 2147483648. /
C
      DATA (ITABLE(I),I=1,18)/
     &  1464221660, 1158328647, 1090310074,
     &  363453867, 1125650601, 1626204584, 
     &  596067919,  102301378, 1392342446,
     & 2117672210, 1470351739, 1107351344,
     & 1160753706, 1046087394,  142212969,
     &   24070872,  832220068, 561689965/
      DATA (ITABLE(I),I=19,36)/
     & 2132613190, 1327815900, 2099255323,
     & 1175377098, 2008300980, 1514090961,
     & 1793048224,  123482417,  899779517,
     & 14500045, 1036604204, 1819512164,
     & 373807068, 1185724401, 1969247094,
     & 117941294,  111922077, 2026157014/
      DATA (ITABLE(I),I=37,54)/
     &  972743819,  112361322,  818613141,
     & 1650818105, 1958655142, 340146731,
     &  244639603, 1374107263,  581629403,
     &   99815077,  407270832, 970490435,
     &  894442080,  502509560, 1772474916,
     &   92762028, 2125760521, 2119124955/
      DATA (ITABLE(I),I=55,72)/
     &  116833190,  815370972,  846774897,
     &  371565210,   14038994, 1877654635,
     &  469257780, 1255556676,  966738110,
     &  106141568, 1509906366, 182036763,
     & 1475162413,  355970676, 2057194637, 
     & 783547359,  710739309, 1091521749/
      DATA (ITABLE(I),I=73,90)/
     & 1400722769, 1231840169, 1795363303,
     &  378309524, 1696574748, 43924770,
     & 1656718469,  194341481, 2122127727,
     & 1192298313,  787836434, 1930262483,
     & 2033580199, 1180162588,  833652824,
     & 1019699940, 1177388520, 1454532182/
      DATA (ITABLE(I),I=91,108)/
     & 1516029073,    7158256, 49724360, 
     & 346179837,  711320736, 126147103,
     &  588000532, 1952681477,  872490485,
     &  929239679, 1230203969, 65553667,
     &  101370358,  777074835, 1448694438,
     & 37829780,  149952948, 1260879105/
      DATA (ITABLE(I),I=109,126)/
     &  226489139, 1261936689,  821434251,
     & 1820573641, 1034181831, 1908878446,
     & 1261839389, 1333596798,  474560247,
     &  179806371,  496186068, 720243575,
     & 1915930533, 1674665013, 1174195909,
     & 1483410280, 1538917937, 300722691/
      DATA (ITABLE(I),I=127,144)/
     & 1217246246, 1328435200, 1770412188,
     & 1931714531,  668347171, 1571429187, 
     & 1256455103, 1034215170,  321723372,
     & 1988373705, 1603828968, 338728032,
     &   22885627,  239160176, 1623174495,
     & 1208969624, 1809686301, 586768446/
      DATA (ITABLE(I),I=145,162)/
     &  572364898, 1157585773, 1489728638,
     &  357378493, 2096054839, 1071933685,
     &  749129112, 2063846670,  915116346,
     &   82547408, 99850294, 999162951,
     & 1757081564, 1222216251, 1107447002,
     &  620994065,  276726035, 1632374490/
      DATA (ITABLE(I),I=163,180)/
     & 1214463005, 1795143947,  986560526,
     &  401521995,  986551091, 242947950,
     &  859782703, 2097912305,   78110042,
     &  682967577,  335973424, 970829205,
     &  145698529,  623819323,  516197007,
     & 2036646416, 1174464179, 1697256876/
      DATA (ITABLE(I),I=181,198)/
     &  771031831,  815657619, 1369483732,
     &  183355178,   11443201, 1199834624,
     &  749080238, 1242421352, 1392163283,
     & 1253963316, 2104424001, 2146002364,
     &  873880383,  666935248, 1463559443,
     &  765865763, 2036382270, 1029929651/
      DATA (ITABLE(I),I=199,216)/
     & 1309449537,  505953903, 1679489248,
     &  650734968, 1915876652, 769087046,
     &  341910829, 1976547278,  405565903,
     &  233036143, 1775766920, 1734382081,
     & 1964094636, 1567409215,  264778756,
     &  550435508, 1957515327, 510628849/
      DATA (ITABLE(I),I=217,234)/
     &  794411731,  772129518, 2084613852,
     &  2056793406,  482508883, 628545509,
     &  492310170,    2535299, 1808581000,
     & 1337327362,  897123632, 474197437,
     &  524509642,   13182159,  361730672,
     & 81199647, 1070351284, 2071002916/
      DATA (ITABLE(I),I=235,252)/
     &  931058636, 1736643210, 1312184093,
     & 1368480008,  493635086, 795562041,
     &  778036865,  437663472,  678482929,
     &  124422133, 1661200800, 366950953,
     & 1919116534, 1534692645,  153200398,
     &    6196433, 1064234375, 195844762/
      DATA (ITABLE(I),I=253,270)/
     & 1617967730, 1745699796, 1054886058,
     & 1992470821, 1744580876, 1576550441,
     & 1430025201, 1944059630, 1993995952,
     & 1607653829,  198657449, 1646157905,
     &  944085034, 1627982402,  411083987,
     &  633677110,  839782297, 958537595/
      DATA (ITABLE(I),I=271,288)/
     & 1866523018,  211248150,  657188559,
     &  859714592,  953170728, 1859902523,
     &  609738329,   80132019,  306596664,
     & 1156862695, 74374927, 183915535,
     &  839428712, 1458285441,  172543676,
     &  838639082, 1071875913, 1925638755/
      DATA (ITABLE(I),I=289,306)/
     & 1631994995, 1278741481, 1939215638,
     &   37917347, 1621691517, 2054362142,
     &  422444128,  437522314,  453524070,
     &  959581287,   80501639, 76349063,
     & 1150964582, 1876521145,  746044173,
     & 1754884425,  802123077, 1527702920/
      DATA (ITABLE(I),I=307,324)/
     &  788492908,   78719119,  182306481,
     & 1713345545,  590352192, 674841804,
     & 1205060021,  525498090, 1593642166,
     &  927838578, 1304219579, 652879324,
     & 1448845945,  436724282, 2073385775,
     &  177580556, 1741619009, 1188575653/
      DATA (ITABLE(I),I=325,342)/
     &  498115577,  937246633,  511610086,
     &  106192814,  223714241, 1868866237,
     &  939024237,  323029456,  317407376, 
     & 316389284,  385186216, 1309020254,
     & 1880929110, 1816267930, 1682541052,
     &  402797268,  945227932, 1509316265/
      DATA (ITABLE(I),I=343,360)/
     & 1001627491,  228932404, 1523702251,
     &  121242082, 1901174818, 635982413,
     &  930304172, 1941268644,  183050837,
     & 1338834955,  465435419, 1437644759,
     & 1156952116, 1577273674,  700500350,
     &  804029596, 1358313048, 1416230126/
      DATA (ITABLE(I),I=361,378)/
     & 2018467981,  592185008, 1414209258,
     &  265994210, 1651218063, 90814660,
     & 1608601250, 1089576667,  921984300,
     & 1695616995, 1126839275, 129412032,
     & 1774571060,  962915884,  290498596,
     & 1179573341, 1667596730, 489164113/
      DATA (ITABLE(I),I=379,396)/
     &  813846475,  994357582,  450139720,
     & 2060869306,  266683479, 350860264,
     & 2065846033,  158671935, 1772005618,
     &  795205130, 1221884629, 1976326989,
     &  998135974, 1676548301,  614362620,
     &  491179564,  327793080, 922741005/
      DATA (ITABLE(I),I=397,414)/
     & 1528656048, 1775329675,  828056307,
     & 1448319189,  173470778, 1388056867,
     &  956906308,  219286173,  460771359,
     &  358199631,  864535676, 376750930,
     & 1271089154,   28090922, 1825207361,
     & 1603702579,  361991756, 174271141/
      DATA (ITABLE(I),I=415,432)/
     & 1954855926,  911232829, 1384270246,
     & 1739676571,  754274892, 502141603,
     & 2030672558, 1703564182, 1551225070,
     &  988276910, 1331500472, 1748831164,
     & 2144180506,  318684035,  298360627,
     &  172742244, 2028487811, 1491743352/
      DATA (ITABLE(I),I=433,450)/
     & 2006421986, 2146093508,  258253944,
     &  409586221, 1230527712, 1211734974,
     & 1042283517,  634961640,  954041537,
     & 1463203857, 1231982802, 2045112487,
     & 1729798774,   94381532, 1427476838,
     & 2063395629, 1924404847, 221056062/
      DATA (ITABLE(I),I=451,468)/
     &  142524724,  968769863, 2041559534,
     & 2144859819,  998479391, 1005906879,
     & 1285646169, 2022189916,  869720790,
     & 1623616048,   40216307, 1605606591,
     &  150466735, 1306162626, 1097415548,
     & 1673554800, 1842198841, 1564181888/
      DATA (ITABLE(I),I=469,486)/
     & 1857668689, 1720395937,  974689951,
     &  608747141,  601104479, 999903065,
     & 1311275680, 1133168246, 1273728926,
     & 1445065986, 1331462779, 1115324913,
     & 2028541775,  251232653,  514348969,
     & 1041442808, 1537551006, 949033491/
      DATA (ITABLE(I),I=487,504)/
     & 1044836968,  601139657, 1591139711,
     & 1818750333,  454615333, 2120569352,
     &  770493452,  357056354,  976831960,
     &  102270405,  871779235, 1860162811,
     &  689431451, 1600121392,  302523963,
     & 1426453692, 2047249983, 1147472047/
      DATA (ITABLE(I),I=505,521)/
     & 1159543869,   39709758, 1681972136,
     & 1578444291, 1047707446, 1600623169,
     &  145955414,  646318224,  698104242,
     & 1334831733, 1902759969, 1507811506,
     & 1480946742,  936424064, 1719078432,
     &  306219886, 1266805790/
C
C  START EXECUTABLE CODE
C
C                   UPDATE POINTER
C
      TABPTJ = TABPTJ + 1                                                   
      IF(TABPTJ.GT.P) TABPTJ = 1
C
C                   UPDATE DELAY POINTER
C
      K = TABPTJ + Q                                                        
      IF(K.GT.P) K = K - P                                                 
C
C                   COMPUTE EXCLUSIVE OR OF TWO TABLE ENTRIES
C                    AND REPLACE WITH NEW ONE
C
      ITABLE(TABPTJ) = IEOR( ITABLE(K), ITABLE(TABPTJ) )                                                   
C
C                   CONVERT BIG INTEGER TO FLOATING POINT NUMBER
C
      RANFT = REAL( ITABLE(TABPTJ) ) / FN
C
      RETURN
      END
      SUBROUTINE IQWNHE(CHECKED)
C
C  CALL BACK ROUTINE FOR WHEN THE "USING HELP" MENU ITEM IS
C  SELECTED.
C
      USE DFLIB
      LOGICAL CHECKED
      INTEGER IRET
C
      IRET=MESSAGEBOXQQ(
     1'To access Dataplot help, enter the command HELP'C,
     1'Dataplot Help'C,
     1MB$OK)
C
      RETURN
      END
      SUBROUTINE IQWNBR(CHECKED)
C
C  CALL BACK ROUTINE FOR WHEN THE "HELP CONTENTS" MENU ITEM
C  SELECTED.
C
      USE DFLIB
      USE DFWIN
      LOGICAL CHECKED
      INTEGER IRET
C
      IRET=MESSAGEBOXQQ(
     1'If you click OK, Dataplot will try to connect to the '//
     1'Dataplot Reference Manual at the NIST web site (using '//
     1'Internet Explorer).  Alternatively, you can use the,'//
     1'Dataplot WEB HELP command (WEB HELP allows you to '//
     1'specify a local site (if you have the installed a copy '//
     1'the Dataplot web pages locally) or a different browser '//
     1'(e.g., Netscape).  Enter HELP WEB HELP for details.'C,
     1'Accesing the On-line Dataplot Reference Manual'C,
     1MB$OKCANCEL)
C
      IF(IRET.EQ.MB$IDOK)THEN
        IRET=WinExec('Explorer.exe '//
     1       'http://www.itl.nist.gov/div898/'//
     1       'software/dataplot/document.htm'C,
     1       SW_SHOW)
      ENDIF
C
      RETURN
      END
      Subroutine R250IN(iseed)
C ===================================================================
C
C  R250, call R250IN with the desired initial seed BEFORE
C  the first invocation of RND250()
C
C ===================================================================

      Integer k, mask, msb
      Integer indexf, indexb, buffer(250)
      Common/R250CM/indexf,indexb,buffer
      Integer msbit, allbit, hlfrng, step
      Parameter ( msbit = Z'40000000')
      Parameter ( hlfrng = Z'20000000' )
      Parameter ( allbit = Z'7FFFFFFF' )
      Parameter ( step = 7 )
C
      indexf = 1
      indexb = 104
      k = iseed
      Do 10 i = 1, 250
         buffer(i) = lcmrnd( k )
         k = -1
  10  Continue
      Do 20 i = 1, 250
         if ( lcmrnd( -1 ) .gt. hlfrng ) then
            buffer(i) = ior( buffer(i), msbit )
         endif
 20   Continue
C
      msb = msbit
      mask = allbit
C
      Do 30 i = 0,30
         k = step * i + 4
         buffer(k) = iand( buffer(k), mask )
         buffer(k) = ior( buffer(k), msb )
         msb = msb / 2
         mask = mask / 2
  30  Continue
      Return
      END
      Function rnd250()
C
C R250.F77     The R250 Pseudo-random number generator
C
C algorithm from:
C Kirkpatrick, S., and E. Stoll, 1981; A Very Fast Shift-Register
C Sequence Random Number Generator, Journal of Computational Physics,
C V. 40. p. 517
C
C 
C see also:
C Maier, W.L., 1991; A Fast Pseudo Random Number Generator,
C                    Dr. Dobb's Journal, May, pp. 152 - 157
C
C 
C Uses the Linear Congruential Method,
C the "minimal standard generator"
C Park & Miller, 1988, Comm of the ACM, 31(10), pp. 1192-1201
C for initialization
C
C
C For a review of BOTH of these generators, see:
C Carter, E.F, 1994; Generation and Application of Random Numbers,
C Forth Dimensions, Vol. XVI, Numbers 1,2 May/June, July/August
C
C     R250 PRNG, run after R250_Init
      Integer newrnd
      Integer indexf, indexb, buffer(250)
      Common/R250CM/indexf, indexb,buffer
C
      newrnd = ieor( buffer(indexf), buffer(indexb) )
      buffer(indexf) = newrnd
C
      indexf = indexf + 1
      if ( indexf .gt. 250 ) indexf = 1
C
      indexb = indexb + 1
      if ( indexb .gt. 250 ) indexb = 1
C
      rnd250= newrnd
C
      return
      End
      subroutine sgrnd(seed)
*
      implicit integer(a-z)
*
* Period parameters
      parameter(N     =  624)
*
      dimension mt(0:N-1)
*                     the array for the state vector
      common /mtblock/mti,mt
      save   /mtblock/
*
*      setting initial seeds to mt[N] using
*      the generator Line 25 of Table 1 in
*      [KNUTH 1981, The Art of Computer Programming
*         Vol. 2 (2nd Ed.), pp102]
*
      mt(0)= iand(seed,-1)
      do 1000 mti=1,N-1
        mt(mti) = iand(69069 * mt(mti-1),-1)
 1000 continue
*
      return
      end
************************************************************************
      double precision function grnd()
*
      implicit integer(a-z)
*
* Period parameters
      parameter(N     =  624)
      parameter(N1    =  N+1)
      parameter(M     =  397)
      parameter(MATA  = -1727483681)
*                                    constant vector a
      parameter(UMASK = -2147483648)
*                                    most significant w-r bits
      parameter(LMASK =  2147483647)
*                                    least significant r bits
* Tempering parameters
      parameter(TMASKB= -1658038656)
      parameter(TMASKC= -272236544)
*
      dimension mt(0:N-1)
*                     the array for the state vector
      common /mtblock/mti,mt
      save   /mtblock/
      data   mti/N1/
*                     mti==N+1 means mt[N] is not initialized
*
      dimension mag01(0:1)
      data mag01/0, MATA/
      save mag01
*                        mag01(x) = x * MATA for x=0,1
*
      TSHFTU(y)=ishft(y,-11)
      TSHFTS(y)=ishft(y,7)
      TSHFTT(y)=ishft(y,15)
      TSHFTL(y)=ishft(y,-18)
*
      if(mti.ge.N) then
*                       generate N words at one time
        if(mti.eq.N+1) then
*                            if sgrnd() has not been called,
          call sgrnd(4357)
*                              a default initial seed is used
        endif
*
        do 1000 kk=0,N-M-1
            y=ior(iand(mt(kk),UMASK),iand(mt(kk+1),LMASK))
            mt(kk)=ieor(ieor(mt(kk+M),ishft(y,-1)),mag01(iand(y,1)))
 1000   continue
        do 1100 kk=N-M,N-2
            y=ior(iand(mt(kk),UMASK),iand(mt(kk+1),LMASK))
            mt(kk)=ieor(ieor(mt(kk+(M-N)),ishft(y,-1)),mag01(iand(y,1)))
 1100   continue
        y=ior(iand(mt(N-1),UMASK),iand(mt(0),LMASK))
        mt(N-1)=ieor(ieor(mt(M-1),ishft(y,-1)),mag01(iand(y,1)))
        mti = 0
      endif
*
      y=mt(mti)
      mti=mti+1
      y=ieor(y,TSHFTU(y))
      y=ieor(y,iand(TSHFTS(y),TMASKB))
      y=ieor(y,iand(TSHFTT(y),TMASKC))
      y=ieor(y,TSHFTL(y))
*
      if(y.lt.0) then
        grnd=(dble(y)+2.0d0**32)/(2.0d0**32-1.0d0)
      else
        grnd=dble(y)/(2.0d0**32-1.0d0)
      endif
*
      return
      end
      SUBROUTINE DPPID(IPID,IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--RETURN THE PROCESS-ID.
C     WRITTEN BY--ALAN HECKERT
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           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C               HOST DEPENDENT
C     VERSION NUMBER--2006.3
C     ORIGINAL VERSION--MARCH      2006.
C
C-----NON-COMMON VARIABLES (GRAPHICS)---------------------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.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
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'PPID')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPPID--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,81)IBUGS2,ISUBRO
   81   FORMAT('IBUGS2,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,82)IFOUND,IERROR
   82   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IFOUND='YES'
      CALL DPPID2(IPID,ISUBRO,IERROR)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)IPID
 1011 FORMAT('***** PROCESS ID: ',I8,' SAVED IN INTERNAL ',
     1       'PARAMETER   PID')
      CALL DPWRST('XXX','BUG ')
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'PPID')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPPID--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9021)IPID
 9021   FORMAT('IPID = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9031)IBUGS2,ISUBRO
 9031   FORMAT('IBUGS2,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9032)IFOUND,IERROR
 9032   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPPID2(IPID,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE IS USED BY DPPID (AND POSSIBLY BY A
C              FEW OTHER ROUTINES) TO EXTRACT THE PROCESS ID.
C              THE PRIMARY USE OF THIS IS BUILDING UNIQUE FILE
C              NAMES.  HOWEVER, DATAPLOT USERS CAN USE IT FOR
C              WHATEVER PURPOSE THEY NEED.
C     TO THE IMPLEMENTER--
C              THIS IS A PLATFORM/COMPILER DEPENDENT ROUTINE,
C              SO YOU MAY NEED TO MODIFY IT FOR YOUR LOCAL
C              INSTALLATION.  IF IS CURRENTLY IMPLEMENTED FOR
C              INTEL COMPILER UNDER WINDOWS AND FOR THE g77
C              COMPILER UNDER UNIX.
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C               HOST DEPENDENT
C     VERSION NUMBER--2006.3
C     ORIGINAL VERSION--MARCH      2006.
C
C-----NON-COMMON VARIABLES (GRAPHICS)--------------------------------
C
      USE PORTLIB
C
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C
      IERROR='NO'
      IPID=0
C
      IF(ISUBRO.EQ.'PID2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPPID2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,59)ISUBRO,IERROR
   59   FORMAT('ISUBRO,IERROR= ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,61)IHOST1,IHOST2
   61   FORMAT('IHOST1,IHOST2 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,62)IHMOD1,IHMOD2
   62   FORMAT('IHMOD1,IHMOD2 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,63)IOPSY1,IOPSY2
   63   FORMAT('IOPSY1,IOPSY2 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,64)ICOMPI,ISITE
   64   FORMAT('ICOMPI,ISITE = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ********************************
C               **  STEP 1--                  **
C               **  STEP THROUGH EACH HOST    **
C               ********************************
C
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')GOTO2600
      IF(IOPSY1.EQ.'UNIX')GOTO2300
      GOTO8000
C
C     *********************************************************
C     *  UNIX.  USE THE LIBRARY ROUTINE "GETPID".             *
C     *********************************************************
C
 2300 CONTINUE
CUNIX IPID=getpid()
      GOTO9000
C
C     *********************************************************
C     *  PC USING INTEL     COMPILER                          *
C     *********************************************************
C
 2600 CONTINUE
      IPID=getpid()
      GOTO9000
C
C
C     *********************************************************
C     *  OTHER   - LEFT TO IMPLEMENTOR                        *
C     *********************************************************
C
 8000 CONTINUE
      WRITE(ICOUT,8010)
 8010 FORMAT(1X,'THE PROCESS IF COMMAND HAS NOT BEEN IMPLEMENTED ',
     1       'AT THIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8020)IHOST1
 8020 FORMAT(1X,'SITE FOR A ',A4,' HOST.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(ISUBRO.EQ.'PID2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPPID2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)IPID
 9015   FORMAT('PROCESS ID  = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPINF2(IFILE,IEXIST,IFWRIT,ISUBN0,IBUGS2,
     1                  ISUBRO,IERRFI)
C
C     PURPOSE--THE DPINFI ROUTINE CHECKS FOR THE EXISTENCE OF A
C              FILE.  THIS ROUTINE IS A SLIGHT VARIATION THAT
C              CHECKS IF THE FILE CAN BE OPENED IN WRITE MODE.
C
C              THE PURPOSE OF THIS IS TO CHECK IF THE PLOT FILES
C              ARE IN USE BY ANOTHER PROCESS.  CURRENTLY UNDER LINUX,
C              IF TWO DATAPLOT SESSIONS ARE RUNNING IN THE SAME
C              DIRECTORY AT THE SAME TIME, BOTH ARE ALLOWED TO WRITE
C              TO THE FILE (I.E., THERE IS NO LOCK ON THE FILE).
C              HOWEVER, UNDER WINDOWS, IF A DATAPLOT SESSION IS
C              ALREADY RUNNING, THEN A SECOND DATAPLOT PROCESS
C              WILL NOT BE ABLE TO OPEN THE FILE IN WRITE MODE
C              (IT WILL IN FACT HANG DATAPLOT).  THIS IS IN
C              PARTICULAR AN ISSUE BECAUSE THE VERSION BUILT WITH
C              THE INTEL COMPILER DOES NOT AUTOMATICALLY CLOSE
C              IF THE GUI IS NOT SHUT DOWN CLEANLY.  IF THIS HAPPENS,
C              WHEN YOU RESTART THE DATAPLOT GUI, THE "DEAD" PROCESS
C              STILL HAS THE PLOT FILE LOCKED AND THE NEW SESSION
C              HANGS.
C
C              NOTE THAT INQUIRING ABOUT THE "WRITE" MODE IS A
C              FORTRAN 90 FEATURE NOT AVAILABLE IN FORTRAN 77.
C              SO FOR NOW, THIS COMMAND IS ONLY ACTIVE UNDER
C              WINDOWS.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C     LANGUAGE--ANSI FORTRAN (1977)
C     ORIGINAL VERSION--MARCH     2006.
C
C---------------------------------------------------------------------
C
      CHARACTER*(*) IFILE
      CHARACTER*4 IEXIST
      CHARACTER*12 IFWRIT
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      LOGICAL LEXIST
C
C-----COMMON------------------------------------------------
C
      INCLUDE 'DPCOHO.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='DPIN'
      ISUBN2='F2  '
C
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'INF2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('*****AT THE BEGINNING OF DPINF2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IFILE
   52   FORMAT('IFILE = ',A80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)ISUBN0
   55   FORMAT('ISUBN0 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,61)IHOST1
   61   FORMAT('IHOST1 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  INQUIRE ABOUT THE EXISTENCE OF A FILE.          **
C               **  IF FILE DOES NOT EXIST, THEN ASSUME THAT IT     **
C               **  IS WRITTABLE.  IF FILE EXISTS, CHECK IF IT      **
C               **  IS A WRITABLE FILE.                             **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'INF2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IEXIST='NO'
      INQUIRE(FILE=IFILE,EXIST=LEXIST)
      IF(LEXIST)IEXIST='YES'
C
      IF(IHOST1.EQ.'IBM-'.AND.ICOMPI.EQ.'MS-F')THEN
        IF(IEXIST.EQ.'NO')THEN
          IFWRIT='YES'
        ELSE
          IFWRIT='YES'
          INQUIRE(FILE=IFILE,WRITE=IFWRIT)
          IF(IFWRIT.EQ.'UNKOWN')IFWRIT='YES'
        ENDIF
      ELSEIF(IOPSY1.EQ.'UNIX')THEN
        IFWRIT='YES'
      ELSE
         IFWRIT='YES'
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'INF2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('*****AT THE END       OF DPINF2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IFILE
 9012   FORMAT('IFILE = ',A80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)IEXIST,IFWRIT
 9014   FORMAT('IEXIST,IFWRIT = ',A4,2X,A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)ISUBN0
 9015   FORMAT('ISUBN0 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)IERRFI
 9016   FORMAT('IERRFI = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9021)IHOST1
 9021   FORMAT('IHOST1 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
