Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0100/lin81.sep
There is 1 other file named lin81.sep in the archive. Click here to see a list.
C - - -PROGRAM LINCUR.SEP                                               SEP 0010
C - - -   PROGRAM SEPERATES OUT SUBROUTINES IN A FILE                   SEP 0020
C - - -   FOR EASE OF OVERLAYING WITH F10 COMPILER.                     SEP 0030
C - - -                                                                 SEP 0040
C - - -   PROGRAM WRITTEN BY R. F. KOHM, ALCOHA R & D.                  SEP 0050
C - - -                                                                 SEP 0060
C - - -MAKE NEWFILES WITH THE NAME                                      SEP 0070
C - - -LINC.--- WHERE --- IS A NUMBER FROM 100 TO 999                   SEP 0080
C - - -THESE ARE NUMBERED SEQUENCTIALLY STARTING WITH 10                SEP 0090
       DOUBLE PRECISION WORD                                            SEP 0100
       DIMENSION IWORD(2)                                               SEP 0110
       EQUIVALENCE (IWORD,WORD)                                         SEP 0120
       EQUIVALENCE (IWORD(2),NUM)                                       SEP 0130
       DIMENSION N(80),NSUB(30)                                         SEP 0140
       EQUIVALENCE (N(1),NSUB(1))                                       SEP 0150
C - - -DEFINE DATA                                                      SEP 0160
       DATA IPER/'('/                                                   SEP 0170
       DATA IWORD/'LINC.',' '/                                          SEP 0180
       DATA NE,NN,ND/'E','N','D'/                                       SEP 0190
       DATA IC/'C'/                                                     SEP 0200
       DATA IBLANK/' '/                                                 SEP 0210
C - - -DEFINE THE LOGICAL UNIT FOR INPUT                                SEP 0220
C - - -THIS IS ASSUMED DISK                                             SEP 0230
C - - -FLAG FOR DATA READ                                               SEP 0240
       IDAT=0                                                           SEP 0250
       LUCR=1                                                           SEP 0260
       LUOUT=23                                                         SEP 0270
       WRITE(5,1999)                                                    SEP 0280
 1999  FORMAT(' OUTPUT FILE IS LOGICAL UNIT 23')                        SEP 0290
       LUIO=24                                                          SEP 0300
       IFLAG=0                                                          SEP 0310
C - - -START LOOP CHECKING FOR ------END                                SEP 0320
 1     DO 900 I=100,999                                                 SEP 0330
       ENCODE(5,1001,NUM) I,IBLANK                                      SEP 0340
 1001  FORMAT(I3,A2)                                                    SEP 0350
       IDAT=0                                                           SEP 0360
       OPEN(UNIT=LUIO,ACCESS='SEQOUT',FILE=WORD)                        SEP 0370
       ILINE=1                                                          SEP 0380
       WRITE(5,2000) WORD                                               SEP 0390
C***** WRITE(LUOUT,2000) WORD                                           SEP 0400
 2000  FORMAT(1X,A10,$)                                                 SEP 0410
 2     READ(LUCR,1000,END=901) N                                        SEP 0420
 1000  FORMAT(80A1)                                                     SEP 0430
       ISPACE=7                                                         SEP 0440
       IF(N(1).EQ. IC) GO TO 102                                        SEP 0450
       IF(ILINE.GT.1) GO TO 100                                         SEP 0460
       IF(N(1) .EQ. IC) GO TO 99                                        SEP 0470
       JSTOP=30                                                         SEP 0480
       DO 173 M=1,30                                                    SEP 0490
       IF(N(M) .NE. IPER) GO TO 173                                     SEP 0500
       ISTOP=M                                                          SEP 0510
       GO TO 81                                                         SEP 0520
 173   CONTINUE                                                         SEP 0530
81     ILINE=2                                                          SEP 0540
       WRITE(5,2200) ( NSUB(J),J=1,ISTOP)                               SEP 0550
       WRITE(LUOUT,2200) ( NSUB(J),J=1,ISTOP)                           SEP 0560
       WRITE(LUOUT,2300) WORD                                           SEP 0570
 2300  FORMAT(' = ', A10)                                               SEP 0580
 2200  FORMAT(5X,30A1)                                                  SEP 0590
 99    ISPACE=10                                                        SEP 0600
 100   CONTINUE                                                         SEP 0610
       IFINDE=0                                                         SEP 0620
       ICSTOP=1                                                         SEP 0630
       DO 150 IJ=2,80                                                   SEP 0640
       IF(N(IJ) .NE. IBLANK) GO TO 140                                  SEP 0650
       GO TO 150                                                        SEP 0660
 140   ICSTOP=IJ                                                        SEP 0670
       IF(IFINDE.NE.0) GO TO 150                                        SEP 0680
 7     IF(N(IJ).NE.NE) GO TO 170                                        SEP 0690
       IFINDE=1                                                         SEP 0700
 8     IF(N(IJ+1).EQ.NN) GO TO 9                                        SEP 0710
       IFINDE=1                                                         SEP 0720
       GO TO 150                                                        SEP 0730
 9     IF(N(IJ+2) .EQ. ND) GO TO 97                                     SEP 0740
       IFINDE=1                                                         SEP 0750
       GO TO 150                                                        SEP 0760
 97    ISPACE=80                                                        SEP 0770
 150   CONTINUE                                                         SEP 0780
C - - -------END FOUND SET FLAG FOR END OF A PROGRAM                    SEP 0790
       IF(ISPACE.EQ. 80) IFLAG=1                                        SEP 0800
 170   CONTINUE                                                         SEP 0810
 102   WRITE(LUIO,1000) N                                               SEP 0820
       IF (IFLAG.EQ.0) GO TO 2                                          SEP 0830
       IFLAG=0                                                          SEP 0840
       CLOSE(UNIT=LUIO)                                                 SEP 0850
 900   CONTINUE                                                         SEP 0860
 901   CLOSE(UNIT=LUIO)                                                 SEP 0870
       STOP                                                             SEP 0880
       END                                                              SEP 0890