C C AUTHOR : G. GUELFI C C DATE : 1-OCT-78 C C C C CALL IS C CALL OPNFIL(FILSPC,ITCHAN,IBLKS,AEXT,IBUFF) C C C WHERE C C C FILSPC IS AREA FOR ICSI DATA C ITCHAN IS CHANNEL NUMBER C IBLKS IS NUMBER OF BLOCKS IN FILE TO BE CREATED C IF IBLKS = 0 LOOKUP UP FILE C IF IBLKS -VE FILSPC ALREADY LOADED DO LOOKUP C C C AEXT IS ASCII EXTENSION C C IBUFF BUFFER TO INITIALISE FILE C C C N.B. OPNFIL MUST BE POSITIONED SO USR DOES NOT SWAP OVER C IT BECAUSE FILSPC MUST BE AVAILABLE WHILE USR IS C MEMORY . C C SUBROUTINE OPNFIL(FILSPC,ITCHAN,IBLKS,AEXT,IBUFF) INTEGER*2 FILSPC(39),DEFEXT(4),IBUFF(256) LOGICAL*1 AEXT(4),IT,NDATA,YDATA DATA DEFEXT/3RCOL,3RDAT,3RDAT,3RDAT/ DATA NDATA/'N'/,YDATA/'Y'/ C C CONVERT EXTENSION TO RAD50 C IR = IRAD50(3,AEXT,DEFEXT(1)) C C ENTER CSI COMMAND C IF (IBLKS.LT.0) GOTO 6 !FILSPC LOADED 5 WRITE(7,10)AEXT 10 FORMAT('0ENTER VALID FILE SPEC. (E.G. SY1:QW0001.',4A1,')'//) IF (ICSI(FILSPC,DEFEXT, , ,0).NE.0) GOTO 5 6 ITCHAN = IGETC(IIC) IF (ITCHAN.LT.0) STOP ' NO CHANNEL AVAILABLE' C C FETCH HANDLER AND CHECK IF DESIGNATED FILE EXISTS C IF (IFETCH(FILSPC(16)).EQ.0) GOTO 12 WRITE(7,15) 15 FORMAT('0DEVICE NOT VALID USE SY0: OR SY1:',//) GOTO 5 12 ILOK = LOOKUP (ITCHAN,FILSPC(16)) IF (ILOK + 1) 20,30,40 30 TYPE*,' -1 ERR - LOOKUP ON CHANNEL ALREADY IN USE ' GOTO 6 C C FILE FOUND C 40 IF (IBLKS.LE.0) GOTO 70 C C CHECK IF FILE TO BE FOUND ?? C NO THEN C OPEN NEW FILE C 20 IF (IBLKS.GT.0) GOTO 21 WRITE(7,24) 24 FORMAT(' FILE NOT FOUND '//) 23 CALL CLOSEC(ITCHAN) CALL IFREEC(ITCHAN) GOTO 5 21 IF (ILOK.LE.0) GOTO 26 TYPE *,'FILE ALREADY EXISTS' GOTO 23 26 IE = IENTER(ITCHAN,FILSPC(16),IBLKS) IF (IE.GT.0) GOTO 25 IF (IE.EQ.-3) WRITE(7,22) 22 FORMAT('0OUTPUT DEVICE IS FULL CHOOSE ANOTHER DRIVE OR CHANGE DISK'/) GOTO 23 C C INITIALISE FILE C IWRT = 0 DO 27 I = 1,IBLKS CALL WRITW(256,IBUFF,IWRT,ITCHAN) 27 CALL READW(256,IBUFF,IRD,ITCHAN) 25 RETURN C C 70 IBLKS = ILOK RETURN END