home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
01e
/
libry31a.zip
/
LIBRY5.DOC
< prev
next >
Wrap
Text File
|
1987-01-21
|
10KB
|
302 lines
.pa
FILE HANDLING
FORTRAN is rather ill suited to file I/O. It is painfully slow compared
to the actual speed of memory-to-disk transfers. I have developed this
set of procedures to allow fast file access from FORTRAN. On the
HP-1000F and HP-A900 these routines provide a speed increase factor of
about 20. On the PC the speed increase is more like 30. It may seem a
little circuitous at first to always read and write character strings
instead of numbers and to call some subroutine rather than simply using
"WRITE" and "READ" statements; but once you get used to it, it isn't so
bad; and the speed is worth a little extra trouble.
As far as numbers go, you can use DEC0DE to decode them from the
character strings and "WRITE(CBUF,1000)" to encode them.
I have allowed for only two sequential access files and one random
access file. It's not obvious in FORTRAN, but you can't just open an
unlimited number of files. Two has always been enough for me. These
procedures are so much faster than FORTRAN you can afford to close one,
open another, read what you want from it, close it, and then skip
through the first until you get to the point where you left off if you
need more than two files at a time.
A word of warning about reading files created by word processors and the
like... these procedures ignore control characters on either read or
write and chop-off trailing blanks on write. Also, files must end with
the standard EOF character (zero record length for HPs or SUB for PCs).
This is done for you automatically by the end-file functions and most
editors (at least WED and IBM's Professional Editor). If you create a
file using FORTRAN on the PC WITHOUT these procedures and then attempt
to read it WITH these procedures you will get trash at the end unless
you put a CHAR(26) on the last line (A1 format) before you close the
file.
.pa
QUICK LIST OF FILE HANDLING SUBROUTINES
GETPSP: get the program segment prefix (PC only - on HP use GETST)
RRPAR: get file name from runtime string
ECLOS: close random access file
EOPEN: open random access file
EREAD: read random access file
EWRIT: write random access file
FBKSP1: backspace first sequential access file
FBKSP2: backspace second sequential access file
FCLOS1: close first sequential access file
FCLOS2: close second sequential access file
FENDF1: end (affix EOF marker to) first sequential access file
FENDF2: end (affix EOF marker to) second sequential access file
FOPEN1: open first sequential access file
FOPEN2: open second sequential access file
FREAD1: read first sequential access file
FREAD2: read second sequential access file
FRWND1: rewind first sequential access file
FRWND2: rewind second sequential access file
FWRIT1: write first sequential access file
FWRIT2: write second sequential access file
.pa
NAME: GETPSP
PURPOSE: get the program segment prefix (PC only - on HP use GETST)
TYPE: subroutine (far external)
SYNTAX: CALL GETPSP(PSP)
INPUT: none
OUTPUT: PSP (CHARACTER*1 PSP(128))
NOTE: This seems like a logical thing to want; but to actually find
the PSP after DOS gets through with it on the PC is no easy
task when working from inside an EXE file.
NAME: RRPAR
PURPOSE: get file name from runtime string
TYPE: subroutine (far external)
SYNTAX: CALL RRPAR(N,NAME)
INPUT: N (INTEGER*2) number of entry see example below
OUTPUT: NAME (CHARACTER*12)
NOTE: the purpose of this is to fetch and parse the string that you
type in after the name of your program as below
MYPROG this.dat that.for other.bin wednesday
fetch the names with the following
CHARACTER NAME1*12,NAME2*12,NAME3*12,COMMENT*12
CALL RRPAR(1,NAME1)
CALL RRPAR(2,NAME2)
CALL RRPAR(3,NAME3)
CALL RRPAR(4,COMMENT)
you will get the following
NAME1='this.dat'
NAME2='that.for'
NAME3='other.bin'
COMMENT='wednesday'
NAME: ECLOS
PURPOSE: close random access file
TYPE: subroutine (far external)
SYNTAX: CALL ECLOS
INPUT: none
OUTPUT: none
NAME: EOPEN
PURPOSE: open random access file
TYPE: subroutine (far external)
SYNTAX: CALL EOPEN(NAME,NEW,LREC,IERR)
INPUT: NAME (CHARACTER*? up to 64 including drive and path)
NEW (INTEGER*2) NEW<0 means 'old', NEW=0 means 'unknown'
NEW>0 means 'new' (note that Microsoft hasn't yet learned what
'new', 'old', and 'unknown' mean. 'New' means make one and if
it already exists return an error. 'Old' means open it and if
it doesn't already exist return an error. 'Unknown' means open
it and create it if necessary.)
LREC (INTEGER*2) record length in bytes
OUTPUT: IERR (INTEGER*2) error indicator (IER=0 is normal)
NAME: EREAD
PURPOSE: read random access file
TYPE: subroutine (far external)
SYNTAX: CALL EREAD(CBUF,NREC,IERR)
INPUT: NREC (INTEGER*2) desired record number
OUTPUT: CBUF (CHARACTER*LREC see EOPEN) buffer
IERR (INTEGER*2) error indicator (IER=0 is normal)
NAME: EWRIT
PURPOSE: write random access file
TYPE: subroutine (far external)
SYNTAX: CALL EWRIT(CBUF,NREC,IERR)
INPUT: CBUF (CHARACTER*LREC see EOPEN) buffer
NREC (INTEGER*2) desired record number
OUTPUT: IERR (INTEGER*2) error indicator (IER=0 is normal)
NAME: FBKSP1
PURPOSE: backspace first sequential access file
TYPE: subroutine (far external)
SYNTAX: CALL FBKSP1(NREC)
INPUT: NREC (INTEGER*2) number of records to backspace (if NREC is
larger than the number of records read so far this will be
the same as a rewind)
OUTPUT: none
NAME: FCLOS1
PURPOSE: close first sequential access file
TYPE: subroutine (far external)
SYNTAX: CALL FCLOS1
INPUT: none
OUTPUT: none
NAME: FENDF1
PURPOSE: end (affix EOF marker to) first sequential access file
TYPE: subroutine (far external)
SYNTAX: CALL FENFD1
INPUT: none
OUTPUT: none
NAME: FOPEN1
PURPOSE: open first sequential access file
TYPE: subroutine (far external)
SYNTAX: CALL FOPEN1(NAME,NEW,IERR)
INPUT: NAME (CHARACTER*? up to 64 including drive and path)
NEW (INTEGER*2) NEW<0 means 'old', NEW=0 means 'unknown'
NEW>0 means 'new' (note that Microsoft hasn't yet learned what
'new', 'old', and 'unknown' mean. 'New' means make one and if
it already exists return an error. 'Old' means open it and if
it doesn't already exist return an error. 'Unknown' means open
it and create it if necessary.)
OUTPUT: IERR (INTEGER*2) error indicator (IER=0 is normal)
NAME: FREAD1
PURPOSE: read first sequential access file
TYPE: subroutine (far external)
SYNTAX: CALL FREAD1(CBUF,NBUF,LREC,IERR,IEND)
INPUT: NBUF (INTEGER*2) number of bytes in CBUF
OUTPUT: CBUF (CHARACTER*?) buffer
LREC (INTEGER*2) nominal record length
IERR (INTEGER*2) error indicator (IERR=0 is normal)
IEND (INTEGER*2) EOF indicator (IEND=0 is normal)
NAME: FWRIT1
PURPOSE: write first sequential access file
TYPE: subroutine (far external)
SYNTAX: CALL FWRIT1(CBUF,NBUF,IERR)
INPUT: CBUF (CHARACTER*?) buffer
NBUF (INTEGER*2) number of bytes in CBUF
OUTPUT: IERR (INTEGER*2) error indicator (IERR=0 is normal)
NAME: FRWND1
PURPOSE: rewind first sequential access file
TYPE: subroutine (far external)
SYNTAX: CALL FRWND1
INPUT: none
OUTPUT: none
.pa
EXAMPLE USING FILE PROCEDURES
PROGRAM EXMPL
C
C IN THIS EXAMPLE ONE FILE WILL BE COPIED INTO ANOTHER
C
IMPLICIT INTEGER*2 (I-N)
CHARACTER CBUF*80,INFILE*12,OUTFILE*12,ANS
DATA LINES/0/
C
CALL ERASE
CALL WRTTY('EXMPL/V1.0: example using file procedures<')
CALL WRTTY(' (copying one file into another)<')
C
C FETCH FILE NAMES FROM RUNTIME STRING
C
CALL RRPAR(1,INFILE)
CALL RRPAR(2,OUTFILE)
C
C CHECK FOR MISSING FILE NAMES
C
IF(INFILE.NE.' '.AND.OUTFILE.NE.' ') GO TO 100
CALL WRTTY('missing file names... try something like<')
CALL WRTTY(' EXMPL infile outfile<')
GO TO 999
C
C OPEN INFILE (NOTE: NEW='-1')
C
100 CALL FOPEN1(INFILE,-1,IERR)
IF(IERR.EQ.0) GO TO 110
CALL WRTTY('unable to access infile<')
GO TO 999
C
C OPEN OUTFILE, FIRST CHECK FOR ALREADY EXIST (NOTE: NEW=-1)
C IF YOU DON'T CARE TO CHECK FOR OVERWRITE JUST SET NEW=0
C
110 CALL FOPEN2(OUTFILE,-1,IERR)
IF(IERR.NE.0) GO TO 120
C
111 CALL WRTTY('outfile already exists... overwrite?(Y/N)_')
CALL READ1(ANS)
IF(ANS.EQ.'Y') GO TO 112
IF(ANS.EQ.'N') GO TO 900
CALL BEEP
CALL CLEAR1
GO TO 111
C
112 CALL CLEAR1
C
C OPEN OUTFILE, CREATE (NOTE: NEW=1)
C
120 CALL FOPEN2(OUTFILE,1,IERR)
IF(IERR.EQ.0) GO TO 200
CALL WRTTY('unable to access outfile<')
GO TO 900
C
C READ INFILE
C
200 CALL FREAD1(CBUF,80,LREC,IERR,IEND)
IF(IERR.NE.0) GO TO 400
IF(IEND.NE.0) GO TO 300
LINES=LINES+1
C
C COPY TO OUTFILE
C
CALL FWRIT2(CBUF,LREC,IERR)
IF(IERR.NE.0) GO TO 500
GO TO 200
C
C END OUTFILE
C
300 CALL FENDF2
WRITE(CBUF,3000) LINES
3000 FORMAT('lines copied ',I5,'<')
CALL WRTTY(CBUF)
GO TO 900
C
C READ ERROR
C
400 WRITE(CBUF,4000) LINES
4000 FORMAT('infile read error at line ',I5,'<')
CALL WRTTY(CBUF)
GO TO 900
C
C WRITE ERROR
C
500 WRITE(CBUF,5000) LINES
5000 FORMAT('outfile write error at line ',I5,'<')
CALL WRTTY(CBUF)
C
C CLOSE FILES
C
900 CALL FCLOS2
CALL FCLOS1
STOP
END