C--  CALEND  -  PRINT CALENDAR YEAR OF YOUR CHOICE.
C
C     1972 MICHAEL HUCK
C
C	MODIFIED BY GEORGE GONZALEZ, JULY 1978
C----------------------------------------------------------------------

	INTEGER DAY(42, 14)
	INTEGER DAYSMONTH(14), NUMSEG(5, 10), DAYLIT(32)
	INTEGER YEAR, WEKDAY, UNIT
	REAL LINSEG(16), MONTH(2, 12)
	DATA DAYSMONTH/31,31,28,31,30,31,30,31,31,30,31,30,31,31/

	DATA NUMSEG/9,6,6,6,9,13,9,13,13,8,9,6,13,11,16,
     1 9,14,8,14,9,6,6,16,14,14,16,7,1,14,1,9,7,1,6,9,
     2 16,14,13,11,7,9,6,9,6,9,9,6,8,14,9/

	DATA LINSEG/
     1 4H$$$ , 4H$$ $, 4H$$  , 4H$ $$, 4H$ $ , 
     2 4H$  $, 4H$   , 4H $$$, 4H $$ , 4H $ $, 
     3 4H $  , 4H  $$, 4H  $ , 4H   $, 4H     , 4H$$$$ /

	DATA DAYLIT/' 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','32' /

	DATA MONTH / '  JAN','UARY ','  FEB','RUARY',' MARC','H    ',
     1 '   AP','RIL  ','    M','AY   ','  JUN','E    ',
     2 '    J','ULY  ','   AU','GUST ',' SEPT','EMBER',
     3 '  OCT','OBER ','  NOV','EMBER','  DEC','EMBER' /

	UNIT = 1		@ OUTPUT TO TTY

	WHILE ( .TRUE. )
	WRITE(1, 10)		@ ASK FOR YEAR
	READ(1, 20)YEAR
	IF(YEAR .LE. 0) STOP
C
C--  DETERMINE LEAP YEAR.
C
C    LEAP YEARS ARE YEARS DIVISIBLE BY 4 EXCEPT YEARS ENDING
C    IN 00 THAT CANNOT BE DIVISIBLE BY 400.
C
	IF(MOD(YEAR, 4) .EQ. 0 .AND.
     $ .NOT. ( MOD(YEAR, 100) .EQ. 0 .AND. MOD(YEAR, 400) .NE. 0)) THEN
	   DAYSMONTH(3) = 29
	ELSE
	   DAYSMONTH(3) = 28
	ENDIF
C
C--  ZELLER'S CONGRUENCE  [ IT = -MOD ... ]
C
C    F = (INT(2.6M-0.2) + K + D + D/4 + C/4-2C) MOD 7
C
C    K = DAY OF MONTH
C    C = NUMBER OF HUNDREDS IN THE YEAR
C    D = YEAR IN THE CENTURY
C    M = MONTH NUMBER (1, MARCH) (2, APRIL) ... (10, DECEMBER)
C	  (11, JANUARY) (12, FEBRUARY)
C    F = (0, SUN) (1, MON) (2, TUE) (3, WED) (4, THU) (5, FRI) (6, SAT)
C
C    EXAMPLE:  OCT 12, 1956.
C
C    K = 12, C = 19, D = 56, M = 8  THEN  F = 5 (FRIDAY).
C
	LASTYEAR = YEAR - 1
	I2 = LASTYEAR / 100
	I3 = MOD(LASTYEAR, 100)
	WEKDAY = -MOD(26 + I3/4 + I2/4 + I3-2 * I2, 7)
	IF(WEKDAY .EQ. 0) WEKDAY = WEKDAY - 7
C
C--  SET CALENDAR DATES IN ARRAY FROM DECEMBER OF THE YEAR
C    BEFORE TO JANUARY OF THE YEAR AFTER (TOTAL OF 14 MONTHS).
C
	DO ? J = 1, 14	@ FOR ALL MONTHS
	   ITI = -WEKDAY
	   JJ = DAYSMONTH(J)

	   DO ? J2 = 1, 42	@ FOR ALL DAYS
		WEKDAY = WEKDAY + 1
		IF(WEKDAY .GT. 0 .AND. WEKDAY .LE. JJ)
	            DAY(J2, J) = DAYLIT(WEKDAY)
	        ELSE
	            DAY(J2, J) = '  '
	        ENDIF
	   ENDDO 	@ FOR ALL DAYS

	   WEKDAY = -MOD(JJ + ITI, 7)
	ENDDO	@ FOR ALL MONTHS
C
C--  PRINT OUT BLOCK NUMBERS FOR YEAR HEADER.
C
	K1 = YEAR / 10
	K4 = MOD(YEAR, 10) + 1
	K3 = MOD(K1, 10) + 1
	K1 = K1 / 10
	K2 = MOD(K1, 10) + 1
	K1 = K1 / 10 + 1
	WRITE(UNIT, 30)

	DO ? N = 1, 5
	   N1 = NUMSEG(N, K1)
	   N2 = NUMSEG(N, K2)
	   N3 = NUMSEG(N, K3)
	   N4 = NUMSEG(N, K4)
	   WRITE(UNIT, 40)LINSEG(N1), LINSEG(N2), LINSEG(N3), LINSEG(N4)
	ENDDO

C
C--  PRINT 12 MONTHS OF REQUESTED YEAR.
C
	WRITE(UNIT, 50)

	DO ? J = 2, 13, 3
	   WRITE(UNIT, 60)
	   N1 = J - 1
	   N2 = J + 1
	   WRITE(UNIT, 70)MONTH(1, N1), MONTH(2, N1), MONTH(1, J), 
     $     MONTH(2, J), MONTH(1, N2), MONTH(2, N2)
	   DO ? L = 1, 42, 7
	      N1 = L + 6
	      WRITE(UNIT,80) (DAY(M,J),M = L,N1),(DAY(M,J + 1),M = L,N1),
     $       (DAY(M, J + 2), M = L, N1)
	   ENDDO
	ENDDO
C
C--  PRINT MONTH BEFORE AND AFTER YEAR.
C
	WRITE(UNIT, 60)
	N = YEAR + 1
	WRITE(UNIT, 90)MONTH(1, 12), MONTH(2, 12), LASTYEAR, 
     $  MONTH(1, 1), MONTH(2, 1), N
	DO ? L = 1, 42, 7
	   N1 = L + 6
	   WRITE(UNIT, 100)(DAY(M, 1), M = L, N1), (DAY(M, 14), M = L, N1)
	ENDDO
	WRITE(UNIT, 60)
	WRITE(UNIT, 50)
	ENDWHILE

10	FORMAT('INPUT YEAR')
20	FORMAT(I4)
30	FORMAT('1',////)
40	FORMAT(20X,4(3X,A4))
90	FORMAT(' #',6X,2A5,I5,8X,'#',8X,'#',6X,2A5,I5,8X,'#',/,
     1 ' #',2X,26('-'),' #',8X,'#',2X,26('-'),' #',/,
     2 ' #   S   M   T   W   T   F   S #',8X,'#',3X,
     3 'S   M   T   W   T   F   S #')
100	FORMAT(' #',7(2X,A2),' #',8X,'#',7(2X,A2),' #')
60	FORMAT(1X,70('#'))
70	FORMAT(1X,3('#',6X,2A5,6X),'#',/,1X,3('# ',20('-'),1X),'#',
     1 /,1X,3('#  S  M  T  W  T  F  S '),'#')
80	FORMAT(3(' #',7(1X,A2)),' #')
50	FORMAT(//)
	END