//********************************************************************
//*               P I C T U R E - C A L E N D A R    R U N           *
//*     INPUT:  ONE CARD WITH YEAR (FREE  FORMAT), PICTURE DECKS     *
//********************************************************************
/*FULLSKIPS
//CALENDAR EXEC FWCLG,PARM='NOEXT,NOSOURCE,NOCHECK,NOSUBCHK'
//SYSIN    DD   *
C*********************************************************************
C*                                                                   *
C*  CALENDAR PROGRAM:  THIS PROGRAM WILL PRODUCE A CALENDAR FOR A    *
C*                     YEAR FROM 1 THROUGH 9999.  TO USE IT, ONE MAY *
C*                     EITHER RUN THE PROGRAM WITH NO DATA IN WHICH  *
C*                     CASE A CALENDAR FOR THE PRESENT YEAR WILL BE  *
C*                     PRINTED, OR MAY INCLUDE YEAR NUMBERS ON DATA  *
C*                     CARDS (ONE YEAR PER CARD) TO GET CALENDARS    *
C*                     FOR SELECTED YEARS.                           *
C*                                                                   *
C*  PROGRAMMER:        DOUG COMER, CMPSC DEPT., PENN STATE U.        *
C*                                                                   *
C*  DATE:              FEBRUARY, 1974                                *
C*                                                                   *
C*  LANGUAGE:          PSU WATFIV, IBM 370/168 - OS/360 MVT/HASP     *
C*                                                                   *
C*********************************************************************
      INTEGER YEAR, NDAYS(12) /31,28,31,30,31,30,31,31,30,31,30,31/,
     1        DOFWEK
      LOGICAL CARDS/.FALSE./
      CHARACTER*168 P(2)
      CHARACTER*9   MONTHS(12)/' JANUARY ','FEBRUARY ','  MARCH  ',
     1                         '  APRIL  ','   MAY   ','  JUNE   ',
     2                         '  JULY   ',' AUGUST  ','SEPTEMBER',
     3                         ' OCTOBER ','NOVEMBER ','DECEMBER '/
      CHARACTER*8   MMDDYY
      CHARACTER*2   NUMS(31) /' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8',
     1                        ' 9','10','11','12','13','14','15','16',
     2                        '17','18','19','20','21','22','23','24',
     3                        '25','26','27','28','29','30','31'/,
     4              PRNT(42,4)
      CHARACTER LINE1*68,LINE2*64,COLUM1*1
      EQUIVALENCE   (PRNT,P)
C
C     IF NO DATA CARDS APPEAR, PRINT CALENDAR FOR CURRENT YEAR (DATE
C     SUBROUTINE)  OTHERWISE PRINT CALENDAR FOR YEAR READ IN.
C
      READ,     YEAR
  105 READ (5,111,END=95) COLUM1,LINE1,LINE2
  111 FORMAT(A1,1X,A68/2X,A64)
      IF(COLUM1.EQ.',') GO TO 4
      PRINT 112,LINE1,LINE2
  112 FORMAT('S',A68,A64)
      GO TO 105
C
C     BEGIN TO GENERATE CALENDAR FOR YEAR FOUND
C
    4 NDAYS(2) = 28
      IF (MOD(YEAR,4) .EQ. 0) NDAYS(2) = 29
      IF (YEAR .GT. 1753 .AND. MOD(YEAR,100) .EQ. 0
     1                   .AND. MOD(YEAR,400) .NE. 0) NDAYS(2) = 28
      MONTH = 1
      PRINT 5, YEAR
    5 FORMAT ('1 ',T54,'C A L E N D A R',/' ',T59,'F O R',/' ',T60,I4)
      IF (YEAR .GE. 1753) DOFWEK = MOD(YEAR + (YEAR-1)/4
     1                               -(YEAR-1)/100 + (YEAR-1)/400, 7)
      IF (YEAR .LT. 1753) DOFWEK = MOD(YEAR + (YEAR-1)/4 + 5, 7)
C
C     LOOP FOR THREE ROWS OF FOUR MONTHS PER ROW
C
      DO 12 IROW = 1, 3
           MNTHE = MONTH + 3
           PRINT 6, (MONTHS(M), M = MONTH,MNTHE)
    6      FORMAT('-',T5, 4(26('*'),4X),
     1           /' ',T5, 4('*',24X,'*',4X),
     2           /' ',T5, 4('*',8X,A9,7X,'*',4X),
     3           /' ',T5, 4('*',24X,'*',4X),
     4           /' ',T5, 4('*   S  M  T  W  T  F  S  *', 4X) )
           P(1) = ' '
           P(2) = ' '
           DO 8 J = 1, 4
                LIMIT = NDAYS(MONTH)
                DO 7 K = 1, LIMIT
                     DOFWEK = DOFWEK + 1
    7                PRNT(DOFWEK,J) = NUMS(K)
                DOFWEK = MOD( DOFWEK, 7 )
    8           MONTH = MONTH + 1
           DO 9 J = 1, 36, 7
                K = J + 6
    9           PRINT 10, ((PRNT(LINE,MNTH),LINE = J, K), MNTH = 1, 4)
   10           FORMAT(' ', T5, 4('* ',7A3,'  *',4X) )
           PRINT 11
   11      FORMAT (' ',T5, 4( 26('*'),4X ) )
   12      CONTINUE
      PRINT 201
  201 FORMAT('1')
      GO TO 105
   95 STOP
      END
//INPUT    DD   *
..
.