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