C.. SNOOPY.FTN MOD BY BOHDEN K. CMAYLO NOV 81 C.. C.. COPY OF SNOOPY ON FCCC MODIFIED FOR PDP + IMPROVED C.. C PROGRAM SNOOPY 00001 C ****************************************************************** 00002 C * * 00003 C * PRINTS CALENDAR, ONE MONTH PER PAGE WITH PICTURES OPTIONAL. * 00004 C * * 00005 C * BEGINNING MONTH AND YEAR, ENDING MONTH AND YEAR MUST BE PRO- * 00006 C * VIDED IN 4(I6) FORMAT ON A CARD IMMEDIATELY FOLLOWING * 00007 C * CARD 98 OF DECK. * 00008 C * * 00009 C * IF GRID LINES ARE DESIRED, A 1 MUST APPEAR IN COLUMN 30 OF * 00010 C * ABOVE CARD. A BLANK OR ZERO WILL SUPPRESS GRID LINES. * 00011 C * * 00012 C * ALL PICTURE DATA DECKS MUST BE TERMINATED WITH CODE -2. * 00013 C * CONSECUTIVE -2*S WILL RESULT IN NO PICTURE BEING PRINTED * 00014 C * FOR THAT MONTH. * 00015 C * * 00016 C * PICTURE FORMAT CODES -- * 00017 C * -1 END OF LINE * 00018 C * -2 END OF PICTURE * 00019 C * -3 LIST CARDS, ONE PER LINE, FORMAT 13A6 * 00020 C * -4 LIST CARDS, TWO PER LINE, FORMAT 11A6/11A6 * 00021 C * -5 LIST CARDS, TWO PER LINE, FORMAT 12A6/10A6 * 00022 C * * 00023 C ****************************************************************** 00024 DOUBLE PRECISION AMONTH (12,7,13), ANAM(22), ANUM(2,10,5), 00025 1 CAL(60,22) DIMENSION NODS(12) 00026 COMMON ISET 00027 C.. PDP 11 ADDITIONS BY BOHDEN INCR=2 CALL ASSIGN(INCR,'SX:[5,10]SNOOPY.DAT ') TYPE 33 33 FORMAT('0*** CALENDAR PROGRAM ***'//'$OUTPUT FILE NAME = ') ACCEPT 22,NODS 22 FORMAT(12A2) IOUT=3 CALL ASSIGN(IOUT,NODS) TYPE 11 11 FORMAT(/' ENTER FIRST-MONTH, YEAR, LAST-MONTH, YEAR, 0/1=GRID?'/ 1 '$MM,YYYY,MM,YYYY,G : ') ACCEPT 4,MF,IYR,MTHLST,IYRLST,LNSW IEOF=0 C.. END OF PDP 11 ADDITIONS READ (INCR,1) (((AMONTH(I,J,K),K=1,13),J=1,7),I=1,12) 00028 READ (INCR,2) (ANAM(I),I=1,22) 00029 READ (INCR,3) (((ANUM(I,J,K),J=1,10),K=1,5),I=1,2) 00030 READ (INCR,4) (NODS(I),I=1,12) 00031 READ (INCR,1) BLANK,ONE,ALIN1,ALIN2,ALIN3,ALIN4 00032 C-OLD-READ (5,4) MF,IYR,MTHLST,IYRLST,LNSW 00033 ISET=25 00034 DO 10 I=1,60 00035 DO 10 J=1,22 00036 10 CAL(I,J)= BLANK 00037 CAL(1,1)= ONE 00038 DO 20 J=1,22 00039 20 CAL(11,J)=ANAM(J) 00040 IF (LNSW) 122,142,122 00041 122 DO 125 I=12,60,8 00042 DO 125 J=1,22 00043 125 CAL(I,J)=ALIN2 00044 DO 140 J=4,19,3 00045 I=13 00046 127 DO 130 L=1,7 00047 CAL(I,J)=ALIN1 00048 130 I=I+1 00049 IF (I-55) 135,135,140 00050 135 CAL(I,J)=ALIN3 00051 I=I+1 00052 GO TO 127 00053 140 CONTINUE 00054 DO 141 I=12,60,8 00055 141 CAL(I,1)=ALIN4 00056 142 IDOW=(IYR-1751)+(IYR-1753)/4-(IYR-1701)/100+(IYR-1601)/400 00057 IDOW=IDOW-7*((IDOW-1)/7) 00058 55 IF (IYR-IYRLST) 60,65,100 00059 60 ML=12 00060 GO TO 70 00061 65 ML=MTHLST 00062 70 IY1=IYR/1000 00063 NUMB=IYR-1000*IY1 00064 IY2=NUMB/100 00065 NUMB=NUMB-100*IY2 00066 IY3=NUMB/10 00067 NUMB=NUMB-10*IY3 00068 IY4=NUMB 00069 DO 72 J=1,5 00070 CAL(J+3,1)=ANUM(2,IY1+1,J) 00071 CAL(J+1,2)=ANUM(2,IY2+1,J) 00072 CAL(J+1,21)=ANUM(2,IY3+1,J) 00073 72 CAL(J+3,22)=ANUM(2,IY4+1,J) 00074 LPYRSW=0 00075 IF (IYR-4*(IYR/4)) 90,75,90 00076 75 IF (IYR-100*(IYR/100)) 85,80,85 00077 80 IF (IYR-400*(IYR/400)) 90,85,90 00078 85 LPYRSW=1 00079 90 NODS(2)=NODS(2)+LPYRSW 00080 IF (MF-1) 100,110,95 00081 95 MF=MF-1 00082 DO 105 MONTH=1,MF 00083 105 IDOW=IDOW+NODS(MONTH) 00084 IDOW=IDOW-7*((IDOW-1)/7) 00085 MF=MF+1 00086 110 DO 51 MONTH=MF,ML 00087 LSTDAY=NODS(MONTH) 00088 DO 115 I=1,7 00089 DO 115 JM=1,13 00090 J=JM+4 00091 115 CAL(I,J)=AMONTH(MONTH,I,JM) 00092 IF (IDOW-1) 160,160,120 00093 120 ID=IDOW-1 00094 J=2 00095 DO 155 K=1,ID 00096 DO 150 I=14,18 00097 CAL (I,J)= BLANK 00098 150 CAL(I,J+1)= BLANK 00099 J=J+3 00100 155 CONTINUE 00101 160 IDAY=1 00102 II=14 00103 25 J=3*IDOW-1 00104 N=IDAY/10+1 00105 I=II 00106 DO 30 K=1,5 00107 CAL(I,J)=ANUM(1,N,K) 00108 30 I=I+1 00109 N=IDAY-10*N+11 00110 J=J+1 00111 I=II 00112 DO 35 K=1,5 00113 CAL(I,J)=ANUM(2,N,K) 00114 35 I=I+1 00115 IDOW=IDOW+1 00116 IF (IDOW-7) 45,45,40 00117 40 IDOW=1 00118 II=II+8 00119 45 IDAY=IDAY+1 00120 IF (IDAY-LSTDAY) 25,25,50 00121 50 ID=IDOW 00122 205 I=II 00123 J=3*ID-1 00124 DO 210 K=1,5 00125 CAL(I,J)= BLANK 00126 CAL(I,J+1)= BLANK 00127 210 I=I+1 00128 IF (ID-7) 215,220,220 00129 215 ID=ID+1 00130 GO TO 205 00131 220 IF (II-54) 225,230,230 00132 225 II=54 00133 ID=1 00134 GO TO 205 00135 C.. PDP-11 MODIFICATIONS 230 CALL PICTUR(INCR,IOUT,IEOF) IF(IEOF.LE.0) GO TO 444 REWIND INCR READ (INCR,1) (((AMONTH(I,J,K),K=1,13),J=1,7),I=1,12) 00028 READ (INCR,2) (ANAM(I),I=1,22) 00029 READ (INCR,3) (((ANUM(I,J,K),J=1,10),K=1,5),I=1,2) 00030 READ (INCR,4) (NODS(I),I=1,12) 00031 READ (INCR,1) BLANK,ONE,ALIN1,ALIN2,ALIN3,ALIN4 00032 ISET=25 GO TO 230 444 CONTINUE CAL(1,1)='1' C.. END OF MODIFICATIONS WRITE (IOUT,5) ((CAL(I,J),J=1,22),I=1,60) 51 CONTINUE 00138 IF (IYR-IYRLST) 235,100,100 00139 235 NODS(2)=NODS(2)-LPYRSW 00140 IYR=IYR+1 00141 MF=1 00142 GO TO 55 00143 100 CONTINUE 00144 STOP 00145 1 FORMAT (13A6) 00146 2 FORMAT (11A6) 00147 3 FORMAT (10A6) 00148 4 FORMAT (12I6) 00149 5 FORMAT (22A6) 00150 END 00151 SUBROUTINE PICTUR(INCR,IOUT,IEOF) INTEGER ALIN,AMPSAN,CRD2 DIMENSION KRD1(25),CRD2(25),ALIN(132) 00153 COMMON I 00154 DATA PLUS/1H-/,AMPSAN/1H*/ 11 N=0 00156 10 I=I+1 00157 IF (I-25) 14,14,13 00158 13 I=1 00159 IEOF=0 READ (INCR,1,END=99) (KRD1(K),CRD2(K),K=1,25) 14 M=N+1 00161 IF (KRD1(I)) 15,10,16 00162 15 IF (KRD1(I)+2) 18,35,17 00163 18 IF (KRD1(I)+4) 55,44,33 00164 17 N=132 00165 GO TO 20 00166 16 N=N+KRD1(I) 00167 20 DO 21 J=M,N 00168 21 ALIN (J)=CRD2(I) 00169 IF (N-132) 10,31,31 00170 31 IF (ALIN(1).EQ.AMPSAN) ALIN(1)=PLUS 00171 WRITE (IOUT,2) (ALIN(J),J=1,132) 00172 C31 WRITE OUTPUT TAPE 1,2, (ALIN(J),J=1,132) 00173 GO TO 11 00174 33 READ (INCR,5,END=99) (ALIN(J),J=1,13),ICHK WRITE (IOUT,7) (ALIN(J),J=1,13) 00176 IF (ICHK+2) 77,35,33 00177 44 READ (INCR,3,END=99) (ALIN(J),J=1,22),ICHK WRITE (IOUT,4) (ALIN(J),J=1,22) 00179 IF (ICHK+2) 77,35,44 00180 55 READ (INCR,6,END=99) (ALIN(J),J=1,22),ICHK WRITE (IOUT,4) (ALIN(J),J=1,22) 00182 IF (ICHK+2) 77,35,55 00183 77 I=25 00184 GO TO 11 00185 35 RETURN 00186 C.. PDP-11 MODS 99 IEOF=1 RETURN C.. END OF MODS 1 FORMAT (25(I2,A1)) 00187 2 FORMAT (132A1) 00188 3 FORMAT (11A6/11A6,I2) 00189 4 FORMAT (22A6) 00190 5 FORMAT (13A6,I2) 00191 6 FORMAT (12A6/10A6,I2) 00192 7 FORMAT (30X,13A6) 00193 END 00194