SUBROUTINE mcfile(filenm, length, width, status) IMPLICIT NONE INTEGER length, width, status CHARACTER filenm*256 c Read the specified file and return the number of rows and columns c Arguments : c filenm c i: Filename to test c length i r: Actual length of chain c width i r: Actual width of chain c status i r: 0 == OK c -1 == cannot open or read file INTEGER lun, lenn, lenb, lene, iflag, idelim, ierr LOGICAL qskip CHARACTER tmpstr*2048 INTEGER lenact EXTERNAL lenact status = 0 c Open file CALL getlun(lun) CALL openwr(lun, filenm, 'old', ' ', ' ', 0, 0, ierr) IF ( ierr .NE. 0 ) THEN tmpstr = 'MCFILE : Failed to open '//filenm CALL xwrite(tmpstr, 10) WRITE(tmpstr,'(a,i4)') ' iostat = ', ierr CALL xwrite(tmpstr, 10) CALL frelun(lun) status = -1 RETURN ENDIF c Read the first line and get for the number of columns READ(lun, '(a)', iostat=ierr) tmpstr IF ( ierr .NE. 0 ) THEN tmpstr = 'MCFILE : Failed to read '//filenm(:lenact(filenm)) CALL xwrite(tmpstr, 10) WRITE(tmpstr,'(a,i4)') ' iostat = ', ierr CALL xwrite(tmpstr, 10) CALL frelun(lun) status = -1 RETURN ENDIF width = 0 lenn = 0 iflag = 0 DO WHILE( lenn .LT. len(tmpstr) .AND. iflag .EQ. 0 ) width = width + 1 CALL xgtarg(tmpstr, lenn, lenb, lene, qskip, iflag, idelim) ENDDO c Now get the number of rows - recall that we have already read the first c line length = 0 ierr = 0 DO WHILE ( ierr .EQ. 0 ) length = length + 1 READ(lun,'(a)',iostat=ierr) tmpstr ENDDO ierr = 0 c Close the file CLOSE(lun) CALL frelun(lun) RETURN END