//********************************************************************  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
