Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0142/wkday.for
There are 2 other files named wkday.for in the archive. Click here to see a list.
	PROGRAM WKDAY

	DIMENSION MO(12),NUMBER(12),MONTH(1)
	INTEGER DAY,YEAR,YE
	DOUBLE PRECISION NAME(7)
	DATA MO/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG',
	1'SEP','OCT','NOV','DEC'/
	DATA NUMBER/31,28,31,30,31,30,31,31,30,31,30,31/
	DATA NAME/'SUNDAY.','MONDAY.','TUESDAY.','WEDNESDAY.',
	1'THURSDAY.','FRIDAY.','SATURDAY.'/

	WRITE(5,12)

1	WRITE(5,13)
2	READ(5,14)MONTH
	IF(MONTH(1).EQ.'   ')GO TO 30
	WRITE(5,15)
	READ(5,16)DAY
	IF(DAY.LE.0.OR.DAY.GT.31)GO TO 9
	WRITE(5,17)
	READ(5,18)YEAR
	IF(YEAR.LT.1900.OR.YEAR.GT.1999)GO TO 10

	YE = YEAR
	YEAR = YEAR-1900
	IF(YEAR.LT.0.OR.YEAR.GE.100)GO TO 10
	N = 0
	DO 3 I = 1,12
	N = N+1
	IF(MONTH(1).EQ.MO(I))GO TO 4
3	CONTINUE
	GO TO 11

4	IF(DAY-NUMBER(N))6,6,5
5	IF(N.NE.2.AND.DAY.NE.29)GO TO 9
	IF(MOD(YEAR,4).NE.0)GO TO 9
6	IF(YEAR.EQ.0)GO TO 9
	K = (YEAR*365) + YEAR/4
	IF(N.LE.2)K = K - 1
7	DO 8 I = 1,N-1
	K = K + NUMBER(I)
8	CONTINUE
	K = K + DAY
	L = K- 7 * (K/7)
	WRITE(5,19)MO(N),DAY,YE,NAME(L+1)
	GO TO 1

9	WRITE(5,20)
	GO TO 1
10	WRITE(5,21)
	GO TO 1
11	WRITE(5,22)
	GO TO 2
30	STOP

12	FORMAT(' TO EXIT FROM PROGRAM RESPOND WITH A
	1 CARRIAGE RETURN'/' WHEN PROMPTED FOR THE NAME
	2 OF THE MONTH.',/)
13	FORMAT('0MONTH ? ',$)
14	FORMAT(A3)
15	FORMAT('   DAY ? ',$)
16	FORMAT(I2)
17	FORMAT('  YEAR ? ',$)
18	FORMAT(I4)
19	FORMAT(' THE DATE: ',A3,I3,',',I5,' OCCURS ON A ',A10)
20	FORMAT(' THAT IS AN IMPOSSIBLE DAY !')
21	FORMAT(' TWENTIETH CENTURY ONLY PLEASE.')
22	FORMAT(' TYPE FIRST 3 LETTERS OF THE MONTH: ',$)
23	END