BANNER PROGRAM. PRINTS EACH LETTER ON ONE PAGE C BBBBBBBB AAAAAAA NNN NNN NNN NNN EEEEEEEE RRRRRRRR C BBBBBBBBB AAAAAAAAA NNNN NNN NNNN NNN EEEEEEEE RRRRRRRRR C BBB BBB AAA AAA NNNNN NNN NNNNN NNN EEE RRR RRR C BBBBBBBB AAAAAAAAA NNNNNN NNN NNNNNN NNN EEEEEE RRRRRRRR C BBBBBBBB AAAAAAAAA NNN NNNNNN NNN NNNNNN EEEEEE RRRRRRRR C BBB BBB AAA AAA NNN NNNNN NNN NNNNN EEE RRR RRR C BBBBBBBBB AAA AAA NNN NNNN NNN NNNN EEEEEEEE RRR RRR C BBBBBBBB AAA AAA NNN NNN NNN NNN EEEEEEEE RRR RRR C C C C GREINERS GREAT BANNER PROGRAM. C C VALID CHARACTER SET: A B C D E F G H I J K L M N O P Q R S T U V W X Y Z C 1 2 3 4 5 6 7 8 9 0 . , : ; ' " + - ? C C NECESSARY DATA: ONE CARD MAXIMUM 79 CHARACTERS. C TWO SUCCESSIVE BLANKS ENDS DATA STREAM. C C COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX INTEGER INPUT(80), * BLANK/' '/, * CHAR/'X'/ INTEGER A/'A'/, B/'B'/, C/'C'/, D/'D'/, E/'E'/, F/'F'/, G/'G'/ INTEGER H/'H'/,II/'I'/,JJ/'J'/, K/'K'/, L/'L'/,MM/'M'/, N/'N'/ INTEGER O/'O'/, P/'P'/, Q/'Q'/, R/'R'/, S/'S'/, T/'T'/, U/'U'/ INTEGER V/'V'/, W/'W'/, X/'X'/, Y/'Y'/, Z/'Z'/ INTEGER A1/'1'/, A2/'2'/, A3/'3'/, A4/'4'/, A5/'5'/, A6/'6'/ INTEGER A7/'7'/, A8/'8'/, A9/'9'/, A0/'0'/ INTEGER APERIO/'.'/, ACOMMA/','/, ACOLON/':'/ INTEGER ASEMI /';'/, AQUOTE/''''/,ADOUBL/'"'/, AMINUS/'-'/ INTEGER APLUS /'+'/, AQUERY/'?'/ DO 1 I=1,120 BLANX(I)=BLANK 1 RALPH(I)=CHAR READ(5,2)(INPUT(I),I=1,80) 2 FORMAT(80A1) PRINT 3, (INPUT(M),M=1,80) 3 FORMAT(' INPUT CARD WAS: '/' ',80A1/'1') DO 4 J=1,79 IF(INPUT(J).EQ.BLANK.AND.INPUT(J+1).EQ.BLANK) GO TO 5 4 CONTINUE 5 J=J-1 DO 7 I=1,J PRINT 6 6 FORMAT('1') IF(INPUT(I).EQ.BLANK) GO TO 7 IF(INPUT(I).EQ.A) CALL AAA IF(INPUT(I).EQ.B) CALL BBB IF(INPUT(I).EQ.C) CALL CCC IF(INPUT(I).EQ.D) CALL DDD IF(INPUT(I).EQ.E) CALL EEE IF(INPUT(I).EQ.F) CALL FFF IF(INPUT(I).EQ.G) CALL GGG IF(INPUT(I).EQ.H) CALL HHH IF(INPUT(I).EQ.II)CALL III IF(INPUT(I).EQ.JJ)CALL JJJ IF(INPUT(I).EQ.K) CALL KKK IF(INPUT(I).EQ.L) CALL LLL IF(INPUT(I).EQ.MM)CALL MMM IF(INPUT(I).EQ.N) CALL NNN IF(INPUT(I).EQ.O) CALL OOO IF(INPUT(I).EQ.P) CALL PPP IF(INPUT(I).EQ.Q) CALL QQQ IF(INPUT(I).EQ.R) CALL RRR IF(INPUT(I).EQ.S) CALL SSS IF(INPUT(I).EQ.T) CALL TTT IF(INPUT(I).EQ.U) CALL UUU IF(INPUT(I).EQ.V) CALL VVV IF(INPUT(I).EQ.W) CALL WWW IF(INPUT(I).EQ.X) CALL XXX IF(INPUT(I).EQ.Y) CALL YYY IF(INPUT(I).EQ.Z) CALL ZZZ IF(INPUT(I).EQ.A1) CALL S1 IF(INPUT(I).EQ.A2) CALL S2 IF(INPUT(I).EQ.A3) CALL S3 IF(INPUT(I).EQ.A4) CALL S4 IF(INPUT(I).EQ.A5) CALL S5 IF(INPUT(I).EQ.A6) CALL S6 IF(INPUT(I).EQ.A7) CALL S7 IF(INPUT(I).EQ.A8) CALL S8 IF(INPUT(I).EQ.A9) CALL S9 IF(INPUT(I).EQ.A0) CALL OOO IF(INPUT(I).EQ.APERIO) CALL PERIOD IF(INPUT(I).EQ.ACOMMA) CALL COMMA IF(INPUT(I).EQ.ACOLON) CALL COLON IF(INPUT(I).EQ.ASEMI) CALL SEMI IF(INPUT(I).EQ.AQUOTE) CALL QUOTE IF(INPUT(I).EQ.ADOUBL) CALL DOUBLE IF(INPUT(I).EQ.AMINUS) CALL MINUS IF(INPUT(I).EQ.APLUS) CALL PLUS IF(INPUT(I).EQ.AQUERY) CALL QUERY 7 CONTINUE STOP END SUBROUTINE AAA COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 L=120-(21-I) 1 PRINT 2, (RALPH(M),M=1,L) 2 FORMAT(120A1) CALL SUB8 DO 3 I=1,20 K=121-I 3 PRINT 2, (RALPH(M),M=1,K) RETURN END SUBROUTINE BBB COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 CALL SUB9 CALL SUB12 RETURN END SUBROUTINE CCC COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB1 CALL SUB10 CALL SUB10 RETURN END SUBROUTINE DDD COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 CALL SUB10 CALL SUB7 RETURN END SUBROUTINE EEE COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 CALL SUB9 CALL SUB10 RETURN END SUBROUTINE FFF COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 CALL SUB8 CALL SUB17 RETURN END SUBROUTINE GGG COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB1 CALL SUB10 PRINT 2, (RALPH(M),M=1,96) DO 1 I=1,19 K=72-I L=24-I 1 PRINT 2, (BLANX(M),M=1,I), (RALPH(M),M=1,K), (RALPH(M),M=1,L) 2 FORMAT(72A1,24X,24A1) RETURN END SUBROUTINE HHH COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 CALL SUB11 CALL SUB4 RETURN END SUBROUTINE III COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB10 CALL SUB4 CALL SUB10 RETURN END SUBROUTINE JJJ COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 K=20-I L=I+3 1 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,L) 2 FORMAT(24A1) CALL SUB14 CALL SUB5 RETURN END SUBROUTINE KKK COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 DO 1 I=1,20 K=60-I*2 L=4*I 1 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,L) 2 FORMAT(120A1) DO 3 I=1,20 K=20-I*2 L=4*I J=40 IF(L.GE.40)J=39-(I-10)*2 IF(K.LT.1)K=1 3 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,J), * (BLANX(M),M=1,L),(RALPH(M),M=1,J) RETURN END SUBROUTINE LLL COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 CALL SUB14 CALL SUB14 RETURN END SUBROUTINE MMM COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 DO 1 I=1,10 K=90-5*I 1 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,30) 2 FORMAT(120A1) DO 3 I=1,10 K=35+5*I 3 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,30) CALL SUB4 RETURN END SUBROUTINE NNN COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 PRINT 2, (BLANX(M),M=1,80),(RALPH(M),M=1,40) DO 1 I=1,19 K=80-I*4 1 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,40) 2 FORMAT(120A1) CALL SUB4 RETURN END SUBROUTINE OOO COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB1 CALL SUB10 CALL SUB7 RETURN END SUBROUTINE PPP COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 CALL SUB8 CALL SUB15 RETURN END SUBROUTINE QQQ COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB1 DO 1 I=1,10 1 PRINT 2, (RALPH(M),M=1,48) 2 FORMAT(24A1,72X,24A1) DO 3 I=1,6 3 PRINT 4, (RALPH(M),M=1,72) 4 FORMAT(48A1,48X,24A1) DO 5 I=1,4 5 PRINT 2, (RALPH(M),M=1,48) PRINT 7, (RALPH(M),M=1,120) DO 6 I=1,9 L=120-2*I 6 PRINT 7, (BLANX(M),M=1,I),(RALPH(M),M=1,L) 7 FORMAT(120A1) DO 8 I=10,15 L=120-I 8 PRINT 7, (RALPH(M),M=1,L) DO 9 I=16,19 L=120-2*I 9 PRINT 7, (BLANX(M),M=1,I),(RALPH(M),M=1,L) RETURN END SUBROUTINE RRR COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB4 CALL SUB8 DO 1 I=1,20 J=48-I L=72-I*2 K=I*2 1 PRINT 2, (RALPH(M),M=1,J),(BLANX(M),M=1,K),(RALPH(M),M=1,L) 2 FORMAT(120A1) RETURN END SUBROUTINE SSS COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB2 CALL SUB9 CALL SUB13 RETURN END SUBROUTINE TTT COMMON RALPH(120), BLANX(120) CALL SUB17 CALL SUB4 CALL SUB17 RETURN END SUBROUTINE UUU COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB3 CALL SUB14 CALL SUB5 RETURN END SUBROUTINE VVV COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,30 J=50 K=90-I*3 IF(K+J.GT.120)J=120-K 1 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,J) 2 FORMAT(120A1) DO 3 I=1,30 J=50 K=I*3 IF(K+J.GT.120) J=120-K 3 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,J) RETURN END SUBROUTINE WWW COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 3 N=1,2 DO 1 I=1,15 L=60 K=96-I*6 IF(K+L.GT.120) L=120-K 1 PRINT 4, (BLANX(M),M=1,K),(RALPH(M),M=1,L) DO 2 I=1,15 L=60 K=I*6-6 IF(K+L.GT.120) L=120-K 2 PRINT 4, (BLANX(M),M=1,K),(RALPH(M),M=1,L) 3 CONTINUE 4 FORMAT(120A1) RETURN END SUBROUTINE XXX COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,60 K=100-I*2 J=120-K IF(J.GE.40)J=40 L=I*2-20 IF(L+J.GE.120) J=120-L PRINT 2, (BLANX(M),M=1,L),(RALPH(M),M=1,J) 1 PRINT 3, (BLANX(M),M=1,K),(RALPH(M),M=1,J) 2 FORMAT(' ',120A1) 3 FORMAT('+',120A1) RETURN END SUBROUTINE YYY COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 K=80-I*2 1 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,40) 2 FORMAT(120A1) DO 3 I=1,10 K=80-I*2 3 PRINT 2, (RALPH(M),M=1,K) DO 4 I=1,10 K=57+I*2 4 PRINT 2, (RALPH(M),M=1,K) DO 5 I=1,20 K=36+I*2 5 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,40) RETURN END SUBROUTINE ZZZ COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,30 K=I*2-1 L=60-K 1 PRINT 2, (RALPH(M),M=1,30),(RALPH(M),M=1,K), * (BLANX(M),M=1,L),(RALPH(M),M=1,30) 2 FORMAT(120A1) DO 3 I=1,30 K=I*2 L=90-K 3 PRINT 2, (RALPH(M),M=1,30),(BLANX(M),M=1,K),(RALPH(M),M=1,L) RETURN END SUBROUTINE SUB1 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 K=21-I L=120-K*2 1 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,L) 2 FORMAT(120A1) RETURN END SUBROUTINE SUB2 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 J=I+3 K=24-J L=30+2*I 1 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,J), * (BLANX(M),M=1,K),(RALPH(M),M=1,L) 2 FORMAT(24A1,24X,72A1) RETURN END SUBROUTINE SUB3 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 K=21-I L=120-K 1 PRINT 2, (BLANX(M),M=1,K),(RALPH(M),M=1,L) 2 FORMAT(120A1) RETURN END SUBROUTINE SUB4 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 1 PRINT 2, (RALPH(M),M=1,120) 2 FORMAT(120A1) RETURN END SUBROUTINE SUB5 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 L=120-I 1 PRINT 2, (BLANX(M),M=1,I),(RALPH(M),M=1,L) 2 FORMAT(120A1) RETURN END SUBROUTINE SUB6 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,10 1 PRINT 2 2 FORMAT('0') RETURN END SUBROUTINE SUB7 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX PRINT 2, (RALPH(M),M=1,120) DO 1 I=1,19 K=120-2*I 1 PRINT 2, (BLANX(M),M=1,I),(RALPH(M),M=1,K) 2 FORMAT(120A1) RETURN END SUBROUTINE SUB8 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 1 PRINT 2, (RALPH(M),M=1,48) 2 FORMAT(48X,24A1,24X,24A1) RETURN END SUBROUTINE SUB9 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 1 PRINT 2, (RALPH(M),M=1,72) 2 FORMAT(24A1,24X,24A1,24X,24A1) RETURN END SUBROUTINE SUB10 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 1 PRINT 2, (RALPH(M),M=1,48) 2 FORMAT(24A1,72X,24A1) RETURN END SUBROUTINE SUB11 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 1 PRINT 2, (RALPH(M),M=1,24) 2 FORMAT(48X,24A1) RETURN END SUBROUTINE SUB12 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX PRINT 2, (RALPH(M),M=1,72) PRINT 3, (RALPH(M),M=1,72) DO 1 I=1,19 K=72-I*2 PRINT 2, (BLANX(M),M=1,I),(RALPH(M),M=1,K) 1 PRINT 3, (BLANX(M),M=1,I),(RALPH(M),M=1,K) 2 FORMAT(48X,72A1) 3 FORMAT('+',72A1) RETURN END SUBROUTINE SUB13 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 K=72-I*2 L=24-I 1 PRINT 2, (BLANX(M),M=1,I),(RALPH(M),M=1,K), * (BLANX(M),M=1,I),(RALPH(M),M=1,L) 2 FORMAT(72A1,24X,24A1) RETURN END SUBROUTINE SUB14 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 1 PRINT 2, (RALPH(M),M=1,24) 2 FORMAT(24A1) RETURN END SUBROUTINE SUB15 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX PRINT 2, (RALPH(M),M=1,72) DO 1 I=1,19 K=72-I*2 1 PRINT 2, (BLANX(M),M=1,I),(RALPH(M),M=1,K) 2 FORMAT(48X,72A1) RETURN END SUBROUTINE SUB17 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 1 PRINT 2, (RALPH(M),M=1,24) 2 FORMAT(96X,24A1) RETURN END SUBROUTINE S1 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 J=I+27 1 PRINT 2,(RALPH(M),M=1,J) 2 FORMAT(24A1,72X,24A1) CALL SUB4 CALL SUB14 RETURN END SUBROUTINE S2 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 K=I+51 L=72-K J=I+3 1 PRINT 2,(RALPH(M),M=1,K),(BLANX(M),M=1,L),(RALPH(M),M=1,J) 2 FORMAT(72A1,24X,24A1) CALL SUB9 DO 3 I=1,20 K=72-I*2 3 PRINT 4,(RALPH(M),M=1,24),(BLANX(M),M=1,I),(RALPH(M),M=1,K) 4 FORMAT(24A1,24X,72A1) RETURN END SUBROUTINE S3 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 K=21-I L=6+I*2 1 PRINT 2,(BLANX(M),M=1,K),(RALPH(M),M=1,L) 2 FORMAT(24A1,72X,24A1) CALL SUB9 CALL SUB12 RETURN END SUBROUTINE S4 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 1 PRINT 2,(RALPH(M),M=1,48) 2 FORMAT(48X,48A1) CALL SUB11 CALL SUB4 RETURN END SUBROUTINE S5 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 J=21-I K=I+3 L=I+51 1 PRINT 2,(BLANX(M),M=1,J),(RALPH(M),M=1,K), * (BLANX(M),M=1,J),(RALPH(M),M=1,L) 2 FORMAT(24A1,24X,72A1) CALL SUB9 DO 3 I=1,20 K=72-I*2 3 PRINT 4,(BLANX(M),M=1,I),(RALPH(M),M=1,K), * (BLANX(M),M=1,I),(RALPH(M),M=1,24) 4 FORMAT(72A1,24X,24A1) RETURN END SUBROUTINE S6 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB1 CALL SUB9 CALL SUB13 RETURN END SUBROUTINE S7 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB17 CALL SUB17 CALL SUB4 RETURN END SUBROUTINE S8 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 K=21-I L=72-K*2 PRINT 2,(BLANX(M),M=1,K),(RALPH(M),M=1,L) 1 PRINT 3,(BLANX(M),M=1,K),(RALPH(M),M=1,L) 2 FORMAT('+',72A1) 3 FORMAT(48X,72A1) CALL SUB9 CALL SUB12 RETURN END SUBROUTINE S9 COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB2 CALL SUB9 CALL SUB7 RETURN END SUBROUTINE PERIOD COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB6 DO 1 I=1,20 1 PRINT 2,(RALPH(M),M=1,24) 2 FORMAT(24A1) RETURN END SUBROUTINE COMMA COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB6 DO 1 I=1,10 1 PRINT 2,(RALPH(M),M=1,10) 2 FORMAT(10X,10A1) DO 3 I=1,10 K=20-I 3 PRINT 4,(BLANX(M),M=1,I),(RALPH(M),M=1,K) 4 FORMAT(20A1) RETURN END SUBROUTINE COLON COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB6 DO 1 I=1,20 1 PRINT 2,(RALPH(M),M=1,48) 2 FORMAT(24X,24A1,24X,24A1) RETURN END SUBROUTINE SEMI COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB6 DO 1 I=1,20 K=48-I 1 PRINT 2,(BLANX(M),M=1,I),(RALPH(M),M=1,K) 2 FORMAT(24X,24A1,24X,24A1) RETURN END SUBROUTINE QUOTE COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB6 DO 1 I=1,10 1 PRINT 2,(RALPH(M),M=1,24) 2 FORMAT(96X,24A1) RETURN END SUBROUTINE DOUBLE COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB6 DO 1 I=1,10 1 PRINT 2,(RALPH(M),M=1,24) 2 FORMAT(96X,24A1) DO 3 I=1,5 3 PRINT 4 4 FORMAT(' ') DO 5 I=1,10 5 PRINT 2,(RALPH(M),M=1,24) RETURN END SUBROUTINE MINUS COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,3 1 CALL SUB11 RETURN END SUBROUTINE PLUS COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX CALL SUB11 CALL SUB4 CALL SUB11 RETURN END SUBROUTINE QUERY COMMON RALPH(120), BLANX(120) INTEGER RALPH, BLANX DO 1 I=1,20 K=I+4 1 PRINT 2,(RALPH(M),M=1,K) 1 PRINT 2,(RALPH(M),M=1,K) 2 FORMAT(96X,24A1) CALL SUB9 CALL SUB15 RETURN END FAREWELL, CHERYL AND BETSY COMMON FILE(120,8), BLANK, CHAR, M INTEGER A/'A'/, B/'B'/, C/'C'/, D/'D'/, E/'E'/, F/'F'/, G/'G'/ INTEGER H/'H'/,I1/'I'/,J1/'J'/, K/'K'/, L/'L'/,M1/'M'/, N/'N'/ INTEGER O/'O'/, P/'P'/, Q/'Q'/, R/'R'/, S/'S'/, T/'T'/, U/'U'/ INTEGER V/'V'/, W/'W'/, X/'X'/, Y/'Y'/, Z/'Z'/, $/'$'/ INTEGER A1/'1'/, A2/'2'/, A3/'3'/, A4/'4'/, A5/'5'/ INTEGER A6/'6'/, A7/'7'/, A8/'8'/, A9/'9'/, A0/'0'/ INTEGER FILE, CARD(80), CODE, CHAR, BLANC/' '/, RIGHT, BLANK BLANK=BLANC 1000 PRINT 15 CODE=0 READ(5,1,END=16) (CARD(I),I=1,80) 1 FORMAT(80A1) LEFT=1 2 LEFT1=LEFT+10 DO 3 I=LEFT,LEFT1 IF(I.GT.80) GO TO 12 IF(CARD(I).NE.$) GO TO 3 CODE=1 RIGHT=I-1 GO TO 6 3 CONTINUE RIGHT=LEFT1 4 IF(CARD(RIGHT).EQ.BLANK) GO TO 5 RIGHT=RIGHT-1 IF(RIGHT.EQ.LEFT) GO TO 12 GO TO 4 5 RIGHT=RIGHT-1 6 DO 7 I=1,120 DO 7 J=1,8 7 FILE(I,J)=BLANK M=6*(9-(RIGHT-LEFT)) DO 9 I=LEFT,RIGHT CHAR=CARD(I) IF(CHAR.EQ.A) CALL AA IF(CHAR.EQ.B) CALL BB IF(CHAR.EQ.C) CALL CC IF(CHAR.EQ.D) CALL DD IF(CHAR.EQ.E) CALL EE IF(CHAR.EQ.F) CALL FF IF(CHAR.EQ.G) CALL GG IF(CHAR.EQ.H) CALL HH IF(CHAR.EQ.I1)CALL II IF(CHAR.EQ.J1)CALL JJ IF(CHAR.EQ.K) CALL KK IF(CHAR.EQ.L) CALL LL IF(CHAR.EQ.M1)CALL MM IF(CHAR.EQ.N) CALL NN IF(CHAR.EQ.O) CALL OO IF(CHAR.EQ.P) CALL PP IF(CHAR.EQ.Q) CALL QQ IF(CHAR.EQ.R) CALL RR IF(CHAR.EQ.S) CALL SS IF(CHAR.EQ.T) CALL TT IF(CHAR.EQ.U) CALL UU IF(CHAR.EQ.V) CALL VV IF(CHAR.EQ.W) CALL WW IF(CHAR.EQ.X) CALL XX IF(CHAR.EQ.Y) CALL YY IF(CHAR.EQ.Z) CALL ZZ IF(CHAR.EQ.A1) CALL S1 IF(CHAR.EQ.A2) CALL S2 IF(CHAR.EQ.A3) CALL S3 IF(CHAR.EQ.A4) CALL S4 IF(CHAR.EQ.A5) CALL S5 IF(CHAR.EQ.A6) CALL S6 IF(CHAR.EQ.A7) CALL S7 IF(CHAR.EQ.A8) CALL S8 IF(CHAR.EQ.A9) CALL S9 IF(CHAR.EQ.A0) CALL OO IF(CHAR.EQ.BLANK) M=M+12 9 CONTINUE DO 10 J=1,8 10 PRINT 11, (FILE(I,J),I=1,120) 11 FORMAT(1X,120A1) PRINT 14 PRINT 14 14 FORMAT(1H0) LEFT=RIGHT+2 IF(CODE.EQ.1) GO TO 1000 GO TO 2 12 PRINT 13 13 FORMAT(' INVALID DATA IN INPUT STREAM') 15 FORMAT(1H1) GO TO 1000 16 STOP END SUBROUTINE AA COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S11 M=M+3 CALL S20 M=M+3 CALL S12 M=M+6 RETURN END SUBROUTINE BB COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S18 M=M+3 CALL S26 M=M+6 RETURN END SUBROUTINE CC COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S19 M=M+3 CALL S19 FILE(M+3,1)=BLANK FILE(M+3,8)=BLANK M=M+6 RETURN END SUBROUTINE DD COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S19 M=M+3 CALL S16 M=M+6 RETURN END SUBROUTINE EE COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S18 M=M+3 CALL S19 M=M+6 RETURN END SUBROUTINE FF COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,2 1 FILE(M+I,J)=CHAR RETURN END SUBROUTINE GG COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S19 FILE(M+3,4)=CHAR FILE(M+3,5)=CHAR M=M+3 CALL S18 FILE(M+1,6)=CHAR FILE(M+2,6)=CHAR FILE(M+3,1)=BLANK FILE(M+3,6)=CHAR FILE(M+3,8)=BLANK M=M+6 RETURN END SUBROUTINE HH COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S25 M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE II COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S19 M=M+3 CALL S17 M=M+3 CALL S19 M=M+6 RETURN END SUBROUTINE JJ COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S22 FILE(M+1,8)=BLANK M=M+3 CALL S22 M=M+3 CALL S14 M=M+6 RETURN END SUBROUTINE KK COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S25 FILE(M+2,3)=CHAR FILE(M+2,6)=CHAR FILE(M+3,2)=CHAR FILE(M+3,3)=CHAR FILE(M+3,6)=CHAR FILE(M+3,7)=CHAR M=M+3 CALL S19 FILE(M+1,3)=CHAR FILE(M+1,6)=CHAR M=M+6 RETURN END SUBROUTINE LL COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S22 M=M+3 CALL S22 M=M+6 RETURN END SUBROUTINE MM COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 DO 1 J=2,4 FILE(M+1,J)=CHAR FILE(M+2,J+1)=CHAR 1 FILE(M+3,J)=CHAR M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE NN COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 DO 1 J=2,4 FILE(M+1,J)=CHAR FILE(M+2,J+2)=CHAR 1 FILE(M+3,J+3)=CHAR M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE OO COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S19 M=M+3 CALL S16 M=M+6 RETURN END SUBROUTINE PP COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S20 M=M+3 CALL S27 FILE(M+3,1)=BLANK FILE(M+3,5)=BLANK M=M+6 RETURN END SUBROUTINE QQ COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S19 FILE(M+2,6)=CHAR M=M+3 CALL S12 FILE(M+2,8)=BLANK FILE(M+3,7)=BLANK M=M+6 RETURN END SUBROUTINE RR COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S20 M=M+3 CALL S12 FILE(M+3,4)=BLANK FILE(M+3,5)=BLANK M=M+6 RETURN END SUBROUTINE SS COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S23 M=M+3 CALL S18 M=M+3 CALL S24 M=M+6 RETURN END SUBROUTINE TT COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S21 M=M+3 CALL S17 M=M+3 CALL S21 RETURN END SUBROUTINE UU COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S13 M=M+3 CALL S22 M=M+3 CALL S14 M=M+6 RETURN END SUBROUTINE VV COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S27 FILE(M+1,5)=BLANK DO 1 J=4,6 FILE(M+3,J)=CHAR FILE(M+4,J+1)=CHAR FILE(M+5,J+2)=CHAR FILE(M+6,J+1)=CHAR 1 FILE(M+7,J)=CHAR M=M+6 CALL S27 FILE(M+3,5)=BLANK M=M+6 RETURN END SUBROUTINE WW COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 DO 1 J=5,7 FILE(M+1,J)=CHAR FILE(M+2,J-1)=CHAR 1 FILE(M+3,J)=CHAR M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE XX COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=2,4 FILE(M+I,3)=CHAR FILE(M+I+4,3)=CHAR FILE(M+I,6)=CHAR 1 FILE(M+I+4,6)=CHAR CALL S19 M=M+3 CALL S25 M=M+3 CALL S19 M=M+6 RETURN END SUBROUTINE YY COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=2,4 FILE(M+I,3)=CHAR FILE(M+I+4,3)=CHAR FILE(M+I+1,4)=CHAR 1 FILE(M+I+3,4)=CHAR CALL S21 M=M+3 DO 2 I=1,3 DO 2 J=5,8 2 FILE(M+I,J)=CHAR M=M+3 CALL S21 M=M+6 RETURN END SUBROUTINE ZZ COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=2,4 FILE(M+I,6)=CHAR FILE(M+I+1,5)=CHAR FILE(M+I+3,4)=CHAR 1 FILE(M+I+4,3)=CHAR CALL S19 M=M+3 CALL S19 M=M+3 CALL S19 M=M+6 RETURN END SUBROUTINE S1 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S19 FILE(M+1,1)=BLANK M=M+3 CALL S17 M=M+3 CALL S22 M=M+6 RETURN END SUBROUTINE S2 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S11 FILE(M+1,4)=BLANK DO 1 I=1,3 1 FILE(M+I,3)=BLANK M=M+3 CALL S18 M=M+3 CALL S26 FILE(M+1,5)=BLANK FILE(M+2,5)=BLANK FILE(M+3,8)=CHAR DO 2 I=1,3 2 FILE(M+I,6)=BLANK M=M+6 RETURN END SUBROUTINE S3 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S19 FILE(M+1,1)=BLANK FILE(M+1,8)=BLANK M=M+3 CALL S18 M=M+3 CALL S26 M=M+6 RETURN END SUBROUTINE S4 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S27 M=M+3 CALL S25 M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE S5 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S23 FILE(M+1,1)=CHAR M=M+3 CALL S18 M=M+3 CALL S24 FILE(M+3,1)=CHAR M=M+6 RETURN END SUBROUTINE S6 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S18 M=M+3 CALL S24 M=M+6 RETURN END SUBROUTINE S7 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S21 M=M+3 CALL S21 M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE S8 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,1)=BLANK FILE(M+1,4)=BLANK FILE(M+1,5)=BLANK FILE(M+1,8)=BLANK M=M+3 CALL S18 M=M+3 CALL S26 M=M+6 RETURN END SUBROUTINE S9 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S23 M=M+3 CALL S18 M=M+3 CALL S16 M=M+6 RETURN END SUBROUTINE S11 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,1)=BLANK RETURN END SUBROUTINE S12 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+3,1)=BLANK RETURN END SUBROUTINE S13 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,8)=BLANK RETURN END SUBROUTINE S14 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+3,8)=BLANK RETURN END SUBROUTINE S15 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,1)=BLANK FILE(M+1,8)=BLANK RETURN END SUBROUTINE S16 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+3,1)=BLANK FILE(M+3,8)=BLANK RETURN END SUBROUTINE S17 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,8 1 FILE(M+I,J)=CHAR RETURN END SUBROUTINE S18 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,2 FILE(M+I,J)=CHAR FILE(M+I,J+3)=CHAR 1 FILE(M+I,J+6)=CHAR RETURN END SUBROUTINE S19 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,2 FILE(M+I,J)=CHAR 1 FILE(M+I,J+6)=CHAR RETURN END SUBROUTINE S20 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,2 FILE(M+I,J)=CHAR 1 FILE(M+I,J+3)=CHAR RETURN END SUBROUTINE S21 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S20 M=M+3 CALL S21 M=M+6 RETURN END SUBROUTINE S22 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=7,8 1 FILE(M+I,J)=CHAR RETURN END SUBROUTINE S23 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,1)=BLANK FILE(M+1,5)=BLANK FILE(M+1,6)=BLANK FILE(M+1,8)=BLANK FILE(M+2,6)=BLANK FILE(M+3,6)=BLANK RETURN END SUBROUTINE S24 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,3)=BLANK FILE(M+2,3)=BLANK FILE(M+3,1)=BLANK FILE(M+3,3)=BLANK FILE(M+3,4)=BLANK FILE(M+3,8)=BLANK RETURN END SUBROUTINE S25 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=4,5 1 FILE(M+I,J)=CHAR RETURN END SUBROUTINE S26 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+3,1)=BLANK FILE(M+3,4)=BLANK FILE(M+3,5)=BLANK FILE(M+3,8)=BLANK RETURN END SUBROUTINE S27 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,5 1 FILE(M+I,J)=CHAR RETURN END HI C BANNER PROGRAM COMMON FILE(120,8), BLANK, CHAR, M INTEGER A/'A'/, B/'B'/, C/'C'/, D/'D'/, E/'E'/, F/'F'/, G/'G'/ INTEGER H/'H'/,I1/'I'/,J1/'J'/, K/'K'/, L/'L'/,M1/'M'/, N/'N'/ INTEGER O/'O'/, P/'P'/, Q/'Q'/, R/'R'/, S/'S'/, T/'T'/, U/'U'/ INTEGER V/'V'/, W/'W'/, X/'X'/, Y/'Y'/, Z/'Z'/, $/'$'/ INTEGER A1/'1'/, A2/'2'/, A3/'3'/, A4/'4'/, A5/'5'/ INTEGER A6/'6'/, A7/'7'/, A8/'8'/, A9/'9'/, A0/'0'/ INTEGER FILE, CARD(80), CODE, CHAR, BLANC/' '/, RIGHT, BLANK BLANK=BLANC 1000 PRINT 15 CODE=0 READ(5,1,END=16) (CARD(I),I=1,80) 1 FORMAT(80A1) LEFT=1 2 LEFT1=LEFT+10 DO 3 I=LEFT,LEFT1 IF(I.GT.80) GO TO 12 IF(CARD(I).NE.$) GO TO 3 CODE=1 RIGHT=I-1 GO TO 6 3 CONTINUE RIGHT=LEFT1 4 IF(CARD(RIGHT).EQ.BLANK) GO TO 5 RIGHT=RIGHT-1 IF(RIGHT.EQ.LEFT) GO TO 12 GO TO 4 5 RIGHT=RIGHT-1 6 DO 7 I=1,120 DO 7 J=1,8 7 FILE(I,J)=BLANK M=6*(9-(RIGHT-LEFT)) DO 9 I=LEFT,RIGHT CHAR=CARD(I) IF(CHAR.EQ.A) CALL AA IF(CHAR.EQ.B) CALL BB IF(CHAR.EQ.C) CALL CC IF(CHAR.EQ.D) CALL DD IF(CHAR.EQ.E) CALL EE IF(CHAR.EQ.F) CALL FF IF(CHAR.EQ.G) CALL GG IF(CHAR.EQ.H) CALL HH IF(CHAR.EQ.I1)CALL II IF(CHAR.EQ.J1)CALL JJ IF(CHAR.EQ.K) CALL KK IF(CHAR.EQ.L) CALL LL IF(CHAR.EQ.M1)CALL MM IF(CHAR.EQ.N) CALL NN IF(CHAR.EQ.O) CALL OO IF(CHAR.EQ.P) CALL PP IF(CHAR.EQ.Q) CALL QQ IF(CHAR.EQ.R) CALL RR IF(CHAR.EQ.S) CALL SS IF(CHAR.EQ.T) CALL TT IF(CHAR.EQ.U) CALL UU IF(CHAR.EQ.V) CALL VV IF(CHAR.EQ.W) CALL WW IF(CHAR.EQ.X) CALL XX IF(CHAR.EQ.Y) CALL YY IF(CHAR.EQ.Z) CALL ZZ IF(CHAR.EQ.A1) CALL S1 IF(CHAR.EQ.A2) CALL S2 IF(CHAR.EQ.A3) CALL S3 IF(CHAR.EQ.A4) CALL S4 IF(CHAR.EQ.A5) CALL S5 IF(CHAR.EQ.A6) CALL S6 IF(CHAR.EQ.A7) CALL S7 IF(CHAR.EQ.A8) CALL S8 IF(CHAR.EQ.A9) CALL S9 IF(CHAR.EQ.A0) CALL OO IF(CHAR.EQ.BLANK) M=M+12 9 CONTINUE DO 10 J=1,8 10 PRINT 11, (FILE(I,J),I=1,120) 11 FORMAT(1X,120A1) PRINT 14 PRINT 14 14 FORMAT(1H0) LEFT=RIGHT+2 IF(CODE.EQ.1) GO TO 1000 GO TO 2 12 PRINT 13 13 FORMAT(' INVALID DATA IN INPUT STREAM') 15 FORMAT(1H1) GO TO 1000 16 STOP END SUBROUTINE AA COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S11 M=M+3 CALL S20 M=M+3 CALL S12 M=M+6 RETURN END SUBROUTINE BB COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S18 M=M+3 CALL S26 M=M+6 RETURN END SUBROUTINE CC COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S19 M=M+3 CALL S19 FILE(M+3,1)=BLANK FILE(M+3,8)=BLANK M=M+6 RETURN END SUBROUTINE DD COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S19 M=M+3 CALL S16 M=M+6 RETURN END SUBROUTINE EE COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S18 M=M+3 CALL S19 M=M+6 RETURN END SUBROUTINE FF COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,2 1 FILE(M+I,J)=CHAR RETURN END SUBROUTINE GG COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S19 FILE(M+3,4)=CHAR FILE(M+3,5)=CHAR M=M+3 CALL S18 FILE(M+1,6)=CHAR FILE(M+2,6)=CHAR FILE(M+3,1)=BLANK FILE(M+3,6)=CHAR FILE(M+3,8)=BLANK M=M+6 RETURN END SUBROUTINE HH COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S25 M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE II COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S19 M=M+3 CALL S17 M=M+3 CALL S19 M=M+6 RETURN END SUBROUTINE JJ COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S22 FILE(M+1,8)=BLANK M=M+3 CALL S22 M=M+3 CALL S14 M=M+6 RETURN END SUBROUTINE KK COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S25 FILE(M+2,3)=CHAR FILE(M+2,6)=CHAR FILE(M+3,2)=CHAR FILE(M+3,3)=CHAR FILE(M+3,6)=CHAR FILE(M+3,7)=CHAR M=M+3 CALL S19 FILE(M+1,3)=CHAR FILE(M+1,6)=CHAR M=M+6 RETURN END SUBROUTINE LL COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S22 M=M+3 CALL S22 M=M+6 RETURN END SUBROUTINE MM COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 DO 1 J=2,4 FILE(M+1,J)=CHAR FILE(M+2,J+1)=CHAR 1 FILE(M+3,J)=CHAR M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE NN COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 DO 1 J=2,4 FILE(M+1,J)=CHAR FILE(M+2,J+2)=CHAR 1 FILE(M+3,J+3)=CHAR M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE OO COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S19 M=M+3 CALL S16 M=M+6 RETURN END SUBROUTINE PP COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S20 M=M+3 CALL S27 FILE(M+3,1)=BLANK FILE(M+3,5)=BLANK M=M+6 RETURN END SUBROUTINE QQ COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S19 FILE(M+2,6)=CHAR M=M+3 CALL S12 FILE(M+2,8)=BLANK FILE(M+3,7)=BLANK M=M+6 RETURN END SUBROUTINE RR COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S20 M=M+3 CALL S12 FILE(M+3,4)=BLANK FILE(M+3,5)=BLANK M=M+6 RETURN END SUBROUTINE SS COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S23 M=M+3 CALL S18 M=M+3 CALL S24 M=M+6 RETURN END SUBROUTINE TT COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S21 M=M+3 CALL S17 M=M+3 CALL S21 M=M+6 RETURN END SUBROUTINE UU COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S13 M=M+3 CALL S22 M=M+3 CALL S14 M=M+6 RETURN END SUBROUTINE VV COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S27 FILE(M+1,5)=BLANK DO 1 J=4,6 FILE(M+3,J)=CHAR FILE(M+4,J+1)=CHAR FILE(M+5,J+2)=CHAR FILE(M+6,J+1)=CHAR 1 FILE(M+7,J)=CHAR M=M+6 CALL S27 FILE(M+3,5)=BLANK M=M+6 RETURN END SUBROUTINE WW COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 DO 1 J=5,7 FILE(M+1,J)=CHAR FILE(M+2,J-1)=CHAR 1 FILE(M+3,J)=CHAR M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE XX COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=2,4 FILE(M+I,3)=CHAR FILE(M+I+4,3)=CHAR FILE(M+I,6)=CHAR 1 FILE(M+I+4,6)=CHAR CALL S19 M=M+3 CALL S25 M=M+3 CALL S19 M=M+6 RETURN END SUBROUTINE YY COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=2,4 FILE(M+I,3)=CHAR FILE(M+I+4,3)=CHAR FILE(M+I+1,4)=CHAR 1 FILE(M+I+3,4)=CHAR CALL S21 M=M+3 DO 2 I=1,3 DO 2 J=5,8 2 FILE(M+I,J)=CHAR M=M+3 CALL S21 M=M+6 RETURN END SUBROUTINE ZZ COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=2,4 FILE(M+I,6)=CHAR FILE(M+I+1,5)=CHAR FILE(M+I+3,4)=CHAR 1 FILE(M+I+4,3)=CHAR CALL S19 M=M+3 CALL S19 M=M+3 CALL S19 M=M+6 RETURN END SUBROUTINE S1 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S19 FILE(M+1,1)=BLANK M=M+3 CALL S17 M=M+3 CALL S22 M=M+6 RETURN END SUBROUTINE S2 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S11 FILE(M+1,4)=BLANK DO 1 I=1,3 1 FILE(M+I,3)=BLANK M=M+3 CALL S18 M=M+3 CALL S26 FILE(M+1,5)=BLANK FILE(M+2,5)=BLANK FILE(M+3,8)=CHAR DO 2 I=1,3 2 FILE(M+I,6)=BLANK M=M+6 RETURN END SUBROUTINE S3 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S19 FILE(M+1,1)=BLANK FILE(M+1,8)=BLANK M=M+3 CALL S18 M=M+3 CALL S26 M=M+6 RETURN END SUBROUTINE S4 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S27 M=M+3 CALL S25 M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE S5 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S23 FILE(M+1,1)=CHAR M=M+3 CALL S18 M=M+3 CALL S24 FILE(M+3,1)=CHAR M=M+6 RETURN END SUBROUTINE S6 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S15 M=M+3 CALL S18 M=M+3 CALL S24 M=M+6 RETURN END SUBROUTINE S7 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S21 M=M+3 CALL S21 M=M+3 CALL S17 M=M+6 RETURN END SUBROUTINE S8 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,1)=BLANK FILE(M+1,4)=BLANK FILE(M+1,5)=BLANK FILE(M+1,8)=BLANK M=M+3 CALL S18 M=M+3 CALL S26 M=M+6 RETURN END SUBROUTINE S9 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S23 M=M+3 CALL S18 M=M+3 CALL S16 M=M+6 RETURN END SUBROUTINE S11 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,1)=BLANK RETURN END SUBROUTINE S12 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+3,1)=BLANK RETURN END SUBROUTINE S13 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,8)=BLANK RETURN END SUBROUTINE S14 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+3,8)=BLANK RETURN END SUBROUTINE S15 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,1)=BLANK FILE(M+1,8)=BLANK RETURN END SUBROUTINE S16 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+3,1)=BLANK FILE(M+3,8)=BLANK RETURN END SUBROUTINE S17 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,8 1 FILE(M+I,J)=CHAR RETURN END SUBROUTINE S18 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,2 FILE(M+I,J)=CHAR FILE(M+I,J+3)=CHAR 1 FILE(M+I,J+6)=CHAR RETURN END SUBROUTINE S19 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,2 FILE(M+I,J)=CHAR 1 FILE(M+I,J+6)=CHAR RETURN END SUBROUTINE S20 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,2 FILE(M+I,J)=CHAR 1 FILE(M+I,J+3)=CHAR RETURN END SUBROUTINE S21 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 M=M+3 CALL S20 M=M+3 CALL S21 M=M+6 RETURN END SUBROUTINE S22 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=7,8 1 FILE(M+I,J)=CHAR RETURN END SUBROUTINE S23 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,1)=BLANK FILE(M+1,5)=BLANK FILE(M+1,6)=BLANK FILE(M+1,8)=BLANK FILE(M+2,6)=BLANK FILE(M+3,6)=BLANK RETURN END SUBROUTINE S24 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+1,3)=BLANK FILE(M+2,3)=BLANK FILE(M+3,1)=BLANK FILE(M+3,3)=BLANK FILE(M+3,4)=BLANK FILE(M+3,8)=BLANK RETURN END SUBROUTINE S25 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=4,5 1 FILE(M+I,J)=CHAR RETURN END SUBROUTINE S26 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK CALL S17 FILE(M+3,1)=BLANK FILE(M+3,4)=BLANK FILE(M+3,5)=BLANK FILE(M+3,8)=BLANK RETURN END SUBROUTINE S27 COMMON FILE(120,8), BLANK, CHAR, M INTEGER FILE, CHAR, BLANK DO 1 I=1,3 DO 1 J=1,5 1 FILE(M+I,J)=CHAR RETURN END ->30 -IMPURE -MATHEMATICS - -ONCE UPON A TIME (1/-T) PRETTY LITTLE -POLLY -NOMIAL WAS STROLLING ACROSS A FIELD OF VECTORS WHEN SHE CAME TO THE EDGE OF A SINGULARLY LARGE MATRIX. - -NOW -POLLY WAS CONVERGENT AND HER MOTHER HAD MADE IT AN ABSOLUTE CONDITION THAT SHE MUST NEVER ENTER SUCH AN ARRAY WITHOUT HER BRACKETS ON. -POLLY, HOWEVER, WHO HAD CHANGED HER VARIABLES THAT MORNING AND WAS FEELING PARTICULARLY BADLY BEHAVED, IGNORED THIS CONDITION ON THE GROUNDS THAT IT WAS INSUFFICIENT AND MADE HER WAY IN AMONGST THE COMPLEX ELEMENTS. - -ROWS AND COLUMNS ENVELOPED HER ON ALL SIDES. -TANGENTS APPROACHED HER SURFACE. -SHE BECAME TENSOR AND TENSOR. -QUITE SUDDENLY, THREE BRANCHES OF A HYPERBOLA TOUCHED HER AT A SINGLE POINT. -SHE OSCILLATED VIOLENTLY, LOST ALL SENSE OF DIRECTRIX AND WENT COMPLETELY DIVERGENT. -AS SHE REACHED A TURNING POINT SHE TRIPPED OVER A SQUARE ROOT WHICH WAS PROTRUDING FROM THE ERF AND PLUNGED HEADLONG DOWN A STEEP GRADIENT. -WHEN SHE WAS DIFFERENTIATED ONCE MORE SHE FOUND HERSELF, APPARENTLY ALONE, IN A NON-EUCLIDEAN SPACE. --- -SHE WAS BEING WATCHED HOWEVER. -THAT SMOOTH OPERATOR, -CURLY -PI, WAS LURKING INNER PRODUCT. -AS HIS EYES DEVOURED HER CURVILINEAR COORDINATES A SINGULAR EXPRESSION CROSSED HIS FACE. -WAS SHE STILL CONVERGENT, HE WONDERED. -HE DECIDED TO INTEGRATE IMPROPERLY AT ONCE. - -HEARING A VULGAR FRACTION BEHIND HER -POLLY TURNED ROUND AND SAW -CURLEY -PI APPROACHING WITH HIS POWER SERIES EXTRAPOLATED. -SHE COULD SEE AT ONCE, BY HIS DEGENERATE CONIC AND HIS DISSIPATIVE TERMS THAT HE WAS BENT ON NO GOOD. - '-EUREKA,' SHE GASPED. - '-HO, HO,' HE SAID. '-WHAT A SYMMETRIC LITTLE POLYNOMIAL YOU ARE. -I CAN SEE YOU'RE BUBBLING OVER WITH SECS.' - '-O SIR,' SHE PROTESTED, 'KEEP AWAY FROM ME. -I HAVEN'T GOT MY BRACKETS ON.' - '-CALM YOURSELF, MY DEAR,' SAID OUR SUAVE OPERATOR, 'YOUR FEARS ARE PURELY IMAGINARY.' - '-I, -I,' SHE THOUGHT. '-PERHAPS HE'S HOMOGENEOUS THEN.' - '-WHAT ORDER ARE YOU,' THE BRUTE DEMANDED. - '-SEVENTEEN,' REPLIED -POLLY. - -CURLY LEERED. '-I SUPPOSE YOU'VE NEVER BEEN OPERATED ON YET,' HE ASKED. - '-OF COURSE NOT,' -POLLY CRIED INDIGNANTLY. '-I'M ABSOLUTELY CONVERGENT.' - '-COME, COME,' SAID -CURLEY. '-LETS OFF TO A DECIMAL PLACE -I KNOW AND -I'LL TAKE YOU TO THE LIMIT.' - '-NEVER' GASPED -POLLY. --- '-EXCHLF' HE SWORE, USING THE VILEST OATH HE KNEW. -HIS PATIENCE WAS GONE. -COSHING HER OVER THE COEFFICIENT WITH A LOG UNTIL SHE WAS POWER LESS, CURLY REMOVED HER DISCONTINUITIES. -HE STARED AT HER SIGNIFICANT PLACES AND BEGAN SMOOTHING HER POINTS OF INFLEXION. -POOR -POLLY. -ALL WAS UP. -SHE FELT HIS HAND TENDING TO HER ASYMPTOTIC LIMIT. -HER CONVERGENCE WOULD SOON BE GONE FOR EVER. - -THERE WAS NO MERCY, FOR -CURLY WAS A HEAVYSIDE OPERATOR. -HE INTEGRATED BY PARTS. -HE INTEGRATED BY PARTIAL FRACTIONS. -THE COMPLEX BEAST EVEN WENT ALL THE WAY ROUND AND DID A CONTOUR INTEGRATION. -WHAT AN INDIGNITY. TO BE MULTIPLY CONNECTED ON HER FIRST INTEGRATION. -CURLY WENT ON OPERATING UNTIL HE WAS ABSOLUTELY AND COMPLETELY ORTHOGONAL. - -WHEN -POLLY GOT HOME THAT EVENING HER MOTHER NOTICED THAT SHE HAD BEEN TRUNCATED IN SEVERAL PLACES. -BUT IT WAS TOO LATE TO DIFFERENTIATE NOW. AS THE MONTHS WENT BY, -POLLY INCREASED MONOTONICALLY. -FINALLY SHE GENERATED A SMALL BUT PATHOLOGICAL FUNCTION WHICH LEFT SURDS ALL OVER THE PLACE UNTIL SHE WAS DRIVEN TO DISTRACTION. - -THE MORAL OF OUR SAD STORY IS THIS: IF YOU WANT TO KEEP YOUR EXPRESSIONS CONVERGENT, NEVER ALLOW THEM A SINGLE DEGREE OF FREEDOM. CALENDER PROGRAM C..... THIS VERSION OF "CALANDAR" IS GOOD ONLY AFTER 1760. C..... NECESSARY DATA CARDS ARE: C..... ONE CARD FOR EACH YEAR TO BE PRINTED (I4 FORMAT). INTEGER JA(45),FE(45),MA(45),AP(45),MY(45),JN(45), CAL 1 * JL(45),AU(45),SE(45),OC(45),NO(45),DE(45) CAL 2 1 READ(5,2,END=45)IY CAL 3 2 FORMAT(I4) CAL 4 3 LEAP=0 CAL 5 DO 4 IB=1,45 CAL 6 JA(IB)=1000 CAL 7 FE(IB)=1000 CAL 8 MA(IB)=1000 CAL 9 AP(IB)=1000 CAL 10 MY(IB)=1000 CAL 11 JN(IB)=1000 CAL 12 JL(IB)=1000 CAL 13 AU(IB)=1000 CAL 14 SE(IB)=1000 CAL 15 OC(IB)=1000 CAL 16 NO(IB)=1000 CAL 17 4 DE(IB)=1000 CAL 18 N=IY-1760 CAL 19 M=(N-1)/4 CAL 20 I=4*M+1 CAL 21 ID=(M+1)*5+N-I CAL 22 IF(IY-(IY/100)*100)6,5,6 CAL 23 5 IF(IY-(IY/400)*400)8,7,8 CAL 24 6 IF(N-3-I)8,7,8 CAL 25 7 LEAP=1 CAL 26 8 IF(N-40)13,13,9 CAL 27 9 DO 10 I=41,N,100 CAL 28 10 ID=ID-1 CAL 29 IF(N-240)13,13,11 CAL 30 11 DO 12 I=241,N,400 CAL 31 12 ID=ID+1 CAL 32 13 IS=(ID-1)/7 CAL 33 K=ID-7*IS CAL 34 J=1 CAL 35 L=K+30 CAL 36 DO 14 I=K,L CAL 37 JA(I)=J CAL 38 14 J=J+1 CAL 39 IF(LEAP)19,19,15 CAL 40 15 L=K+28 CAL 41 DO 16 I=K,L CAL 42 16 FE(I+3)=JA(I) CAL 43 L=K+29 CAL 44 DO 17 I=K,L CAL 45 17 AP(I)=JA(I) CAL 46 L=K+30 CAL 47 DO 18 I=K,L CAL 48 18 JL(I)=JA(I) CAL 49 GO TO 27 CAL 50 19 L=K+27 CAL 51 DO 20 I=K,L CAL 52 20 FE(I+3)=JA(I) CAL 53 L=K+29 CAL 54 IF(JA(7)-7)21,24,24 CAL 55 21 DO 22 I=K,L CAL 56 22 AP(I-1)=JA(I) CAL 57 L=K+30 CAL 58 DO 23 I=K,L CAL 59 23 JL(I-1)=JA(I) CAL 60 K=K-1 CAL 61 GO TO 28 CAL 62 24 DO 25 I=K,L CAL 63 25 AP(I+6)=JA(I) CAL 64 L=K+30 CAL 65 DO 26 I=K,L CAL 66 26 JL(I+6)=JA(I) CAL 67 K=K+6 CAL 68 27 L=K+30 CAL 69 28 DO 31 I=K,L CAL 70 MA(I+4)=JL(I) CAL 71 MY(I+2)=JL(I) CAL 72 AU(I+3)=JL(I) CAL 73 OC(I+1)=JL(I) CAL 74 IF(JL(7)-7)29,30,30 CAL 75 29 DE(I-1)=JL(I) CAL 76 GO TO 31 CAL 77 30 DE(I+6)=JL(I) CAL 78 31 CONTINUE CAL 79 L=K+29 CAL 80 DO 34 I=K,L CAL 81 NO(I+4)=AP(I) CAL 82 JN(I+5)=AP(I) CAL 83 IF(AP(7)-7)32,33,33 CAL 84 32 SE(I-1)=AP(I) CAL 85 GO TO 34 CAL 86 33 SE(I+6)=AP(I) CAL 87 34 CONTINUE CAL 88 WRITE(6,44)IY CAL 89 WRITE(6,41) CAL 90 WRITE(6,39) CAL 91 DO 35 I=1,36,7 CAL 92 L=I+6 CAL 93 35 WRITE(6,40)(JA(NA),NA=I,L),(AP(NB),NB=I,L),(JL(NC),NC=I,L),(OC(ND)CAL 94 *,ND=I,L) CAL 95 WRITE(6,42) CAL 96 WRITE(6,39) CAL 97 DO 36 I=1,36,7 CAL 98 L=I+6 CAL 99 36 WRITE(6,40)(FE(NA),NA=I,L),(MY(NB),NB=I,L),(AU(NC),NC=I,L),(NO(ND)CAL 100 *,ND=I,L) CAL 101 WRITE(6,43) CAL 102 WRITE(6,39) CAL 103 DO 37 I=1,36,7 CAL 104 L=I+6 CAL 105 37 WRITE(6,40)(MA(NA),NA=I,L),(JN(NB),NB=I,L),(SE(NC),NC=I,L),(DE(ND)CAL 106 *,ND=I,L) CAL 107 WRITE(6,38) CAL 108 GO TO 1 CAL 109 38 FORMAT('1') CAL 110 39 FORMAT(12X,4('S M T W T F S',7X)) CAL 111 40 FORMAT(10X,4(7I3,5X)) CAL 112 41 FORMAT(//17X,'JANUARY',20X,'APRIL',21X,'JULY',21X,'OCTOBER'/) CAL 113 42 FORMAT(//16X,'FEBRUARY',21X,'MAY',21X,'AUGUST',19X,'NOVEMBER'/) CAL 114 43 FORMAT(//18X,'MARCH',21X,'JUNE',20X,'SEPTEMBER',17X,'DECEMBER'/) CAL 115 44 FORMAT(//,20X,'CALENDAR',/20X,'FOR THE YEAR'/20X,I4//) CAL 116 45 STOP CAL 117 END CAL 118 1973 1974 /* WRITE OUT A CALENDAR ARRAY */ (SUBRG,STRG): CLNDR: PROCEDURE OPTIONS (MAIN); DECLARE (CLN,CAL)(0:2,42) FIXED BIN; DECLARE MSG(2) CHAR(4) INIT ('LEAP','NORM'); DECLARE DAY(7) CHAR(3) INIT ('SUN','MON','TUE','WED', 'THU','FRI','SAT'); DECLARE HEAD (14) CHARACTER (9) INITIAL (' DECEMBER', ' JANUARY ',' FEBRUARY',' MARCH ',' APRIL ', ' MAY ',' JUNE ',' JULY ',' AUGUST ', 'SEPTEMBER',' OCTOBER ',' NOVEMBER',' DECEMBER', ' JANUARY '); DECLARE #DAYS (0:13) /* # DAYS / MONTH */ FIXED BIN INIT (31,31,29,31,30,31,30,31,31,30,31,30,31,31); DECLARE CNTRL (14,10) FIXED BIN INIT (8,4,5,3,5,13,2,5,18,0, /*DEC*/ 7,10,1,14,21,1,18,25,0,0, /*JAN*/ 8,6,5,2,18,21,1,18,25,0, /*FEB*/ 5,13,1,18,3,8,0,0,0,0, /*MAR*/ 5,1,16,18,9,12,0,0,0,0, /*APR*/ 3,13,1,25,0,0,0,0,0,0, /*MAY*/ 4,10,21,14,5,0,0,0,0,0, /*JUN*/ 4,10,21,12,25,0,0,0,0,0, /*JUL*/ 6,1,21,7,21,19,20,0,0,0, /*AUG*/ 9,19,5,16,20,5,13,2,5,18, /*SEP*/ 7,15,3,20,15,2,5,18,0,0, /*OCT*/ 8,14,15,22,5,13,2,5,18,0, /*NOV*/ 8,4,5,3,5,13,2,5,18,0, /*DEC*/ 7,10,1,14,21,1,18,25,0,0 /*JAN*/ ); DECLARE DAY1 (0:13) /*STARTING WEEKDAY*/ FIXED BIN INIT (5,1,4,5,1,3,6,1,4,7,2,5,7,3); DECLARE LAST_DIGIT(7) FIXED BIN; DECLARE LEAD_DIGIT(7) FIXED BIN; DECLARE DIGIT(0:10,6) CHAR(5) INIT( ' 000 ','0 0','0 0','0 0','0 0',' 000 ', ' 11 ','1 1 ',' 1 ',' 1 ',' 1 ','11111', ' 222 ','2 2',' 2 ',' 2 ',' 2 ','22222', '3333 ',' 3',' 33 ',' 3','3 3',' 333 ', ' 4 ',' 44 ',' 4 4 ','44444',' 4 ',' 4 ', '55555','5 ','5555 ',' 5',' 5','5555 ', ' 666 ','6 ','6 ','6666 ','6 6',' 666 ', '77777',' 7 ',' 7 ',' 7 ',' 7 ',' 7 ', ' 888 ','8 8',' 888 ','8 8','8 8',' 888 ', ' 999 ','9 9','9 9',' 9999',' 9',' 999 ', ' ',' ',' ',' ',' ',' '); DECLARE ALPH (26,7) CHARACTER (7) INITIAL ( ' AAA ',' A A ','A A','AAAAAAA','A A','A A','A A', 'BBBBBB ','B B','B B','BBBBBB ','B B','B B','BBBBBB ', ' CCCCC ','C C','C ','C ','C ','C C',' CCCCC ', 'DDDDD ','D D ','D D','D D','D D','D D ','DDDDD ', 'EEEEEEE','E ','E ','EEEE ','E ','E ','EEEEEEE', 'FFFFFFF','F ','F ','FFFF ','F ','F ','F ', ' GGGGG ','G G','G ','G ','G GGG','G G',' GGGGG ', 'H H','H H','H H','HHHHHHH','H H','H H','H H', ' IIIII ',' I ',' I ',' I ',' I ',' I ',' IIIII ', ' J',' J',' J',' J','J J','J J',' JJJJJ ', 'K K','K K ','K K ','KKKK ','K K ','K K ','K K', 'L ','L ','L ','L ','L ','L ','LLLLLLL', 'M M','MM MM','M M M M','M M M','M M','M M','M M', 'N N','NN N','N N N','N N N','N N N','N NN','N N', 'OOOOOOO','O O','O O','O O','O O','O O','OOOOOOO', 'PPPPPP ','P P','P P','PPPPPP ','P ','P ','P ', 'QQQQQQQ','Q Q','Q Q','Q Q','Q Q Q','Q Q Q','QQQQQQQ', 'RRRRRR ','R R','R R','RRRRRR ','R R ','R R ','R R', ' SSSSSS','S ','S ',' SSSSS ',' S',' S','SSSSSS ', 'TTTTTTT',' T ',' T ',' T ',' T ',' T ',' T ', 'U U','U U','U U','U U','U U','U U',' UUUUU ', 'V V','V V','V V','V V',' V V ',' V V ',' V ', 'W W','W W','W W','W W W','W W W W','WW WW','W W', 'X X',' X X ',' X X ',' X ',' X X ',' X X ','X X', 'Y Y',' Y Y ',' Y Y ',' Y ',' Y ',' Y ',' Y ', 'ZZZZZZZ',' Z ',' Z ',' Z ',' Z ',' Z ','ZZZZZZZ'); DECLARE (DA#, DAYS, STRT, IC(10)) FIXED BINARY; DECLARE IF_RET LABEL; DECLARE TOP CHAR(21) INITIAL(' S M T W T F S'); OPEN FILE(SYSPRINT) PAGESIZE(62); /* PRINT THE ALPHABETIC CHARACTERS */ IL03: DO I = 1 TO 7; PUT EDIT((ALPH(J,I) DO J = 1 TO 13)) (SKIP,13 (X(3),A(7))); END IL03; PUT SKIP(2); IL04: DO I = 1 TO 7; PUT EDIT((ALPH(J,I) DO J = 14 TO 26)) (SKIP,13 (X(3),A(7))); END IL04; PUT SKIP(2); DO I=1 TO 6; PUT EDIT((DIGIT(J,I) DO J=0 TO 9)) (SKIP,10 (X(3),A(5))); END; /* READ IN THE YEAR, DETERMINE WHETHER OR NOT IT IS A LEAP YEAR, AND COMPUTE THE DAY OF THE WEEK ON WHICH JAN.1 FALLS */ ON ENDFILE(SYSIN) GO TO TERM; RDIN: GET EDIT (ICENT,IYEAR,IMUD) (2 F(2),X(74),F(2)); JYEAR = (ICENT * 100) + IYEAR; IYR = 1972; IBG = 7; /* IS IT A LEAP YEAR? */ IF (MOD(IYEAR,4)=0) THEN IF (IYEAR\=0) THEN IL = 1; /* LEAP YEAR, NOT 00 */ ELSE IF (MOD (ICENT,4)=0) THEN IL=1; /* LEAP, 00 */ ELSE IL=2; /*NORMAL, 00 */ ELSE IL = 2; /* NOT LEAP YEAR */ /* USING THE FACTS THAT JAN.1,1972 FALLS ON A SATURDAY; THAT FOR A LEAP YEAR, THE FIRST DAY OF THE NEXT YEAR FALLS TWO DAYS LATER; AND FOR A NORMAL YEAR, IT FALLS ONE DAY LATER, COMPUTE THE DAY OF THE WEEK ON WHICH JAN.1 FALLS IN THE YEAR UNDER CONSIDERATION. LET SUNDAY BE THE 1ST DAY OF THE WEEK, ETC. IS THE YEAR BEFORE OR AFTER 1972? */ IF (JYEAR > 1972) THEN IF_RET=ADD_IYR; ELSE IF (JYEAR < 1972) THEN DO; IF_RET=SUB_IYR; GO TO SUB; END; ELSE GO TO RTN; /* JYEAR = 1972 */ CALC_NEW: ICT =IYR / 100; /* ORIG. YEAR=LEAP? */ JYR = IYR - (ICT * 100); IF (MOD(JYR,4)=0) THEN IF (JYR\=0) THEN JL=2; ELSE IF (MOD(ICT,4)=0) THEN JL=2; ELSE JL=1; ELSE JL=1; GO TO IF_RET; /* ADD ONE UNTIL THE DESIRED YEAR IS REACHED */ ADD_IYR: IYR = IYR + 1; IBG = MOD (IBG+JL,7); IF (IYR < JYEAR) THEN GO TO CALC_NEW; /* YEAR NOT REACHED */ ELSE GO TO RTN; /* YEAR REACHED */ /* SUBTRACT ONE UNTIL THE DESIRED YEAR IS REACHED */ SUB: IYR = IYR - 1; GO TO CALC_NEW; SUB_IYR: IBG = MOD (IBG-JL,7); IF (IYR > JYEAR) THEN GO TO SUB; /* YEAR NOT REACHED YET */ /* PRINT OUT THE CHARACTERISTICS OF THE YEAR */ RTN: IF (IBG = 0) THEN IBG = 7; PUT PAGE; PUT EDIT (JYEAR,'STARTS ON A',DAY(IBG),MSG(IL)) (SKIP(2),F(5),X(5),A,X(2),A,X(5),A); /* FILL IN THE ARRAYS FOR THE YEAR */ DA#=0; /* PRINT THE ENTIRE YEAR */ MOLUP: DO I = 0 TO 13; M = 0; DAYS = #DAYS(I); /* THE # OF DAYS IN THE MONTH */ IF I=2 & IL=2 THEN DAYS=28; /* FEB OF A NORMAL YEAR */ IX=(IL-1)*7+IBG; IR=(8+I)/11; IR=IR*(IX-1)/7; /* THE WEEKDAY STARTING THE MONTH */ STRT=MOD(DAY1(I)+IX-2-IR,7)+1; K=MOD(I,3); IL05: DO J = 1 TO 42; IF ((J=STRT+DAYS)) THEN CAL(K,J),CLN(K,J)=0; ELSE DO; M = M + 1; CAL(K,J) = M; IF I\=0&I\=13 THEN DA#=DA#+1; CLN(K,J) = DA#; END; END IL05; IF I<2 THEN GO TO FIN_MO; PUT EDIT (HEAD(I-1), (JYEAR DO MM = 1 TO 16 BY 1), HEAD(I+1)) (PAGE,X(5),A(10),X(10),16 F(5),X(10),A(10)); IC = CNTRL(I,*); IR = IC(1); NINE_IR=9*IR; PUT EDIT (TOP,(ALPH(IC(L),1) DO L = 2 TO IR+1), TOP) (SKIP, A,X((87-NINE_IR)/2),(IR) (X(2),A(7)), X((90-NINE_IR)/2),A); KLUP: DO K = 1 TO 6; LK = ((K-1)*7) +1; PUT EDIT ((CAL(MOD(I-2,3),L) DO L = LK TO LK+6), (ALPH(IC(L),K+1) DO L = 2 TO IR+1), (CAL(MOD(I ,3),L) DO L = LK TO LK+6)) (SKIP,7 P'ZZZ',X((87-NINE_IR)/2),(IR) (X(2),A(7)), X((90-NINE_IR)/2),7 P'ZZZ'); END KLUP; /* START PRINTING THE BODY */ PUT SKIP(2); PUT SKIP LIST((3)' '^^(128)'-'); PUT EDIT('^', ' SSSS ^ M M ^ TTTTT ^ W W ^ TTTTT ^ FFFFF ^ SSSS','^','^', ' S ^ MM MM ^ T ^ W W ^ T ^ F ^ S','^','^', ' SSS ^ M M M ^ T ^ W W ^ T ^ FFFF ^ SSS','^','^', ' S ^ M M ^ T ^ W W W ^ T ^ F ^ S','^','^', ' SSSS ^ M M ^ T ^ W W ^ T ^ F ^ SSSS','^') ( 5 ( SKIP, X(3),A,A,COL(131),A) ); LUPK: DO K = 1 TO 6; LK = ((K-1)*7) +1; IF K>1 THEN IF CAL(MOD(I-1,3),LK)=0 THEN GO TO END_MO; DO L=LK TO LK+6; IF CAL(MOD(I-1,3),L)=0 THEN JL,IR=10; ELSE DO; LL=CAL(MOD(I-1,3),L); JL=LL/10; IR=LL-JL*10; IF JL=0 THEN DO; JL=10; IF IR=0 THEN IR=10; END; END; LEAD_DIGIT(L-LK+1)=JL; LAST_DIGIT(L-LK+1)=IR; END; PUT EDIT((128)'-','^',(CLN(MOD(I-1,3),L),DIGIT(LEAD_DIGIT( L-LK+1),1), DIGIT(LAST_DIGIT(L-LK+1),1),'^' DO L=LK TO LK+6)) (SKIP,X(3),A,SKIP,X(3), A,X(2),7 (P'ZZZ',X(1),A,X(1),A,X(1),A,X(1))); PUT EDIT((('^',DIGIT(LEAD_DIGIT(L-LK+1),LL),DIGIT(LAST_DIGIT (L-LK+1),LL) DO L=LK TO LK+6),'^' DO LL=2 TO 6)) ( 4 (SKIP,X(3),A,X(1), 7(X(5),A,X(1),A,X(1),A))); END LUPK; END_MO: PUT SKIP LIST((3)' '^^(128)'-'); FIN_MO: END MOLUP; GO TO RDIN; TERM: PUT EDIT ('NORMAL PROGRAM TERMINATION')(PAGE,A); END CLNDR; 1973 0 1 1984 1974 SIMULATION OF A HARMONIGRAPH TITLE 'HARM -- SIMULATION OF A HARMONIGRAPH' PRINT NOGEN BEGIN CSECT=HARM,BASEREG=13 * * GR1 HAS ADDR OF PARMS * LR GR2,GR1 PUT ADDR OF PARMS IN GR2 * * SET UP THE SCALE FACTORS TO SIMULATE 1024 RASTER * CALL OFFSET,(E0,E256,E0,E256) * * GET ADDR OF FIRST TWO PARMS * LM GR3,GR4,0(GR2) * * COMPUTE -A1*.01 AND -A2*.01 * LE FR0,0(GR3) GET A1 LCER FR0,FR0 -A1 ME FR0,E01 *.01 STE FR0,A101 SAVE IT LE FR0,0(GR4) GET A2 LCER FR0,FR0 -A2 ME FR0,E01 *.01 STE FR0,A201 SAVE IT * * GET ADDR OF REST OF PARMS * LM GR3,GR12,8(GR2) * * COMPUTE INTIAL X AND Y * LE FR0,0(GR5) GET C1 ME FR0,E100 *100. AE FR0,E511 +511. LE FR2,0(GR6) GET C2 ME FR2,E100 *100. AER FR0,FR2 511.+C1*100.+C2*100. STE FR0,X PUT IT IN X LE FR0,0(GR9) GET E1 ME FR0,E100 *100. AE FR0,E511 +511. LE FR2,0(GR10) GET E2 ME FR2,E100 *100. AER FR0,FR2 511.+100.*E1+100.*E2 STE FR0,Y SAVE IT * CALL PLOT,(X,Y,F13) * * * MAINLOOP FOR SIMULATION AND DRAWING THE CURVE * * FR4 HAS THE CURRENT VALUE OF T * GR2 HAS DO LOOP COUNT * LA GR2,4000 DO IT 4000 TIMES MAINLOOP LE FR4,T GET T AE FR4,E05 INCR T BY .05 STE FR4,T SAVE IT LER FR0,FR4 PUT T IN FR0 ME FR0,A101 T*A101 STE FR0,R1 SAVE IT CALL EXP,(R1) ME FR0,E100 *100. STE FR0,R1 SAVE IT LER FR0,FR4 PUT A COPY OF T IN FR0 ME FR0,A201 *A201 STE FR0,R2 SAVE IT FOR CALL ONLY CALL EXP,(R2) ME FR0,E100 *100. STE FR0,R2 SAVE IT LE FR0,0(GR11) GET F1 MER FR0,FR4 *T STE FR0,F1T SAVE IT LE FR0,0(GR12) GET F2 MER FR0,FR4 *T STE FR0,F2T SAVE IT CALL SIN,(F1T) ME FR0,R1 *R1 STE FR0,S1 SAVE CALL SIN,(F2T) ME FR0,R2 *R2 STE FR0,S2 SAVE IT CALL COS,(F1T) ME FR0,R1 *R1 STE FR0,T1 SAVE IT CALL COS,(F2T) ME FR0,R2 *R2 STE FR0,T2 SAVE IT * * COMPUTE X * ME FR0,0(GR6) T2*C2 LE FR2,T1 GET T1 ME FR2,0(GR5) T1*C1 AER FR0,FR2 LE FR2,S2 ME FR2,0(GR4) B2*S2 AER FR0,FR2 LE FR2,S1 ME FR2,0(GR3) B1*S1 AER FR0,FR2 AE FR0,E511 +511. STE FR0,X SAVE IT * * COMPUTE Y * LE FR0,T2 ME FR0,0(GR10) T2*E2 LE FR2,T1 ME FR2,0(GR9) T1*E1 AER FR0,FR2 LE FR2,S2 ME FR2,0(GR8) S2*D2 AER FR0,FR2 LE FR2,S1 ME FR2,0(GR7) S1*D1 AER FR0,FR2 AE FR0,E511 +511. STE FR0,Y SAVE IT * NOW PLOT CALL PLOT,(X,Y,F12) USE THE FACTOR AND OFFSET * TRY AGAIN BCT GR2,MAINLOOP DO THIS LOOP 4000 TIMES LEAVE E100 DC E'100.' E511 DC E'511.' X DS E Y DS E F13 DC F'13' F12 DC F'12' E0 DC E'0.' E256 DC E'256.' E01 DC E'.01' E05 DC E'.05' A101 DS E A201 DS E T DC E'0.' R1 DS E R2 DS E F1T DS E F2T DS E S1 DS E S2 DS E T1 DS E T2 DS E * EQUATES FR0 EQU 0 FR2 EQU 2 FR4 EQU 4 GR1 EQU 1 GR2 EQU 2 GR3 EQU 3 GR4 EQU 4 GR5 EQU 5 GR6 EQU 6 GR7 EQU 7 GR8 EQU 8 GR9 EQU 9 GR10 EQU 10 GR11 EQU 11 GR12 EQU 12 GR13 EQU 13 END CALL PLOT(2.,2.,-3) CALL HARM(.4,1.,1.4,-1.5,1.4,1.5,-1.4,1.5,1.4,1.5,2.,3.) CALL PLOT(5.,0.,-3) STOP END DRAW:PROC OPTIONS(MAIN); DCL DRAW1 ENTRY(FLOAT BIN,FLOAT BIN,FLOAT BIN,FLOAT BIN,FLOAT BIN, FLOAT BIN), PI FLOAT BIN INIT(3.14159265358979); CALL DRAW1(0.,.5,.5,9.,99,.1); CALL DRAW1(0.,12.,4.,3.,3.,.1); 1DRAW1:PROC(THETA,XORG,YORG,LX,LY,DELTA); DCL LINE1Z ENTRY((*) FLOAT,(*) FLOAT,FIXED BIN(31),FIXED BIN(31), (2)FLOAT,(2) FLOAT), PLOT ENTRY(FLOAT,FLOAT,FIXED BIN(31)), (XORG,YORG,LX,LY,DELTA) FLOAT BIN, (DX,DY,TX(2),TY(2),X34,Y34,X4,Y4,X(1000),Y(1000),CX,CY,SIN,COS, THETA,R,D) FLOAT BIN INIT(0.); 0 CALL PLOT(XORG,YORG,-3); TX(1),TY(1)=0.; TX(2),TY(2)=1.; COS=SQRT(1./(1.+TAN(THETA)**2)); SIN=SQRT(1.-COS*COS); DX,DY=DELTA; IF LX<=LY THEN DY=DY*LY/LX; ELSE DX=DX*LX/LY; X(1),Y(1),X(5),Y(5)=0.; X(2)=-LY*SIN; Y(2)=LY*COS; X(3)=X(2)+LX*COS; Y(3)=Y(2)+LX*SIN; Y(4)=Y(3)-LY*COS; X(4)=X(3)+LY*SIN; CX=X(3)/2. ; CY=Y(3)/2. ; ON ERROR SNAP PUT DATA(I,X(I),Y(I),COS,SIN,DX,DY,CX,CY,D,R,X4,Y4, X34,Y34); DO I=6 TO 1000; R=I-2*(I/2); X4=X(I-4); Y4=Y(I-4); X34=X(I-3)-X4; 03 6 216676363613425 Y34=Y(I-3)-Y4; D=(DX*(R+1.)+DY*R)/SQRT(X34*X34+Y34*Y34); X(I)=X4+D*X34; Y(I)=Y4+D*Y34; IF ( ABS(CX-X(I))