SUBROUTINE MAIN
      LOGICAL*1 BUF(400), DAT(10)
      INTEGER CUPPER, LENGTH
      CALL GDATE(DAT)
      CALL FOLD(DAT)
      CALL WKDAY( DAT, BUF)
      DAT(4) = CUPPER(DAT(4))
      I = LENGTH(BUF)
      BUF(I+1) = 32
      I = I + 2
      CALL STCOPY( DAT, 1, BUF, I)
      BUF(I) = 32
      CALL GTIME (BUF(I+1))
      I = LENGTH(BUF)
      BUF(I+1) = 10
      BUF(I+2) = 0
      CALL PUTLIN(BUF, 2)
      RETURN
      END
      SUBROUTINE WKDAY( DATSTR, DAYNAM)
      INTEGER DYOFMN
      INTEGER DYOFWK
      INTEGER YEAR
      INTEGER C, I, K
      INTEGER MONNUM
      INTEGER CTOI, MOD, OLDMON
      LOGICAL*1 DAYNAM(4)
      LOGICAL*1 DATSTR(100)
      LOGICAL*1 DAYSTR(3), MONSTR(4), YRSTR(3)
      LOGICAL*1 SUNDAY(7)
      LOGICAL*1 MONDAY(7)
      LOGICAL*1 TUESDA(8)
      LOGICAL*1 WEDNES(10)
      LOGICAL*1 THURSD(9)
      LOGICAL*1 FRIDAY(7)
      LOGICAL*1 SATURD(9)
      DATA SUNDAY(1)/83/,SUNDAY(2)/117/,SUNDAY(3)/110/,SUNDAY(4)/100/,SU
     *NDAY(5)/97/,SUNDAY(6)/121/,SUNDAY(7)/0/
      DATA MONDAY(1)/77/,MONDAY(2)/111/,MONDAY(3)/110/,MONDAY(4)/100/,MO
     *NDAY(5)/97/,MONDAY(6)/121/,MONDAY(7)/0/
      DATA TUESDA(1)/84/,TUESDA(2)/117/,TUESDA(3)/101/,TUESDA(4)/115/,TU
     *ESDA(5)/100/,TUESDA(6)/97/,TUESDA(7)/121/,TUESDA(8)/0/
      DATA WEDNES(1)/87/,WEDNES(2)/101/,WEDNES(3)/100/,WEDNES(4)/110/,WE
     *DNES(5)/101/,WEDNES(6)/115/,WEDNES(7)/100/,WEDNES(8)/97/,WEDNES(9)
     */121/,WEDNES(10)/0/
      DATA THURSD(1)/84/,THURSD(2)/104/,THURSD(3)/117/,THURSD(4)/114/,TH
     *URSD(5)/115/,THURSD(6)/100/,THURSD(7)/97/,THURSD(8)/121/,THURSD(9)
     */0/
      DATA FRIDAY(1)/70/,FRIDAY(2)/114/,FRIDAY(3)/105/,FRIDAY(4)/100/,FR
     *IDAY(5)/97/,FRIDAY(6)/121/,FRIDAY(7)/0/
      DATA SATURD(1)/83/,SATURD(2)/97/,SATURD(3)/116/,SATURD(4)/117/,SAT
     *URD(5)/114/,SATURD(6)/100/,SATURD(7)/97/,SATURD(8)/121/,SATURD(9)/
     *0/
      CALL MVSUBS( DATSTR, 1, 2, DAYSTR)
      CALL MVSUBS( DATSTR, 4, 3, MONSTR)
      CALL MVSUBS( DATSTR, 8, 2, YRSTR)
      I = 1
      DYOFMN = CTOI( DAYSTR, I)
      I = 1
      YEAR = CTOI( YRSTR, I)
      IF(.NOT.( YEAR .EQ. 0 ))GOTO 23000
      YEAR = 100
      C = 18
      GOTO 23001
23000 CONTINUE
      C = 19
23001 CONTINUE
      K = C/4 - 2*C
      CALL FOLD(MONSTR)
      MONNUM = OLDMON(MONSTR)
      IF(.NOT.( MONNUM .GT. 10 ))GOTO 23002
      YEAR = YEAR - 1
23002 CONTINUE
      DYOFWK = MOD(DYOFMN + (26*MONNUM-2)/10 + YEAR + YEAR/4 + K, 7) + 1
      IF(.NOT.( DYOFWK .LE. 0 ))GOTO 23004
      DYOFWK = DYOFWK + 7
23004 CONTINUE
      I23006=(DYOFWK)
      GOTO 23006
23008 CONTINUE
      CALL SCOPY(SUNDAY, 1, DAYNAM, 1)
      GOTO 23007
23009 CONTINUE
      CALL SCOPY(MONDAY, 1, DAYNAM, 1)
      GOTO 23007
23010 CONTINUE
      CALL SCOPY(TUESDA, 1, DAYNAM, 1)
      GOTO 23007
23011 CONTINUE
      CALL SCOPY(WEDNES, 1, DAYNAM, 1)
      GOTO 23007
23012 CONTINUE
      CALL SCOPY(THURSD, 1, DAYNAM, 1)
      GOTO 23007
23013 CONTINUE
      CALL SCOPY(FRIDAY, 1, DAYNAM, 1)
      GOTO 23007
23014 CONTINUE
      CALL SCOPY(SATURD, 1, DAYNAM, 1)
      GOTO 23007
23015 CONTINUE
      DAYNAM(1) = 0
      GOTO 23007
23006 CONTINUE
      IF(I23006.LT.1.OR.I23006.GT.7)GOTO 23015
      GOTO(23008,23009,23010,23011,23012,23013,23014),I23006
23007 CONTINUE
      RETURN
      END
      INTEGER FUNCTION MOVCHS( SRC, DST, N)
      LOGICAL*1 DST(100), SRC(100)
      INTEGER I, N
      I = 1 
23016 IF(.NOT.(I .LE. N .AND. SRC(I) .NE. 0 ))GOTO 23018
      DST(I) = SRC(I)
23017 I = I + 1 
      GOTO 23016
23018 CONTINUE
      DST(I) = 0
      MOVCHS = I
      RETURN
      END
      INTEGER FUNCTION MVSUBS( IN, I, N, OUT)
      INTEGER I, J, K, N
      LOGICAL*1 IN(100), OUT(100)
      K = I
      J = 1 
23019 IF(.NOT.(IN(K) .NE. 0 .AND. J .LE. N ))GOTO 23021
      OUT(J) = IN(K)
      K = K + 1
23020 J = J + 1 
      GOTO 23019
23021 CONTINUE
      OUT(J) = 0
      MVSUBS = J - 1
      RETURN
      END
      INTEGER FUNCTION OLDMON( MONSTR )
      INTEGER TRIGRM
      INTEGER MONTH
      LOGICAL*1 MONSTR(4)
      LOGICAL*1 MONTHS(37)
      DATA MONTHS(1)/109/,MONTHS(2)/97/,MONTHS(3)/114/,MONTHS(4)/97/,MON
     *THS(5)/112/,MONTHS(6)/114/,MONTHS(7)/109/,MONTHS(8)/97/,MONTHS(9)/
     *121/,MONTHS(10)/106/,MONTHS(11)/117/,MONTHS(12)/110/,MONTHS(13)/10
     *6/,MONTHS(14)/117/,MONTHS(15)/108/,MONTHS(16)/97/,MONTHS(17)/117/,
     *MONTHS(18)/103/,MONTHS(19)/115/,MONTHS(20)/101/,MONTHS(21)/112/,MO
     *NTHS(22)/111/,MONTHS(23)/99/,MONTHS(24)/116/,MONTHS(25)/110/,MONTH
     *S(26)/111/,MONTHS(27)/118/,MONTHS(28)/100/,MONTHS(29)/101/,MONTHS(
     *30)/99/,MONTHS(31)/106/,MONTHS(32)/97/,MONTHS(33)/110/,MONTHS(34)/
     *102/,MONTHS(35)/101/,MONTHS(36)/98/,MONTHS(37)/0/
      MONTH = TRIGRM( MONSTR, MONTHS, 12)
      IF(.NOT.( MONTH .EQ. 0 ))GOTO 23022
      CALL PUTLIN( 20H? Bad month_string `, 3)
      CALL REMARK( MONSTR, 3)
23022 CONTINUE
      OLDMON = MONTH
      RETURN
      END
      INTEGER FUNCTION TRIGRM( TG, LIST, N)
      INTEGER I, J, JUNK, N
      INTEGER EQUAL
      LOGICAL*1 LIST(100), TG(100)
      JUNK = MOVCHS( LIST, STR, 3)
      J = 1
      I = 1 
23024 IF(.NOT.(EQUAL( TG, STR) .EQ. 0 ))GOTO 23026
      IF(.NOT.( I .LE. N ))GOTO 23027
      J = J + 3
      JUNK = MOVCHS( LIST(J), STR, 3)
      GOTO 23028
23027 CONTINUE
      GOTO 23026
23028 CONTINUE
23025 I = I + 1 
      GOTO 23024
23026 CONTINUE
      IF(.NOT.( I .GT. N ))GOTO 23029
      TRIGRM = 0
      GOTO 23030
23029 CONTINUE
      TRIGRM = I
23030 CONTINUE
      RETURN
      END