iodisk.f
上传用户:szhypcb168
上传日期:2007-01-06
资源大小:2187k
文件大小:3k
- C==========================================================================
- C
- C ROUTINE
- C iodisk
- C
- C FUNCTION
- C 16-bit disk i/o
- C SYNOPSIS
- C function iodisk(mode, lun, fname, nrec, iar, size)
- C
- C formal
- C
- C data I/O
- C name type type function
- C -------------------------------------------------------------------
- C mode int i defines operation
- C -1 = close file
- C 1 = read
- C 2 = write
- C 3 = open for read
- C 4 = open for write
- C lun int i logical unit number
- C fname char i file name
- C nrec int i/o direct access record pointer
- C (auto increment)
- C iar int*2 i/o i/o data record
- C size int i record size
- C iodisk int fun status
- C -1 => illegal input
- C 0 => open/close OK
- C size=> read/write OK
- c==========================================================================
- c
- c DESCRIPTION
- c
- c Uses FORTRAN direct-access unformatted files with
- c consecutive 16-bit (i*2) signed samples. (Note:
- c direct access is not required, but sequential access
- c EOF determination is difficult under UNIX.)
- C
- C**************************************************************************
- C*-
- function iodisk(mode, lun, fname, nrec, iar, size)
- implicit undefined(a-z)
- integer mode, lun, nrec, size, iodisk
- integer*2 iar(size)
- character*(*) fname
- integer i
- c
- if ((mode .eq. 1 .or. mode .eq. 2) .and. nrec .le. 0) then
- iodisk = -1
- print *,' iodisk: Bad direct access record number', nrec
- goto 999
- end if
- c
- iodisk = 0
- if (mode .eq. 1) then
- c *read file
- c *Warning, read errors aren't reported
- c *except iodisk=0!
- read(lun, rec=nrec, err=999) (iar(i),i=1,size)
- iodisk = size
- nrec = nrec+1
- else if (mode .eq. 2) then
- c *write file
- write(lun, rec=nrec, err=222) (iar(i),i=1,size)
- iodisk = size
- nrec = nrec+1
- else if (mode .eq. 3) then
- c *open file for read
- open(lun, file=fname, access='direct', status='old',
- + recl=2*size, err=333)
- else if (mode .eq. 4) then
- c *open file for write
- c *unlink = UNIX file delete
- call unlink(fname)
- open(lun, file=fname, access='direct', status='new',
- + recl=2*size, err=444)
- else if (mode .eq. -1) then
- c *close file
- close(lun, err=555)
- else
- c *illegal mode
- iodisk = -1
- print *,' iodisk: Illegal mode', mode
- end if
- goto 999
- c
- c Error reporter
- c
- 222 print *,' iodisk: Error writing output file', fname
- goto 998
- 333 print *,' iodisk: Error opening input file', fname
- goto 998
- 444 print *,' iodisk: Error opening output file', fname
- goto 998
- 555 print *,' iodisk: Error closing file', lun
- goto 998
- 998 stop
- 999 return
- end