!*********************************************************************************************************************************** ! ! F S _ T E S T ! ! Program: FS_TEST ! ! Programmer: David G. Simpson ! NASA Goddard Space Flight Center ! Greenbelt, Maryland 20771 ! ! Date: February 13, 2017 ! ! Language: Fortran-90 ! ! Version: 1.00a ! ! Description: Test driver program for subroutine FILESIZE, which determines the size ! of a file in bytes. ! !*********************************************************************************************************************************** PROGRAM FS_TEST IMPLICIT NONE INTEGER :: SZ CHARACTER(LEN=132) :: INFILE WRITE (UNIT=*, FMT='(A)', ADVANCE='NO') ' Enter file name: ' READ (UNIT=*, FMT=*) INFILE CALL FILESIZE (INFILE, SZ) PRINT *, ' File size is: ', SZ STOP END PROGRAM FS_TEST !*********************************************************************************************************************************** ! FILESIZE ! ! Determine the size of a file, in bytes. ! ! Input: FILENAME is a 132-character string containing the name of the file whose size is to be found. ! Output: FILESZ is an integer giving the file size, in bytes. !*********************************************************************************************************************************** SUBROUTINE FILESIZE (FILENAME, FILESZ) IMPLICIT NONE CHARACTER(LEN=132), INTENT(IN) :: FILENAME ! input: file name INTEGER, INTENT(OUT) :: FILESZ ! output: size in bytes INTEGER, PARAMETER :: INUNIT = 100 INTEGER :: IERR INTEGER(KIND=8) :: RECNUM, PTR1, PTR2 CHARACTER :: A ! ! Open input binary file. ! OPEN (UNIT=INUNIT, FILE=FILENAME, STATUS='OLD', ACCESS='DIRECT', & ! open file FORM='UNFORMATTED', ACTION='READ', RECL=1, IOSTAT=IERR) IF (IERR .NE. 0) THEN ! if file open error.. WRITE (UNIT=*, FMT='(A,I6,A)') ' Error ',IERR,' opening file '//FILENAME ! ..then print error message.. STOP ! ..and return to operating system END IF PTR1 = 1 ! initialize data PTR2 = HUGE(PTR2)-16 RECNUM = PTR2/2 DO ! binary search to find end of file READ (UNIT=INUNIT, REC=RECNUM, IOSTAT=IERR) A IF (IERR .NE. 0) THEN PTR2 = RECNUM ELSE PTR1 = RECNUM END IF RECNUM = (PTR1+PTR2)/2 IF ((PTR2-PTR1) .LT. 6) EXIT ! exit when we've almost found end of file END DO DO RECNUM = PTR1, PTR2 ! almost found end of file - now check.. READ (UNIT=INUNIT, REC=RECNUM, IOSTAT=IERR) A ! ..byte by byte until precise end is found IF (IERR .NE. 0) EXIT END DO FILESZ = RECNUM - 1 ! file size (bytes) CLOSE (UNIT=INUNIT, STATUS='KEEP') ! close file RETURN END SUBROUTINE FILESIZE