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 'CIBM-' 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 C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IBUGIN 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--------------------------------------------------------------------- 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 CIBM- DATA I2MACH( 1) / 5 / CIBM- DATA I2MACH( 2) / 6 / CIBM- DATA I2MACH( 3) / 6 / CIBM- DATA I2MACH( 4) / 0 / CIBM- DATA I2MACH( 5) / 32 / CIBM- DATA I2MACH( 6) / 4 / CIBM- DATA I2MACH( 7) / 2 / CIBM- DATA I2MACH( 8) / 31 / CIBM- DATA I2MACH( 9) / 2147483647 / CIBM- DATA I2MACH(10) / 2 / CIBM- DATA I2MACH(11) / 24 / CIBM- DATA I2MACH(12) / -125 / CIBM- DATA I2MACH(13) / 128 / CIBM- DATA I2MACH(14) / 53 / CIBM- DATA I2MACH(15) / -1021 / CIBM- DATA I2MACH(16) / 1024 / 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' / CIBM- DATA R2MACH(1) / 1.18E-38 / CIBM- DATA R2MACH(2) / 3.340E+38 / CIBM- DATA R2MACH(3) / 0.59E-07 / CIBM- DATA R2MACH(4) / 1.19E-07 / CIBM- 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' / CIBM- DATA D2MACH(1) / 2.23D-308 / CIBM- DATA D2MACH(2) / 1.790D+308 / CIBM- DATA D2MACH(3) / 1.11D-16 / CIBM- DATA D2MACH(4) / 2.22D-16 / CIBM- 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' / CC CIBM- IHOST1='IBM-' CIBM- IHOST2='PC ' CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1992 CCCCC IN CONNECTION WITH CODE IN DPSYS2.FOR APRIL 1992 CCCCC IHMOD1=' ' CIBM- IHMOD1='386 ' CIBM- IHMOD2=' ' CIBM- IOPSY1='PC-D' CIBM- IOPSY2='OS ' CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1992 CCCCC IN CONNECTION WITH CODE IN DPSYS2.FOR APRIL 1992 CCCCC ICOMPI=' ' CIBM- ICOMPI='OTG ' CIBM- 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 DATA I2MACH( 1) / 5 / DATA I2MACH( 2) / 6 / DATA I2MACH( 3) / 5 / DATA I2MACH( 4) / 7 / DATA I2MACH( 5) / 32 / DATA I2MACH( 6) / 4 / DATA I2MACH( 7) / 2 / DATA I2MACH( 8) / 31 / DATA I2MACH( 9) / 2147483647 / 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 DATA I2MACH(11) / 24 / DATA I2MACH(12) / -124 / DATA I2MACH(13) / 127 / DATA I2MACH(14) / 51 / DATA I2MACH(15) / -1013/ 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, DATA R2MACH(1) / 1.175495E-38 / DATA R2MACH(2) / 3.402823E38 / DATA R2MACH(3) / 1.1920928955078E-7 / DATA R2MACH(4) / 2.3841857910156E-7 / 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, CC SEPTEMBER 1994. FIX D2MACH(3) AND D2MACH(4) (NEED NEGATIVE CC EXPONENT). DATA D2MACH(1) / 2.22507385850721D-308 / DATA D2MACH(2) / 1.79769313486231D308 / DATA D2MACH(3) / 1.1102230246252D-16 / DATA D2MACH(4) / 2.2204460492503D-16 / DATA D2MACH(5) / 0.3010299956639812D0 / CC IHOST1='SUN ' IHOST2=' ' IHMOD1='3 ' IHMOD2=' ' IOPSY1='UNIX' IOPSY2=' ' ICOMPI='f77 ' 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 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 FOR WEB COMMAND 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 --FEBRUARY 1998. DATAPLOT_GUI_IO ENVIRONMENT C VARIABLE C UPDATED --JUNE 1998. CODE FOR NEW LAHEY COMPILER C UPDATED --MARCH 1999. UNIT FOR WEB HANDBOOK COMMAND C UPDATED --MAY 1999. ADDED DPST5F C UPDATED --JANUARY 2004. UNIT FOR CHARACTER DATA C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CMS-F USE MSFLIB 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 CHARACTER*20 IGUII2 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' CCCCC FEBRUARY 1998. ADD FOLLOWING LINE IGUIIO='PIPE' 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 CCCCC FOLLOWING SECTION ADDED FEBRUARY 1998. CCCCC WINDOWS 95 VERSION OF GUI NEEDS SPECIAL CCCCC HANDLING OF TERMINAL I/O FOR TCL/TK SCRIPTS CCCCC TO WORK. THE ENVIRONMENT VARIABLE CCCCC DATAPLOT_GUI_IO CCCCC SPECIFIES WHETHER OR NOT TO DO THIS SPECIAL CODE. C CALL getenv('DATAPLOT_GUI_IO',IGUII2) IF(IGUII2.EQ.'FILE'.OR.IGUII2.EQ.'file')IGUIIO='FILE' C UNIXPV='DATAPLOT_FILES' 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) IF(IPATH1(NCP1:NCP1).NE.'/')THEN NCP1=NCP1+1 IPATH1(NCP1:NCP1)='/' ENDIF 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' 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. UNIXPV='DATAPLOT_WEB' 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 APRIL 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' CALL getenv(UNIXPV,IBROWS) IF(IBROWS.EQ.' ')IBROWS='netscape' C UNIXPV='DATAPLOT_URL' 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' CALL getenv(UNIXPV,IURL) IF(IURL.EQ.' ')IURL(1:20)='http://www.nist.gov/' 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. CCCCC 3) "URL" SET VARIABLE. THIS CCCCC VARIABLE SPECIFIES THE LOCATION OF THE DEFAULT URL TO USE CCCCC FOR THE WEB COMMAND. C ELSE IF(IHOST1.EQ.'IBM-')THEN IF(ICOMPI.EQ.'LAHE')THEN CLAHE IPATH1='C:\DATAPLOT\' NCP1=12 CLAGE ICDIR='C:\FED\' NCEDT1=7 ELSE IF(ICOMPI.EQ.'MS-F')THEN CCCCC FOLLOWING SECTION ADDED FEBRUARY 1998. CCCCC WINDOWS 95 VERSION OF GUI NEEDS SPECIAL CCCCC HANDLING OF TERMINAL I/O FOR TCL/TK SCRIPTS CCCCC TO WORK. THE ENVIRONMENT VARIABLE CCCCC DATAPLOT_GUI_IO CCCCC SPECIFIES WHETHER OR NOT TO DO THIS SPECIAL CODE. C CMS-F IRESLT=GETENVQQ('DATAPLOT_GUI_IO',IGUII2) IF(IGUII2.EQ.'FILE'.OR.IGUII2.EQ.'file')IGUIIO='FILE' C CMS-F IRESLT=GETENVQQ('DATAPLO$',ICDIR) IF(IRESLT.LE.0)THEN CMS-F ICDIR='C:\DATAPLOT\' NCP1=12 NCDIR=12 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 CMS-F IRESLT=GETENVQQ('FED$',ICDIR) IF(IRESLT.EQ.0)THEN CMS-F ICDIR='C:\FED\' NCEDT1=7 NCDIR=7 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=' ' CMS-F IRESLT=GETENVQQ('BROWSER',IBROWS) IF(IRESLT.EQ.0)THEN CMS-F IBROWS(1:45)= CMS-F1'"C:\Program Files\NETSCAPE\NAVIGATOR\PROGRAM\' IBROWS(46:58)='netscape.exe"' ENDIF C CMS-F 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 CMS-F IRESLT=GETENVQQ('URL',IURL) 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 CMS-F ICDIR='C:\FED\' NCEDT1=7 CMS-F IPATH1='C:\DATAPLOT\' NCP1=12 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' IDICCS='CLOSED' C C -------------------- C IREANU=31 IREANA='-999' CCCCC IREAST='UNKNOWN' IREAST='OLD' IREAFO='FORMATTED' IREAAC='SEQUENTIAL' CCCCC IREAPR='READWRITE' IREAPR='READONLY' 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='READONLY' 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' IPL1PR='READWRITE' 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' IPL2PR='READWRITE' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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='READONLY' 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 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 --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 1995. AUTO-READ FROM DP SUB-DIRECTORIES C UPDATED --AUGUST 1996. FIX TO SUB-DIRECTORIES 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 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, 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 CCCCC IFILEL=IFILE IFILEL=FTEMP CALL DPLO80(IFILEL,IFILEL,IBUGS2,IERROR) IOSTA2=0 OPEN(UNIT=IOUNIT,FILE=IFILEL,STATUS=ISTAT,FORM=IFORM, 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, 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(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,10 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+1 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+1 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(NC7:NC2)=IFILE(NC3:NC8) ELSE IF(K.EQ.8)THEN NC5=NC1 NC6=NC5+4 IFILE2(NC5:NC6)='menu/' NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILE(NC3:NC8) ELSE IF(K.EQ.9)THEN NC5=NC1 NC6=NC5+2 IFILE2(NC5:NC6)='ps/' NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILE(NC3:NC8) ELSE IF(K.EQ.10)THEN NC5=NC1 NC6=NC5+3 IFILE2(NC5:NC6)='tek/' NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILE(NC3:NC8) END IF IOSTA2=0 OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM, 1 IOSTAT=IOSTA2) IOST3=IOSTA2 IF(IOSTA2.NE.0)THEN CLOSE(UNIT=IOUNIT,ERR=1141) GOTO1141 ENDIF 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,10 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(NC7:NC2)=IFILEL(NC3:NC8) ELSE IF(K.EQ.8)THEN NC5=NC1 NC6=NC5+4 IFILE2(NC5:NC6)='menu/' NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILEL(NC3:NC8) ELSE IF(K.EQ.9)THEN NC5=NC1 NC6=NC5+2 IFILE2(NC5:NC6)='ps/' NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILEL(NC3:NC8) ELSE IF(K.EQ.10)THEN NC5=NC1 NC6=NC5+3 IFILE2(NC5:NC6)='tek/' NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILEL(NC3:NC8) END IF IOSTA2=0 OPEN(UNIT=IOUNIT,FILE=IFILE2,STATUS=ISTAT,FORM=IFORM, 1 IOSTAT=IOSTA2) IOST3=IOSTA2 IF(IOSTA2.NE.0)THEN CLOSE(UNIT=IOUNIT,ERR=1151) GOTO1151 ENDIF 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,10 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(NC7:NC2)=IFILEU(NC3:NC8) ELSE IF(K.EQ.8)THEN NC5=NC1 NC6=NC5+4 IFILE2(NC5:NC6)='menu/' NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILEU(NC3:NC8) ELSE IF(K.EQ.9)THEN NC5=NC1 NC6=NC5+2 IFILE2(NC5:NC6)='ps/' NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILEU(NC3:NC8) ELSE IF(K.EQ.10)THEN NC5=NC1 NC6=NC5+3 IFILE2(NC5:NC6)='tek/' 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 IOSTAT=IOSTA2) IOST3=IOSTA2 IF(IOSTA2.NE.0)THEN CLOSE(UNIT=IOUNIT,ERR=1181) GOTO1181 ENDIF 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,10 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+1 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+1 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.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+1 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+1 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+1 NC6=NC5+8 IFILE2(NC5:NC6)='PROGRAM ' 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+1 NC6=NC5+4 IFILE2(NC5:NC6)='TEXT ' IFILE2(NC6:NC6)=IBSLC NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILEU(NC3:NC8) ELSE IF(K.EQ.8)THEN NC5=NC1+1 NC6=NC5+4 IFILE2(NC5:NC6)='MENU ' IFILE2(NC6:NC6)=IBSLC NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILEU(NC3:NC8) ELSE IF(K.EQ.9)THEN NC5=NC1+1 NC6=NC5+2 IFILE2(NC5:NC6)='PS' IFILE2(NC6:NC6)=IBSLC NC7=NC6+1 NC8=80-NC6 IFILE2(NC7:NC2)=IFILEU(NC3:NC8) ELSE IF(K.EQ.10)THEN NC5=NC1+1 NC6=NC5+3 IFILE2(NC5:NC6)='TEK' 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 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, 1IOSTAT=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 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*1 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 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.IOPSY1.EQ.'OS38')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 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 NUMCLA=iargc() IF(NUMCLA.GE.1)THEN IJUNK=1 CALL getarg(IJUNK,CLARG1) IF(CLARG1(1:4).EQ.' ')GOTO9000 IF(CLARG1(1:4).EQ.'ECHO')GOTO9000 CALL STRLEZ(CLARG1,NC1) ENDIF IF(NUMCLA.GE.2)THEN IJUNK=2 CALL getarg(IJUNK,ITEMP) CLARG2(1:1)=ITEMP(1:1) 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 STRLEZ(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 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 --MAY 1994. IMPLEMENT FOR CRAY C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- 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 CCCCC LOGICAL system CCCCC LOGICAL ISTAT 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 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')GOTO2350 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 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) C2310 FORMAT(1X,'THE SYSTEM COMMAND HAS NOT BEEN IMPLEMENTED AT THIS') CUNIX CALL DPWRST('XXX','BUG ') CUNIX WRITE(ICOUT,2320) C2320 FORMAT(1X,'SITE FOR A UNIX HOST.') CUNIX CALL DPWRST('XXX','BUG ') ISTAT=system(ITEXT(1:IWIDTH)) CCCCC IF(ISTAT)IERROR='YES' GOTO9000 2350 CONTINUE CCCCC WRITE(ICOUT,2360) C2360 FORMAT(1X,'THE SYSTEM COMMAND HAS NOT BEEN IMPLEMENTED AT THIS') CCCCC CALL DPWRST('XXX','BUG ') CCCCC WRITE(ICOUT,2370) C2370 FORMAT(1X,'SITE FOR A UNIX HOST.') CCCCC CALL DPWRST('XXX','BUG ') CCRAY CALL ISHELL(ITEXT(1:IWIDTH)) CCCCC IF(ISTATUS)IERROR='YES' GOTO9000 C C ********************************************************* C * IBM PC 386 - OTG COMPILER * C * USE THE OTG "CISSUE" CALL * C ********************************************************* C 2400 CONTINUE CIBM- CALL CISSUE(ITEXT(1:IWIDTH),IFAIL) IERROR='NO' IF(IFAIL.EQ.1)IERROR='YES' GOTO9000 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,132)) 9016 FORMAT('(ITEXT(I:I),I =1,IWIDTH) = ',132A1) 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 --MARCH 2005. DATE AND TIME FOR g77 COMPILER 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@ CIBN- 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-- CLINU 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 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 CLINU ADATE(1:24)=fdate() CALL Date_and_Time(ADATE,ATIME) 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:8) 3012 FORMAT(A8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3013)ATIME(1:9) 3013 FORMAT(A9) 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:8)=ADATE(1:8) NCURRDAT=8 CURRTIME(1:9)=ATIME(1:9) NCURRTIM=9 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 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 CHARACTER*4 IRTFMD COMMON/COMRTF/IRTFMD C C-----COMMON---------------------------------------------------------- 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(1H ,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) 2121 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 C2121 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 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 CQWIN 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 CHARACTER*20 ITEXT 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 "SLEEP". NOTE THAT UNIX CALLS ARE * C * CASE SENSITIVE, SO LEAVE CODE IN LOWER CASE. * C ********************************************************* C 2300 CONTINUE CALL SLEEP(INT(ASLEEP+0.5)) C CCCCC FOLLOWING IS AN ALTERNAIVE METHOD IF LOCAL G77 LIBRARIES DO NOT CCCCC HAVE SLEEP FUNCTION. C CCCCC ITEXT=' ' CCCCC ITEXT(1:6)='sleep ' CCCCC ISLEEP=INT(ASLEEP+0.5) CCCCC IF(ISLEEP.GT.999)ISLEEP=999 CCCCC IF(ISLEEP.LT.1)ISLEEP=1 CCCCC IF(ISLEEP.GE.100)THEN CCCCC WRITE(ITEXT(7:9),'(I3)')ISLEEP CCCCC IWIDTH=9 CCCCC ELSEIF(ISLEEP.GE.10)THEN CCCCC WRITE(ITEXT(7:8),'(I2)')ISLEEP CCCCC IWIDTH=8 CCCCC ELSE CCCCC WRITE(ITEXT(7:7),'(12)')ISLEEP CCCCC IWIDTH=7 CCCCC ENDIF CCCCC CALL DPSYS2(ITEXT,IWIDTH,ISUBRO,IERROR) 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 CQWIN 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 CQWIN USE MSFLIB LOGICAL ISTATUS CCCCC LOGICAL IRESLT 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 C DO2310I=1,NCTEXT ISTART=I IF(ITEXT3(I:I).NE.' ')GOTO2319 2310 CONTINUE 2319 CONTINUE DO2320I=NCTEXT,1,-1 ISTOP=I IF(ITEXT3(I:I).NE.' ')GOTO2329 2320 CONTINUE 2329 CONTINUE C IRESLT=0 IRESLT=CHDIR(ITEXT3(ISTART:ISTOP)) IF(IRESLT.EQ.0)THEN WRITE(ICOUT,2301) CALL DPWRST('XXX','BUG') WRITE(ICOUT,2302)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 CQWIN 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 CMS-F 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 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 CMS-F 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 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 CMS-F USE IFPORT 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 IPID=getpid() GOTO9000 C C ********************************************************* C * PC USING INTEL COMPILER * C ********************************************************* C 2600 CONTINUE CMS-F 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,54)IWRITE 54 FORMAT('IEXIST = ',A4) 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' CMS-F 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