cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c FORTRAN main program for reading the data file
c "flightx.run", and writing the main header, number
c and length of series, labels of series and first and
c last elements of each series to the screen. This
c version is written for the DOS environment. For a
c UNIX environment, change "CALL rddos(...)" to
c "CALL rdunix(...)", below.
c
c Also required: FORTRAN subroutine "rddos" (or "rdunix")
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
PROGRAM main
INTEGER nele, nser, n
REAL*4 data(10000,20)
CHARACTER file*80, header1*80, label(20)*8
file = 'flightx.run'
CALL rddos(file,header1,label,data,nele,nser,10000,20)
c CALL rdunix(file,header1,label,data,nele,nser,10000,20)
WRITE(*,*)'Main header:',header1
WRITE(*,*)'Number of series (inc. TimeTag):',nser
WRITE(*,*)'Length of series:',nele
DO n=1,nser
WRITE(*,'(a,i2,a,a8,2(2x,g17.8))')'label(',n,'):',label(n),
+ data(1,n),data(nele,n)
ENDDO
STOP
END
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c FORTRAN subroutine for reading a data file in a DOS
c environment. This subroutine has been tested on a
c MS-DOS PC running Lahey F77LEM/32 FORTRAN.
c
c ARGUMENT DESCRIPTION
c
c INPUT
c
c file CHAR*80: Name of data file to be read
c maxele INTEGER: Maximum number of elements for each series
c (first dimension of array "data")
c maxser INTEGER: Maximum number of series
c (dimension of array "label" and
c second dimension of array "data")
c
c OUTPUT
c
c header1 CHAR*80: Main Header of data file
c nele INTEGER: Number of elements in each series
c nser INTEGER: Number of series
c label CHAR*8 ARRAY: Labels of series;
c dimensioned: label(maxser)
c data REAL*4 ARRAY: Data read from file;
c dimensioned: data(maxele,maxser)
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
SUBROUTINE rddos(file,header1,label,data,nele,nser,maxele,maxser)
INTEGER nele, nser, maxele, maxser
REAL*4 data(maxele,maxser)
CHARACTER file*80, header1*80, label(maxser)*8
INTEGER n, Unit
CHARACTER char80*80
Unit = 10
c open file
OPEN(Unit,FILE=file,STATUS='old',ERR=98,FORM='UNFORMATTED',
+ ACCESS='TRANSPARENT')
c read main header
READ(Unit,ERR=99,END=100) header1
c read number of series (not including TimeTag series)
READ(Unit,ERR=99,END=100) nser
nser = nser + 1
IF (nser.GT.maxser) GOTO 97
c read series labels
label(1) = 'TimeTag '
DO n=2,nser
READ(Unit,ERR=99,END=100) label(n), char80
ENDDO
c read data
nele=1
10 CONTINUE
IF (nele.GT.maxele) GOTO 96
READ(Unit,ERR=99,END=20) (data(nele,n),n=1,nser)
nele=nele+1
GOTO 10
20 CONTINUE
nele = nele - 1
CLOSE(Unit)
RETURN
c error statements
96 WRITE(*,*)'ERROR: number of elements in file >= maximum'
STOP
97 WRITE(*,*)'ERROR: Number of series > maximum'
STOP
98 WRITE(*,*)'ERROR: Error whilst opening file'
STOP
99 WRITE(*,*)'ERROR: Error in B1 file'
STOP
100 WRITE(*,*)'ERROR: Unexpected End-of-File found'
STOP
END
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c FORTRAN subroutine for reading a data file in a UNIX
c environment. This subroutine has been tested on a
c HP9000 system running HP-UX with the FORTRAN compilor
c "fort77".
c
c Also required are the C-subroutines: "copen", "cclose",
c "c1byte", "ceof" and "cerror".
c
c ARGUMENT DESCRIPTION
c
c INPUT
c
c file CHAR*80: Name of data file to be read
c maxele INTEGER: Maximum number of elements for each series
c (first dimension of array "data")
c maxser INTEGER: Maximum number of series
c (dimension of array "label" and
c second dimension of array "data")
c
c OUTPUT
c
c header1 CHAR*80: Main Header of data file
c nele INTEGER: Number of elements in each series
c nser INTEGER: Number of series
c label CHAR*8 ARRAY: Labels of series;
c dimensioned: label(maxser)
c data REAL*4 ARRAY: Data read from file;
c dimensioned: data(maxele,maxser)
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
SUBROUTINE rdunix(file,header1,label,data,nele,nser,maxele,maxser)
INTEGER nele, nser, maxele, maxser
REAL*4 data(maxele,maxser)
CHARACTER file*80, header1*80, label(maxser)*8
INTEGER n, fstbl
CHARACTER char80*80
INTEGER ceof, cerror, c1byte, ieof, ierr
INTEGER*4 i, j, i4
REAL*4 r4
BYTE b4(4)
EQUIVALENCE (r4,i4,b4)
c open file
fstbl = index(file,' ')
IF ( (fstbl.LE.0).OR.(fstbl.GT.80) ) fstbl = 80
IF (fstbl.EQ.1) GOTO 95
file=file(:fstbl-1)//char(0)
CALL copen(file)
ierr=cerror()
IF (ierr.NE.0) GOTO 98
c read main header
DO i=1,80
header1(i:i)=char(c1byte())
ieof=ceof()
IF (ieof.ne.0) GOTO 100
ierr=cerror()
IF (ierr.ne.0) GOTO 99
ENDDO
c read number of series (not including TimeTag series)
DO j=4,1,-1
b4(j) = c1byte()
ieof=ceof()
IF (ieof.ne.0) GOTO 100
ierr=cerror()
IF (ierr.ne.0) GOTO 99
ENDDO
nser = i4
nser = nser + 1
IF (nser.GT.maxser) GOTO 97
c read series labels
label(1) = 'TimeTag '
DO n=2,nser
DO i=1,8
label(n)(i:i)=char(c1byte())
ieof=ceof()
IF (ieof.ne.0) GOTO 100
ierr=cerror()
IF (ierr.ne.0) GOTO 99
ENDDO
DO i=1,80
char80(i:i)=char(c1byte())
ieof=ceof()
IF (ieof.ne.0) GOTO 100
ierr=cerror()
IF (ierr.ne.0) GOTO 99
ENDDO
ENDDO
c read data
nele=1
10 CONTINUE
IF (nele.GT.maxele) GOTO 96
DO n=1,nser
DO j=4,1,-1
b4(j) = c1byte()
ieof=ceof()
IF (ieof.ne.0) GOTO 20
ierr=cerror()
IF (ierr.ne.0) GOTO 99
ENDDO
data(nele,n) = r4
ENDDO
nele=nele+1
GOTO 10
20 CONTINUE
nele = nele - 1
CALL cclose
RETURN
c error statements
95 WRITE(*,*)'ERROR: at least first character of file name blank'
STOP
96 WRITE(*,*)'ERROR: number of elements in file >= maximum'
STOP
97 WRITE(*,*)'ERROR: Number of series > maximum'
STOP
98 WRITE(*,*)'ERROR: Error whilst opening file'
STOP
99 WRITE(*,*)'ERROR: Error in B1 file'
STOP
100 WRITE(*,*)'ERROR: Unexpected End-of-File found'
STOP
END
/**************************************************************
C subroutines called by the FORTRAN subroutine "rdunix"
for reading a data file in a UNIX environment. This
subroutine has been tested on a HP9000 system running
HP-UX with the C-compilor "cc".
**************************************************************/
#include
#include
#define NULL 0
FILE *fcptr;
char cflnm[80];
/* void copen(f) char *f; { fcptr=fopen(f,"r"); return; } */
int copen(fflnm)
char *fflnm;
{
int i, ierr;
strncpy(cflnm,fflnm,80);
i = 0;
for ( ;cflnm[i] != ' ' ; ++i)
{
}
cflnm[i] = '\0';
fcptr=fopen(cflnm,"r");
ierr = 0;
if ( fcptr == NULL ) ierr = 1;
return ierr;
}
void cclose() { fclose(fcptr); return; }
int c1byte() { return fgetc(fcptr); }
int ceof() { return feof(fcptr); }
int cerror() { return ferror(fcptr); }
To table of contents
Next
chapter