//******************************************************************** CALENDA1 //* C A L E N D A R R U N * CALENDA2 //* VERS. 3.1 OF 5/22/74 INPUT: YEARS FREE FORM 1/CARD DLM='/*' * CALENDA3 //******************************************************************** CALENDA4 /*FULLSKIPS CALENDA5 //CALENDAR EXEC FWCLG,PARM='NOEXT,NOSOURCE,NOCHECK,NOSUBCHK' CALENDA6 //SYSIN DD * CALENDA7 C********************************************************************* CALENDA8 C* * CALENDA9 C* CALENDAR PROGRAM: THIS PROGRAM WILL PRODUCE A CALENDAR FOR A * CALEND10 C* YEAR FROM 1 THROUGH 9999. TO USE IT, ONE MAY * CALEND11 C* EITHER RUN THE PROGRAM WITH NO DATA IN WHICH * CALEND12 C* CASE A CALENDAR FOR THE PRESENT YEAR WILL BE * CALEND13 C* PRINTED, OR MAY INCLUDE YEAR NUMBERS ON DATA * CALEND14 C* CARDS (ONE YEAR PER CARD) TO GET CALENDARS * CALEND15 C* FOR SELECTED YEARS. * CALEND16 C* * CALEND17 C* PROGRAMMER: DOUG COMER, CMPSC DEPT., PENN STATE U. * CALEND18 C* * CALEND19 C* DATE: FEBRUARY, 1974 * CALEND20 C* * CALEND21 C* LANGUAGE: PSU WATFIV, IBM 370/168 - OS/360 MVT/HASP * CALEND22 C* * CALEND23 C********************************************************************* CALEND24 INTEGER YEAR, NDAYS(12) /31,28,31,30,31,30,31,31,30,31,30,31/, CALEND25 1 DOFWEK CALEND26 LOGICAL CARDS/.FALSE./ CALEND27 CHARACTER*168 P(2) CALEND28 CHARACTER*9 MONTHS(12)/' JANUARY ','FEBRUARY ',' MARCH ', CALEND29 1 ' APRIL ',' MAY ',' JUNE ', CALEND30 2 ' JULY ',' AUGUST ','SEPTEMBER', CALEND31 3 ' OCTOBER ','NOVEMBER ','DECEMBER '/ CALEND32 CHARACTER*8 MMDDYY CALEND33 CHARACTER*2 NUMS(31) /' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8', CALEND34 1 ' 9','10','11','12','13','14','15','16', CALEND35 2 '17','18','19','20','21','22','23','24', CALEND36 3 '25','26','27','28','29','30','31'/, CALEND37 4 PRNT(42,4) CALEND38 EQUIVALENCE (PRNT,P) CALEND39 C CALEND40 C IF NO DATA CARDS APPEAR, PRINT CALENDAR FOR CURRENT YEAR (DATE CALEND41 C SUBROUTINE) OTHERWISE PRINT CALENDAR FOR YEAR READ IN. CALEND42 C CALEND43 READ(5,*,END=1) YEAR CALEND44 IF (YEAR .LE. 0) GOTO 1 CALEND45 CARDS = .TRUE. CALEND46 GOTO 4 CALEND47 1 CALL DATE(MMDDYY) CALEND48 READ(MMDDYY,2) YEAR CALEND49 2 FORMAT(6X,I2) CALEND50 YEAR = YEAR + 1900 CALEND51 GOTO 4 CALEND52 3 READ(5,*,END=13) YEAR CALEND53 C CALEND54 C BEGIN TO GENERATE CALENDAR FOR YEAR FOUND CALEND55 C CALEND56 4 NDAYS(2) = 28 CALEND57 IF (MOD(YEAR,4) .EQ. 0) NDAYS(2) = 29 CALEND58 IF (YEAR .GT. 1753 .AND. MOD(YEAR,100) .EQ. 0 CALEND59 1 .AND. MOD(YEAR,400) .NE. 0) NDAYS(2) = 28 CALEND60 MONTH = 1 CALEND61 PRINT 5, YEAR CALEND62 5 FORMAT ('1 ',T54,'C A L E N D A R',/' ',T59,'F O R',/' ',T60,I4) CALEND63 IF (YEAR .GE. 1753) DOFWEK = MOD(YEAR + (YEAR-1)/4 CALEND64 1 -(YEAR-1)/100 + (YEAR-1)/400, 7) CALEND65 IF (YEAR .LT. 1753) DOFWEK = MOD(YEAR + (YEAR-1)/4 + 5, 7) CALEND66 C CALEND67 C LOOP FOR THREE ROWS OF FOUR MONTHS PER ROW CALEND68 C CALEND69 DO 12 IROW = 1, 3 CALEND70 MNTHE = MONTH + 3 CALEND71 PRINT 6, (MONTHS(M), M = MONTH,MNTHE) CALEND72 6 FORMAT('-',T5, 4(26('*'),4X), CALEND73 1 /' ',T5, 4('*',24X,'*',4X), CALEND74 2 /' ',T5, 4('*',8X,A9,7X,'*',4X), CALEND75 3 /' ',T5, 4('*',24X,'*',4X), CALEND76 4 /' ',T5, 4('* S M T W T F S *', 4X) ) CALEND77 P(1) = ' ' CALEND78 P(2) = ' ' CALEND79 DO 8 J = 1, 4 CALEND80 LIMIT = NDAYS(MONTH) CALEND81 DO 7 K = 1, LIMIT CALEND82 DOFWEK = DOFWEK + 1 CALEND83 7 PRNT(DOFWEK,J) = NUMS(K) CALEND84 DOFWEK = MOD( DOFWEK, 7 ) CALEND85 8 MONTH = MONTH + 1 CALEND86 DO 9 J = 1, 36, 7 CALEND87 K = J + 6 CALEND88 9 PRINT 10, ((PRNT(LINE,MNTH),LINE = J, K), MNTH = 1, 4) CALEND89 10 FORMAT(' ', T5, 4('* ',7A3,' *',4X) ) CALEND90 PRINT 11 CALEND91 11 FORMAT (' ',T5, 4( 26('*'),4X ) ) CALEND92 12 CONTINUE CALEND93 IF (CARDS) GOTO 3 CALEND94 13 STOP CALEND95 END CALEND96 //INPUT DD * CALEND97 .. .