program dayowk c This program will find the day of week for any date in the c 20th century. First the program will ask the user to input a c date consisting of a year(Y), month(M), and day(D), and then c it will calculate the day of week by the following formula : c c DOW = K - ( K / 7 * 7 ) + 1 where c c K = D + 2M + (3M+3)/5 + Y + Y/4 + Y/100 + 1 c c In this formula the months January and February must be c considered as the 13 and 14 months of the preceeding year. c c The date can be input in one of two forms : c All numbers (ex : 07/16/84) or c Two numbers and one string (ex: July 16, 1984) c In both cases any character other than letters or numbers are c considered to be separators in the input string. c If the month is given with letters then at least 3 letters are c needed to provide a unique month (ie. MA could be decoded as c MARCH or MAY) c c Author : Richard A. Crawford c P. O. Box 1056 CBN 27 c E-Systems Inc. c Greenville, Texas 75401 c (214) 457-6018 c c Date : 16 July 1984 c c It is written in DEC Fortran 77 Version 5.0 and runs on a PDP-11/44 c running RSX-11M-PLUS. To build enter the following commands : c c >F77 DAYOWK,DAYOWK=DAYOWK c >TKB DAYOWK=DAYOWK c Character Varaibles : c DATE - the string that holds the users input date. c SUBSTR - substrings of DATE. character*20 DATE, SUBSTR(3) c Integer Variables : c D - number of the day c M - number of the month c Y - number of the year c DOW - number of the day of week : c 1 = Monday, 2 = Tuesday, ... c NUMCHR - Number of characters in each substring. integer D, M, Y, DOW, NUMCHR(3) c Logical Variables : c ERROR - error flag. c END - specifies that the user is finished and that c the program should exit. c LETTER- specifies whether the corresponding SUBSTR c contains letters or not. logical*1 ERROR, END, LETTER(3) c c suppress the fortran end-of-file message : c call errset(24,.true.,.false.,.true.,.false.,15) c c output some general information to the user : c write(5,1000) 100 continue c c initialize the flags and variables: c ERROR = .false. END = .false. LETTER(1) = .false. LETTER(2) = .false. LETTER(3) = .false. DATE = ' ' SUBSTR(1) = ' ' SUBSTR(2) = ' ' SUBSTR(3) = ' ' c c Get the date from the user : c call INDAT(DATE,ERROR,END) c c Break up the date given into three substrings : c call PARSE(DATE,SUBSTR,LETTER,NUMCHR,ERROR,END) c c Convert the strings DAY, MONTH, and YEAR into the c proper integer values D, M, and Y : c call CONVRT(SUBSTR,LETTER,NUMCHR,D,M,Y,ERROR,END) c c Calculate the day of week : c call CALC(D,M,Y,DOW,ERROR,END) c c Output the day of week along with the users input c date (in a standard form) : c call OUTDAT(D,M,Y,DOW,ERROR,END) if (.not.END) goto 100 write(5,1010) c c Format Statements : c 1000 format(1x,/,1x,'Program DAYOWK',/, 1 1x,'This program will take an input date and give the',/, 1 1x,'corresponding day of the week. There is some flexability',/, 1 1x,'in the input formats but the standard input forms are :',/, 1 1x,' DD-MM-YY (ex : 7-16-84)',/, 1 1x,' DD MMMM YY (ex : 07 Jul 84)',/, 1 1x,' MMM DD YY (ex : July 7, 1984)',/, 1 1x,'If you use letters to specify the month, you must use',/, 1 1x,'at least 3 letters.') 1010 format(1x,/,1x,'DAYOWK -- EXITING') end subroutine INDAT(DATE,ERROR,END) c c Get the input date from the user. c character*20 DATE logical*1 ERROR, END c c Ask the user for the input date : c write(5,1000) read(5,1010,end=500)DATE return c If the user inputs a ^Z then set END to c true to tell the program to exit : c 500 END = .true. return c c Format Statements : c 1000 format(1x,/,1x,$'Please enter the date (^Z to exit) : ') 1010 format(a20) end subroutine PARSE(DATE,SUBSTR,LETTER,NUMCHR,ERROR,END) c This subroutine will take the string DATE and break it down c into three substrings. the user can input the date in two ways: c as a sequence of numbers ( ex : 7/16/84 ) or as a sequence of c numbers and letters ( ex : July 16, 1984 ). in either case this c subroutine will divide DATE into three substrings. If the user c inputs too few or too many sbustrings ( ex : 7/6 or 7/6/7/84) or if c they input too many letter strings ( ex : July One 1984) then c an appropriate error message is given and the ERROR flag is set. c Character Varaibles : c DATE - the string that holds the users input date. c SUBSTR - substrings of DATE. character*20 DATE, SUBSTR(3) c Integer Variables : c I - SUBSTR array counter c K - SUBSCRIPTS array counter c J - DATE subscript counter c NUMCHR - Number of characters in each substring. integer I, J, K, NUMCHR(3) c Logical Variables : c ERROR - error flag. c END - specifies that the user is finished and that c the program should exit. c LETTER- specifies whether the corresponding SUBSTR c contains letters or not. c CHECK - flag to see if we need to check any more characters. c Set false after an error condition. c ANYLET - flag to see if any substring has letters logical*1 ERROR, END, ANYLET, CHECK, LETTER(3) c TEMPB and TEMPC are used to convert a letter to lower case : byte TEMPB character*1 TEMPC equivalence (TEMPB, TEMPC) if ( .not.END .and. .not. ERROR ) then c c initialize some flags and variables : c I = 0 J = 1 CHECK = .true. ANYLET = .false. LETTER(1) = .false. LETTER(2) = .false. LETTER(3) = .false. 90 if ( J .le. 20 ) then MOVEON = .false. if (CHECK) then c Look for a letter : if ((DATE(J:J).ge.'a'.and.DATE(J:J).le.'z'). 1 or.(DATE(J:J).ge.'A'.and.DATE(J:J).le.'Z')) then I = I + 1 c c if we have already found 3 substrings then c this is an error condition : c if (I .gt. 3) then write(5,1000) CHECK = .false. ERROR = .true. c c if we have already found a substring with c letters in it then this is an error condition : c else if (ANYLET) then write(5,1010) CHECK = .false. ERROR = .true. c c Save the letter into the substring c and start looking for more letters : c else LETTER(I) = .true. ANYLET = .true. K = 1 SUBSTR(I)(K:K) = DATE(J:J) c Convert the letter to uppercase : if (SUBSTR(I)(K:K).gt.'Z')then ITEMP = ICHAR(SUBSTR(I)(K:K)) ITEMP = ITEMP - '40'O TEMPB = ITEMP SUBSTR(I)(K:K) = TEMPC end if 100 continue J = J + 1 c c if we find a letter, save it : c if ((DATE(J:J).ge.'a'.and.DATE(J:J) 1 .le.'z').or.(DATE(J:J).ge.'A'.and. 1 DATE(J:J).le.'Z')) then K = K + 1 SUBSTR(I)(K:K) = DATE(J:J) c c convert the letter to lower case : c if (SUBSTR(I)(K:K).gt.'Z')then ITEMP = ICHAR(SUBSTR(I)(K:K)) ITEMP = ITEMP - '40'O TEMPB = ITEMP SUBSTR(I)(K:K) = TEMPC end if c c Start looking for the next c substring : c else MOVEON = .true. end if if ( .not.MOVEON) goto 100 NUMCHR(I) = K if ( NUMCHR(I) .lt. 3 ) then write(5,1030) ERROR = .true. end if end if c c Now look for a number : c else if (DATE(J:J).ge.'0'.and. 1 DATE(J:J).le.'9') then I = I + 1 c c if we have already found 3 substrings then c this is an error condition : c if (I .gt. 3) then write(5,1000) CHECK = .false. ERROR = .true. c c otherwise, save the number into the substring c and start looking for more numbers : c else K = 1 SUBSTR(I)(K:K) = DATE(J:J) c repeat 110 continue J = J + 1 c if we find a number, save it : if (DATE(J:J).ge.'0'.and. 1 DATE(J:J).le.'9') then K = K + 1 SUBSTR(I)(K:K) = DATE(J:J) c c otherwise, start looking for the next c substring : c else MOVEON = .true. end if if (.not.MOVEON) goto 110 NUMCHR(I) = K end if c c If the character is neither a letter or a number c just continue onto the next character : c else J = J + 1 end if else goto 200 end if goto 90 end if c c if we did't find enough substrings, let the user know c and set the ERROR condition : c if (I .lt. 3) then write(5,1020) ERROR = .true. end if end if 200 return c c Format Statements : c 1000 format(1x,'Error - Too many strings') 1010 format(1x,'Error - Letters acceptable in only one substring') 1020 format(1x,'Error - Too few strings') 1030 format(1x,'At least 3 letters are needed in to specify a month') 1040 format(i1.1) end subroutine CONVRT(SUBSTR,LETTER,NUMCHR,D,M,Y,ERROR,END) c This subroutine will take the substrings provided by PARSE and c convert the strings into numbers. Here we also have two cases : c c CASE 1 : The month is provided in letters. Here we compare the c letters to determine the month, and then assign that c month a number (Jan = 1, Feb = 2, etc...). Next we c look at the other two strings and determine the day c and year. To do this we look and see if one of them is c greater than the number of days in the given month, if c one is, then that one is the year and the other one is c the day. If neither is clearly the year then the one c that fell to the left of the other in the original c input string is considered to be the day. For example, c if the user input 13 July 10, then neither is obviously c the year, so we assume the leftmost one is the day c (ie. day = 13). c Case 2 : In this case the user has expressed the date in three c numbers. Search for an obvious year and date. If none c are found then use the following "standard" format : c MM-DD-YY (ex : 7-16-84). c Character Varaibles : c SUBSTR - substrings of DATE. character*20 SUBSTR(3) c Integer Variables : c D - number of the day c M - number of the month c Y - number of the year c NUMCHR - Number of characters in each substring. c MONPOS - Number of the substring that holds c the month string. c LEFT - Integer variable used in processing Case 1. c It is the position of the leftmost number. c RIGHT- Integer variable used in processing Case 1. c It is the position of the rightmost number. c NUMLFT - Variable used in processing Case 1. c It is the value of the leftmost number. c NUMRHT- Variable used in processing Case 1. c It is the value of the rightmost number. c NUMDAY - Array of the number of days in each month. c NUMDIM - number of days in a specified month. integer D,M,Y, LEFT, RIGHT, NUMLFT, NUMRHT integer NUMCHR(3), NUMDAY(12), NUMDIM, NUMBER(3) c Logical Variables : c ERROR - error flag. c END - specifies that the user is finished and that c the program should exit. c LETTER- specifies whether the corresponding SUBSTR c contains letters or not. c CASE1 - flag that is set true when the date is specified c with letters in a substring. logical*1 ERROR, END, LETTER(3), CASE1 c begin c c initialize the day, month, and year : c D = 0 M = 0 Y = 0 c c initialize the array that contains the number of days in each month : c NUMDAY( 1) = 31 NUMDAY( 2) = 29 NUMDAY( 3) = 31 NUMDAY( 4) = 30 NUMDAY( 5) = 31 NUMDAY( 6) = 30 NUMDAY( 7) = 31 NUMDAY( 8) = 31 NUMDAY( 9) = 30 NUMDAY(10) = 31 NUMDAY(11) = 30 NUMDAY(12) = 31 CASE1 = .false. if ( .not. ERROR .and. .not. END ) then c c see if we have Case 1 or not : c if (LETTER(1)) then CASE1 = .true. MONPOS = 1 LEFT = 2 RIGHT = 3 else if (LETTER(2)) then CASE1 = .true. MONPOS = 2 LEFT = 1 RIGHT = 3 else if (LETTER(3)) then CASE1 = .true. MONPOS = 3 LEFT = 1 RIGHT = 2 end if c c if we have Case 1 then start processing : c if (CASE1) then c c convert the string containing the letters into c the number of a month : c call DECODE(SUBSTR(MONPOS), 1 NUMCHR(MONPOS),M,ERROR) c c determine the day and year numbers : c call TRANSL(SUBSTR(LEFT),NUMCHR(LEFT), 1 NUMLFT,ERROR) calL TRANSL(SUBSTR(RIGHT),NUMCHR(RIGHT), 1 NUMRHT,ERROR) if (.not.ERROR ) then c c see if one is obviously the year : c if ( NUMLFT .gt. NUMDAY(M) ) then Y = NUMLFT D = NUMRHT else if (NUMRHT .gt. NUMDAY(M) ) then Y = NUMRHT D = NUMLFT c c if neither is clearly the year then let c NUMLFT be the day and NUMRHT be c the year : c else D = NUMLFT Y = NUMRHT end if end if c c else handle Case 2 now : c else c c convert the three strings into numbers : c call TRANSL(SUBSTR(1),NUMCHR(1),NUMBER(1),ERROR) call TRANSL(SUBSTR(2),NUMCHR(2),NUMBER(2),ERROR) call TRANSL(SUBSTR(3),NUMCHR(3),NUMBER(3),ERROR) if ( .not.ERROR ) then c c see if NUMBER(1) is obviously the year : c if ( NUMBER(1) .gt. 31 ) then Y = NUMBER(1) NUMLFT = NUMBER(2) NUMRHT = NUMBER(3) c c see if NUMBER(2) is obviously the year : c else if ( NUMBER(2) .gt. 31 ) then Y = NUMBER(2) NUMLFT = NUMBER(1) NUMRHT = NUMBER(3) c c see if NUMBER(3) is obviously the year : c else if ( NUMBER(3) .gt. 31 ) then Y = NUMBER(3) NUMLFT = NUMBER(1) NUMRHT = NUMBER(2) end if c c if one was the year then find the day and c month : c if ( Y .gt. 0 ) then c c see if one is obviously the day : c if ( NUMLFT .gt. 12) then D = NUMLFT M = NUMRHT else if (NUMRHT .gt. 12) then D = NUMRHT M = NUMLFT else M = NUMLFT D = NUMRHT end if c c since we wern't able to determine the year c assume that they used a standard input of c MM-DD-YY : c else M = NUMBER(1) D = NUMBER(2) Y = NUMBER(3) end if end if end if if ( .not.ERROR ) then c c Now check the numbers : c if ( M .lt. 1 .or. M .gt. 12 ) then write(5,1000)M ERROR = .true. else NUMDIM = NUMDAY(M) end if if (.not.ERROR .and. (D.lt.1 .or. D.gt.NUMDIM)) then ERROR = .true. write(5,1010)D end if c c Take care of the case where the user inputs c the year as two digits (ex : 84) : c if ( Y .lt. 100 ) then Y = Y + 1900 end if if (.not.ERROR .and. (Y.lt.1901 .or. Y.gt.2000)) then ERROR = .true. write(5,1020)Y end if end if end if return c c Format Statements : c 1000 format(1x,'Month number ',i3,' is outside of valid range') 1010 format(1x,'Day number ',i3,' is outside of valid range') 1020 format(1x,'Year number ',i4.4,' is outside of valid range') end subroutine DECODE(STRING,NUMCHR,M,ERROR) c c convert the string containing letters into c the number of a month : c c Character Varaibles : c STRING - Character array to be decoded. c MONTHS - Character array containing the months character*20 STRING character*9 MONTHS(12) c Integer Variables : c M - number of the month c NUMCHR - Number of characters in STRING c NUMLM - Number of letters in each months name. integer M, NUMCHR, NUMLM(12) c Logical Variables : c ERROR - error flag. c FOUND - Flag showing if a match has been found or not. c EQUAL - Flag showing that string are matching. logical*1 ERROR, FOUND, EQUAL c begin if ( .not.ERROR ) then c c initialize MONTHS and NUMLM : c MONTHS( 1) = 'JANUARY ' MONTHS( 2) = 'FEBRUARY ' MONTHS( 3) = 'MARCH ' MONTHS( 4) = 'APRIL ' MONTHS( 5) = 'MAY ' MONTHS( 6) = 'JUNE ' MONTHS( 7) = 'JULY ' MONTHS( 8) = 'AUGUST ' MONTHS( 9) = 'SEPTEMBER' MONTHS(10) = 'OCTOBER ' MONTHS(11) = 'NOVEMBER ' MONTHS(12) = 'DECEMBER ' NUMLM( 1) = 7 NUMLM( 2) = 8 NUMLM( 3) = 5 NUMLM( 4) = 5 NUMLM( 5) = 3 NUMLM( 6) = 4 NUMLM( 7) = 4 NUMLM( 8) = 6 NUMLM( 9) = 9 NUMLM(10) = 7 NUMLM(11) = 8 NUMLM(12) = 8 FOUND = .false. do 110 NUMM = 1 , 12 c c Initialize EQUAL : c EQUAL = .true. do 100 I = 1 , NUMCHR c c if a letter doesn't match then set c EQUAL to false : c if (STRING(I:I).ne. 1 MONTHS(NUMM)(I:I)) then EQUAL = .false. end if 100 continue c c If EQUAL is true then all characters matched c so save the month number : c if (EQUAL .eq. .true.) then FOUND = .true. M = NUMM end if 110 continue if ( .not.FOUND ) then write(5,1000) ERROR = .true. end if end if return c c Format Statements : c 1000 format(1x,'Error - Could Not Match Month String') end subroutine TRANSL(STRING,NUMCHR,NUMBER,ERROR) c c determine the day and year numbers from a given string. c c Character Varaibles : c STRING - Character array to be decoded. character*20 STRING c Integer Variables : c NUMCHR - Number of characters in STRING c NUMBER - Value of decoded string. integer NUMBER, NUMCHR, TEMP c Logical Variables : c ERROR - error flag. logical*1 ERROR c begin if ( .not.ERROR ) then NUMBER = 0 POWER = 0 do 100 I = NUMCHR , 1 , -1 DECODE(1,1000,STRING(I:I))TEMP NUMBER = NUMBER + (TEMP * (10**POWER)) POWER = POWER + 1 100 continue end if return c c Format Statements : c 1000 format(i1.1) end subroutine CALC(D,M,Y,DOW,ERROR,END) c c Calculate the day of week : c c Integer Variables : c D - number of the day c M - number of the month c Y - number of the year c DOW - number of the day of week : c 1 = Monday, 2 = Tuesday, ... c NUMCHR - Number of characters in each substring. integer D, M, Y, DOW c Logical Variables : c ERROR - error flag. c END - specifies that the user is finished and that c the program should exit. logical*1 ERROR, END c begin if ( .not.ERROR .and. .not.END ) then c c Take care of the case where the month is January c or February : c if ( M .eq. 1 .or. M .eq. 2 ) then M = M + 12 Y = Y - 1 end if K = D + 2*M + (3*M+3)/5 + Y + Y/4 + Y/100 + 1 DOW = K - ( K / 7 * 7 ) + 1 c c In the case where the month is January c or February reset the month counter back : c if ( M .eq. 13 .or. M .eq. 14 ) then M = M - 12 Y = Y + 1 end if end if return end subroutine OUTDAT(D,M,Y,DOW,ERROR,END) c c Output the day of week along with the users input c date (in a standard form) : c c Character Variables : c MONTH - Character array of month names c DAY - Character array of Day names character*9 MONTH(12), DAY(7) c Integer Variables : c D - number of the day c M - number of the month c Y - number of the year c DOW - number of the day of week : c 1 = Monday, 2 = Tuesday, ... c NUMLET - The number of letters in each months name. integer D, M, Y, DOW integer NUMLET(12) c Logical Variables : c ERROR - error flag. c END - specifies that the user is finished and that c the program should exit. logical*1 ERROR, END data numlet/ 7, 8, 5, 5, 3, 4, 4, 6, 9, 7, 8, 8 / c begin if ( .not. ERROR .and. .not. END ) then c c initialize MONTH and DAY : c MONTH( 1) = 'January ' MONTH( 2) = 'February ' MONTH( 3) = 'March ' MONTH( 4) = 'April ' MONTH( 5) = 'May ' MONTH( 6) = 'June ' MONTH( 7) = 'July ' MONTH( 8) = 'August ' MONTH( 9) = 'September' MONTH(10) = 'October ' MONTH(11) = 'November ' MONTH(12) = 'December ' DAY(1) = 'Monday ' DAY(2) = 'Tuesday ' DAY(3) = 'Wednesday' DAY(4) = 'Thursday ' DAY(5) = 'Friday ' DAY(6) = 'Saturday ' DAY(7) = 'Sunday ' write(5,1000)MONTH(M),D,Y,DAY(DOW) end if return c c Format Statements : c 1000 format(1x,'The date : ',a,1x,i2,', ' 1 ,i4.4,' was a ',a9) end