C SUBROUTINE FLOPEN.FOR C THIS SUBROUTINE READS IN A FILE NAME AFTER PRINTING A C STRING MESSAGE SPECIFIED IN THE CALL, AND PERFORMS AN C ASSIGN TO A LUN ALSO SPECIFIED IN THE CALL. THE STATUS C IS RETURNED WITH IST = 1 INDICATING SUCCESS AND IST = 2 C INDICATING FAILURE VIA EOF ON INPUT C RE-ENTERED 5-MARCH-75 AUTHOR: LARRY SIMPSON C MODIFIED FOR "FOR" COMPILER 15-AUG-75 C --------- C MODIFIED TO CHECK ON EXISTENCE OF A FILE OPENED FOR READ VIA A C DUMMY READ STATEMENT. POSITIVE LUN INDICATES READ, NEGATIVE C INDICATES WRITE. NO CHECK IS PERFORMED FOR WRITE. C FILE NAME AND LENGTH ARE NOW SAVED IN A COMMON AREA C ACCESSIBLE BY THE MAIN PROGRAM. C MODIFIED 29-JAN-76: LARRY SIMPSON SUBROUTINE FLOPEN(STRNG,NSTR,LUN,ITRM,IST) LOGICAL*1 STRNG(NSTR),BUF1(80),FNAME(30),B COMMON /FILNAM/LENF,FNAME IWFLG=0 IF(LUN)50,60,60 50 IWFLG=1 LUN=-LUN 60 CALL STRING(BUF1,1,'$') CALL STRING(BUF1(2),NSTR,STRNG) N1=NSTR+2 CALL STRING(BUF1(N1),2,': ') N2=NSTR+3 30 WRITE(ITRM,104)(BUF1(I),I=1,N2) 104 FORMAT(80A1) 101 FORMAT(Q,80A1) READ(ITRM,101,END=20)LENF,FNAME CALL ASSIGN(LUN,FNAME,30) CALL ERRSNS(IER) IF(IER.NE.0)GO TO 10 IF(IWFLG.EQ.1)GO TO 70 CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.) READ(LUN,104,ERR=80)B REWIND LUN 70 IST=1 GO TO 90 80 CALL ERRSNS(IER) IF(IER.NE.29)GO TO 10 WRITE(ITRM,103) 103 FORMAT(' FILE DOES NOT EXIST, TRY AGAIN!') CALL CLOSE(LUN) GO TO 30 10 WRITE(ITRM,102)IER 102 FORMAT(' ERROR #',I5,' ON ASSIGN') GO TO 30 20 IST=2 90 CALL ERRSET(29,.TRUE.,.TRUE.,.TRUE.,.TRUE.) RETURN END