qÃ[VAX-11 Librarian V2A.00 õ6—Öô‰ KœÖô‰Œ   ˜LIBLISTOPCLOS\SEPTXTtSQUEEZE ­¤A—Öô‰ SUBROUTINE OPCLOS(KAME,ERROR)*C ************************************C OPEN AND/OR CLOSEC Used in program SEPTXT)C *************************************** CHARACTER*(*) KAME CHARACTER*13 NAME,OLD_NAME CHARACTER*3 EXT LOGICAL LOP,ERROR COMMON/I/ LOP COMMON/PRT/IPRT COMMON/II/ EXTCC IF FILE IS OPEN, CLOSE IT IF (LOP) CLOSE(UNIT=2) NAME= KAME//'.'//EXT LOP = .TRUE. ERROR = .FALSE.A OPEN(UNIT=2,NAME=NAME,CARRIAGECONTROL='LIST',TYPE='NEW',ERR=994) OLD_NAME=NAME IF(IPRT.EQ.0) GO TO 997 PRINT 996,KAME) 996 FORMAT(' ** OPENED DECK FILE -- ',A) 997 CONTINUE GO TO 999 994 LOP = .TRUE. NAME=OLD_NAME ERROR = .TRUE." OPEN(UNIT=2,NAME=NAME,TYPE='OLD') GO TO 999C ENTRY CLOSC IF(LOP) CLOSE(UNIT=2) LOP =.FALSE. 999 RETURN ENDww­ _O—Öô‰ PROGRAM SEPTXTCC******************************************************************BC CREATE SEPARATE FILE NAMES FOR EACH SUBROUTINE,FUNCTION,ETC.CC******************************************************************5C Program SEPTXT calls subroutines OPCLOS and SQUEEZECC****************************************************************** LOGICAL LOP COMMON/I/ LOP CHARACTER*3 EXT,EXTT COMMON/II/ EXT COMMON/PRT/IPRT CHARACTER*50 FILE CHARACTER*9 KAME CHARACTER*1 HTAB CHARACTER*4 NAMM CHARACTER*11 NINC CHARACTER*7 INC CHARACTER*6 CHECK,BLK CHARACTER*3 KNUM CHARACTER*80 NCARD LOGICAL EX,ERROR DATA NUM/0/ DATA LOP/.FALSE./ DATA HTAB/9/ DATA BLK/' '/C IPRT=1( INQUIRE(FILE='FOR001',ERR=333,EXIST=EX) IF(.NOT.EX) GO TO 3337 OPEN(UNIT=1,FILE='FOR001',ERR=998,TYPE='OLD',READONLY) IPRT=0 EXTT='RTX' GO TO 1111 333 WRITE(6,4)9 4 FORMAT('** ASD/XRHD file creation by entity name **'// 1 ' Type input file:',$) READ(5,3) FILE3 OPEN(UNIT=1,NAME=FILE,ERR=998,TYPE='OLD',READONLY) WRITE(6,33)B 33 FORMAT(' Enter extension for files created (.TXT default) ',$) READ(5,3,END=34) EXTT 34 IF(EXTT.EQ.' ') EXTT='TXT' 3 FORMAT(A) 1111 CONTINUE!C READ CARD IMAGE FROM INPUT FILE 5 READ(1,10,END=999) NCARD 10 FORMAT(A) NCH=LEN(NCARD)C RESET SPECIAL TYPE FLAG ITYPE=0 EXT=EXTTC SKIP COMMENT STATEMENTS% IF(NCARD(1:7).EQ.'C>>>>>>') GO TO 14 IF(NCARD(1:1).EQ.'C') GO TO 310 NAMM=NCARD(1:4)C SKIP *DECK CARDS IF(NAMM.EQ.'*DEC')GO TO 5C SKIP OVERLAY CARDS% IF(NCARD(7:13).EQ.'OVERLAY') GO TO 5 LENS=5 IF(NAMM.EQ.'-INC') GO TO 200 LENS=6C REPLACE *CALL COMDECK CARDS IF(NAMM.EQ.'*CAL') GO TO 200 N1=10 N2=17C CHECK FOR *COMDECK CARDS"C CREATE NEW FILE FOR EACH COMDECK ITYPE=2 IF(NAMM.EQ.'*COM') GO TO 110 C TEST FOR BEGINNING OF PROGRAMS>C CHECK FOR TABS AND LINES OTHER THAN PROGS, SUBS OR FUNCTIONS ITYPE=0 CHECK=NCARD(1:6) NTAB=INDEX(CHECK,HTAB) IF(NTAB.EQ.1) GOTO 15 IF(CHECK.EQ.BLK) GO TO 151 IF(NTAB.GT.1.AND.CHECK(1:NTAB-1).EQ.BLK) GOTO 15 GOTO 310 14 MEM=1 LENS=6 ITYPE=0 NST=INDEX(NCARD,'MEMBER') IF(NST.GT.0) GO TO 101 15 CONTINUE LENS=7 ITYPE=0 NST=INDEX(NCARD,'PROGRAM') IF(NST.GT.0) GO TO 100 NST=INDEX(NCARD,'program') IF(NST.GT.0) GO TO 100 NST=INDEX(NCARD,'Program') IF(NST.GT.0) GO TO 100 LENS=8 NST=INDEX(NCARD,'FUNCTION') IF(NST.GT.0) GOTO 100 NST=INDEX(NCARD,'function') IF(NST.GT.0) GOTO 100 NST=INDEX(NCARD,'Function') IF(NST.GT.0) GOTO 100 LENS=10 NST=INDEX(NCARD,'SUBROUTINE') IF(NST.GT.0) GOTO 100 NST=INDEX(NCARD,'subroutine') IF(NST.GT.0) GOTO 100 NST=INDEX(NCARD,'Subroutine') IF(NST.GT.0) GOTO 100 LENS=5 NST=INDEX(NCARD,'IDENT') IF(NST.GT.0) GOTO 100 NST=INDEX(NCARD,'ident') IF(NST.GT.0) GOTO 100 LENS=10 ITYPE=1C 'BLOCK DATA' NST=INDEX(NCARD,'BLOCK ') IF(NST.GT.0) GOTO 100 NST=INDEX(NCARD,'block ') IF(NST.GT.0) GOTO 100 LENS=9 NST=INDEX(NCARD,'BLOCKDATA') IF(NST.GT.0) GOTO 100 NST=INDEX(NCARD,'blockdata') IF(NST.GT.0) GOTO 100 MEM=0 K=NCH$ 556 IF(NCARD(K:K).NE.' ') GO TO 104 K=K-1 IF(K.EQ.0) GO TO 5 GO TO 556 104 WRITE(2,10) NCARD(1:K) GO TO 5 100 CONTINUE IF(MEM.EQ.1) GO TO 310 101 CONTINUE& IF(NCARD(1:7).EQ.'C>>>>>>') GO TO 1026 IF (NCARD(1:1) .EQ. 'C' .OR. NCARD(1:1) .EQ. '*' .OR.! 1 NCARD(1:1) .EQ. '!') GO TO 310/ 102 IF (INDEX(NCARD,'INDEX') .GT. 0) GO TO 310, IF (INDEX(NCARD,'FORMAT') .GT. 0) GO TO 310 N1=NST + LENS N2= INDEX(NCARD,'(') N3=INDEX(NCARD,'!')+ IF (N3 .NE. 0 .AND. NST .GT. N3) GO TO 310 N4=INDEX(NCARD,'*') IF(N4.NE.0) N2=N4 IF(N2.EQ.0) N2=N3 N2= N2 -1 IF(N2.EQ.0) N2= N1 + 73 IF(ITYPE.EQ.1 .AND. NCARD(N1+1:N1+1).EQ.' ' .AND.( 1 NCARD(N1+2:N1+2).EQ.' ') GO TO 900 110 CONTINUE KAME= NCARD(N1:N2) IF(ITYPE.EQ.2) EXT='CDK' CALL OPCLOS(KAME,ERROR) IF (ERROR) GO TO 5C OPEN NEW DECK FILE 310 CONTINUE IF(.NOT.LOP) GO TO 5C IF(ITYPE.EQ.2) NCARD(1:1)='C' K=NCH$ 555 IF(NCARD(K:K).NE.' ') GO TO 103 K=K-1 IF(K.EQ.0) GO TO 5 GO TO 555 103 WRITE(2,10) NCARD(1:K) GO TO 5 200 CONTINUE N1 = LENS + 1 N2= N1 + 9 INC=NCARD(N1:N2) NINC = INC//'.CDK' CALL SQUEEZE(NINC) WRITE(2,25) NINC& 25 FORMAT(6X,9HINCLUDE ' ,A,2H' ) GO TO 5 900 NUM= NUM + 1 ENCODE(3,16,KNUM) NUM 16 FORMAT(I3) KAME= 'DATA'//KNUM CALL OPCLOS(KAME,ERROR) IF (ERROR) GO TO 5 WRITE(2,31) NUM# 31 FORMAT(6X,'BLOCK DATA DATA',I3) GO TO 5 998 PRINT 9973 997 FORMAT('** ERROR ** INPUT FILE OPEN ERROR **') PRINT 996,FILE3 996 FORMAT(' TRIED TO OPEN FILE --',A) STOP '** ERROR **' 999 CALL CLOS STOP '** EOF **' ENDww­@…u—Öô‰ SUBROUTINE SQUEEZE(NAME),C ******************************************C REMOVE BLANKSC Used in program SEPTXT+C ***************************************** CHARACTER*(*) NAME CHARACTER*13 NEWC LN=LEN(NAME) NEW=' ' NUM=0 DO 100 I=1,LN IF(NAME(I:I).EQ.' ') GO TO 100 NUM=NUM + 1 NEW(NUM:NUM)=NAME(I:I) 100 CONTINUE NAME=NEW RETURN ENDww­ KœÖô‰ PROGRAM LIBLIST CHARACTER*80 A,B CHARACTER*50 FILENAME CHARACTER*10 NAME(7),MODNAME CHARACTER*17 INNAME LOGICAL*1 EX FILENAME='LIBRARY.LIS' INQUIRE(FILE=FILENAME,EXIST=EX) IF(.NOT.EX) THEN 2 TYPE 5$ 5 FORMAT(1X,'Library list file?',$) ACCEPT 10,FILENAME 10 FORMAT(A)  ENDIF5 OPEN(UNIT=1,FILE=FILENAME,READONLY,ERR=2,TYPE='OLD') READ(1,10) A WRITE(6,15) A 15 FORMAT(1X,A) READ(1,10) A READ(1,10) B WRITE(6,17) A(1:36),B(1:36) 17 FORMAT(1X,A,1X,A) DO 20 I=4,7 READ(1,10) A 20 CONTINUE J=-1000 MODNAME=' ' 25 K=0 27 K=K+1 35 READ(1,10,END=50) INNAME IF (INNAME .EQ. ' ') GO TO 35( IF (INNAME(1:10) .EQ. MODNAME) GO TO 35, IF (INNAME(1:6) .EQ. 'Module') READ(1,10) A# IF (INNAME(1:6) .EQ. 'Module') J=04 IF (INNAME(1:6) .EQ. 'Module') MODNAME=INNAME(8:17)4 IF (INNAME(1:6) .EQ. 'Module') INNAME(1:10)=MODNAME NAME(K)=INNAME(1:10) J=J+1% IF(J.GE.2) NAME(K)='*'//NAME(K)(1:9) IF (K.LT.7) GO TO 27 WRITE(6,30) (NAME(JJ),JJ=1,K) GO TO 25 50 K=K-1) IF(K.GT.0) WRITE(6,30) (NAME(JJ),JJ=1,K) 30 FORMAT(7(1X,A)) CLOSE(1) ENDww