-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X Write (PLACE (5:6), '(I2.2)') Y X If ((I .eq. DAY) .and. CURRENT) Then X If (J + I .lt. 100) Then X Write (PLACE (5:6), '(I2.2)') Y + 1 X Write (UNIT, 1003) ESC, INVRS (1), ESC, PLACE, J + I V, ESC, INVRS (2) X Else X Write (UNIT, 1004) ESC, INVRS (1), ESC, PLACE, J + I V, ESC, INVRS (2) X EndIf X Else X Write (UNIT, '(X, A1, A7, I3)') ESC, PLACE, J + I X EndIf X EndIf X EndDo X X Write (UNIT, '(X)') X If (MO .eq. 1) Write (UNIT, '(X)') X GoTo 1 X X666 Stop ' ' X X10 Format (' ', A1, A2, ' ', A36) X1000 Format (' ', A1, A07, A1, A02, ' ', I4, 11X, A3, 11X, ' ', I4) X1001 Format (' ', 1X, A1, A5, A1, A7, I2, A1, A3) X1002 Format (' ', A1, A5, A1, A7, I2, A1, A3) X1003 Format (' ', 1X, A1, A5, A1, A7, I2, A1, A3) X1004 Format (' ', A1, A5, A1, A7, I3, A1, A3) X1005 Format (' ', A1, A02) X1006 Format (' ', A1, A3) X END X X`0C X Options /Extend_Source XC*INDATE -- Prompts and reads date in many different forms XC+ X Subroutine INDATE (YEAR, DOY, DAY, MO, MONTH, END, CURRENT) X X Implicit None X Integer YEAR, DOY, DAY, MO X Character MONTH*3 X Logical*1 END, CURRENT X X************************************************************************* X* * X* A subroutine to collect a date in one of many different formats. * X* The different formats presently allowed are: * X* * X* MON YR --> 3-letter MONth,YeaR (A3, 1X, I2) * X* MON YEAR --> 3-letter MONth,YEAR (A3, 1X, I4) * X* YR MON --> YeaR,3-letter MONth (I2, 1X, A3) * X* YEAR MON --> YEAR,3-letter MONth (I4, 1X, A3) * X* DOY-YR --> 3-digit Day Of Year,YeaR (I3, 1X, I2) * X* DOY-YEAR --> 3-digit Day Of Year,YEAR (I3, 1X, I4) * X* DD-MON-YR --> Day of month,MONth,YeaR (I2, 1X, A3, 1X, I2) * X* DD-MON-YEAR --> Day of month,MONth,YEAR (I2, 1X, A3, 1X, I2) * X* ? --> list of allowed syntax * X* . --> current month * X* --> current month * X* --> Exit * X* anything else --> error * X* * X************************************************************************* XC-- end marker for DOCUMENT program X X Logical*1 GOOD, FIRST / .True. / X Integer YR, UNIT / 6 / X Character BUFFER*11 X X CURRENT = .False. X END = .False. X If (FIRST) Then X Call Lib$Get_Foreign (BUFFER, 'Enter date ==> ', ) X FIRST = .False. X GoTo 2 X EndIf X X1 Write (UNIT, 10) '$Enter date ==> ' X Read (UNIT, '(A11)', Err = 4, End = 666) BUFFER X Call Str$UpCase (BUFFER, BUFFER) X X2 If ((BUFFER (1:1) .eq. ' ') .or. (BUFFER (1:1) .eq. '.')) Then X CURRENT = .True. X Call Idate (MO, DAY, YR) X Call Date (BUFFER) X MONTH = BUFFER (4:6) X YEAR = 1900 + YR X Call MMDD2DDD (YR, MONTH, DAY, DOY, GOOD) X Else If (BUFFER (3:3) .eq. ' ') Then ! YR MON X Read (BUFFER, 2000, Err = 4) YR, MONTH X YEAR = 1900 + YR X DAY = 1 X Call MMDD2DDD (YR, MONTH, DAY, DOY, GOOD) X If (.not. GOOD) GoTo 4 X Else If (BUFFER (3:3) .eq. '-') Then ! DD-MON-YR X If (BUFFER (10:10) .eq. ' ') Then ! DD-MON-YEA VR X Read (BUFFER, 1000, Err = 4) DAY, MONTH, YR X YEAR = 1900 + YR X Else X Read (BUFFER, 1001, Err = 4) DAY, MONTH, YEAR X YR = Mod (YEAR, 100) X EndIf X Call MMDD2DDD (YR, MONTH, DAY, DOY, GOOD) X If (.not. GOOD) GoTo 4 X CURRENT = .True. X Else If (BUFFER (4:4) .eq. ' ') Then ! MON YR X If (BUFFER (7:7) .eq. ' ') Then ! MON YEAR X Read (BUFFER, 3000, Err = 4) MONTH, YR X YEAR = 1900 + YR X Else X Read (BUFFER, 3001, Err = 4) MONTH, YEAR X YR = Mod (YEAR, 100) X EndIf X DAY = 1 X Call MMDD2DDD (YR, MONTH, DAY, DOY, GOOD) X If (.not. GOOD) GoTo 4 X Else If (BUFFER (4:4) .eq. '-') Then ! DOY-YR X If (BUFFER (7:7) .eq. ' ') Then ! DOY-YEAR X Read (BUFFER, 4000, Err = 4) DOY, YR X YEAR = 1900 + YR X Else X Read (BUFFER, 4001, Err = 4) DOY, YEAR X YR = Mod (YEAR, 100) X EndIf X Call DDD2MMDD (YR, DOY, MONTH, DAY, GOOD) X If (.not. GOOD) GoTo 4 X CURRENT = .True. X Else If (BUFFER (5:5) .eq. ' ') Then ! YEAR MON X Read (BUFFER, 5000, Err = 4) YEAR, MONTH X DAY = 1 X YR = Mod (YEAR, 100) X Call MMDD2DDD (YR, MONTH, DAY, DOY, GOOD) X If (.not. GOOD) GoTo 4 X Else X GoTo 4 X EndIf X X If (YEAR .lt. 1900) Then X Write (UNIT, 10) ' Sorry, but I only work for years greater than V 1900!' X Write (UNIT, 10) ' Try Again...' X GoTo 1 X EndIF X X3 If (MONTH .eq. 'JAN') Then X MO = 1 X Else If (MONTH .eq. 'FEB') Then X MO = 2 X Else If (MONTH .eq. 'MAR') Then X MO = 3 X Else If (MONTH .eq. 'APR') Then X MO = 4 X Else If (MONTH .eq. 'MAY') Then X MO = 5 X Else If (MONTH .eq. 'JUN') Then X MO = 6 X Else If (MONTH .eq. 'JUL') Then X MO = 7 X Else If (MONTH .eq. 'AUG') Then X MO = 8 X Else If (MONTH .eq. 'SEP') Then X MO = 9 X Else If (MONTH .eq. 'OCT') Then X MO = 10 X Else If (MONTH .eq. 'NOV') Then X MO = 11 X Else If (MONTH .eq. 'DEC') Then X MO = 12 X EndIf X BUFFER = '***********' X Return X X666 END = .True. X Return X X4 Write (UNIT, 10) ' The currently allowed inputs are:' X Write (UNIT, 10) ' MON YR, YR MON, DD-MON-YR, DOY-YR,' X Write (UNIT, 10) ' or MON YEAR, YEAR MON, DD-MON-YEAR, DOY-YEAR' X Write (UNIT, 10) ' or . for the current month,' X Write (UNIT, 10) ' ? for Help,' X Write (UNIT, 10) ' to Exit,' X GoTo 1 X X10 Format (A) X1000 Format (I2, X, A3, X, I2) X1001 Format (I2, X, A3, X, I4) X2000 Format (I2, X, A3) X3000 Format (A3, X, I2) X3001 Format (A3, X, I4) X4000 Format (I3, X, I2) X4001 Format (I3, X, I4) X5000 Format (I4, X, A3) X End X`0C XC*DDD2MMDD -- Convert DOY to day of month XC+ X Subroutine DDD2MMDD (YEAR, DOY, MONTH, DAY, GOOD) X X Implicit None X Integer YEAR, DAY, DOY X Character*3 MONTH X Logical*1 GOOD X X************************************************************************* X* A subroutine to convert Day-Of-Year to day of the month and month. * X* This is a cute litte piece of code to do the conversion, * X* unfortunetly, I don't know how it actually works! I believe it's * X* results, but can't figure out it's algorithim. I think it makes * X* use of some "trick" math operations (truncation, rounding, etc.). * X* * X* input parameters * X* YEAR Integer*4 year * X* DOY Integer*4 day-of-year * X* output parameters * X* MONTH Character*3 mnemonic of month * X* DAY Integer*4 day-of-month * X* GOOD Logical*1 error flag * X* * X************************************************************************* XC-- end marker for DOCUMENT program X X Integer A, B, C, LEAP, YR X Logical*1 LEAP_YEAR X Character*3 MON_ABREV (12) X X Data MON_ABREV / 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', X & 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' / X X YR = Mod (YEAR, 100) X GOOD = .True. X If (Mod (YR, 4) .eq. 0) LEAP_YEAR = .True. X If (Mod (YEAR, 100) .eq. 0) LEAP_YEAR = .False. X If (Mod (YEAR, 400) .eq. 0) LEAP_YEAR = .True. X If (LEAP_YEAR) Then X If ((DOY .lt. 1) .or. (DOY .gt. 366)) GOOD = .False. X LEAP = 1523 X Else X If ((DOY .lt. 1) .or. (DOY .gt. 365)) GOOD = .False. X LEAP = 1889 X EndIf X If (GOOD) Then X A = Int ((Float (DOY) + Float (LEAP) - 122.1) / 365.25) X B = DOY + LEAP - Int ((Float (A) * 365.25)) X C = Int ((Float (B) / 30.6001)) X MONTH = MON_ABREV (Mod (C - 2, 12) + 1) X DAY = B - Int ((Float (C) * 30.6001)) X EndIf X X Return X End X`0C X Options /Extend_Source XC*MMDD2DDD -- Convert month to DOY XC+ X Subroutine MMDD2DDD (YEAR, MONTH, DAY, DOY, GOOD) X `20 X Implicit None X Integer DAY, DOY, YEAR X Character*3 MONTH X Logical*1 GOOD X X************************************************************************* X* A subroutine to convert month, day to day-of-year. * X* * X* input parameters * X* YEAR Integer*4 year mod 100 * X* MONTH Character*3 mnemonic of month * X* DAY Integer*4 day-of-month * X* output parameter * X* DOY Integer*4 day-of-year * X* GOOD Logical*1 error flag * X* * X************************************************************************* XC-- end marker for DOCUMENT program X X Byte DAYS_IN_MON (12) X Real*4 AM X Integer I, M, LEAP X Character*3 MON_ABREV (12), MON X X Data MON_ABREV / 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', X & 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' / X Data DAYS_IN_MON / 31, 28, 31, 30, 31, 30, X & 31, 31, 30, 31, 30, 31 / X X MON = MONTH X Call Str$Upcase (MON, MON) X GOOD = .True. X Do I = 1, 12 X M = I X If (MON .eq. MON_ABREV (M)) GoTo 1 X EndDo X GOOD = .False. X X1 If (DAY .gt. DAYS_IN_MON (M)) GOOD = .False. X If (Mod (YEAR, 4) .eq. 0) Then X I = 1 X Else X I = 2 X EndIf X AM = M X DOY = Int (275.0 * AM / 9.0) - I * Int ((AM + 9.0) / 12.0) + DAY - 3 V0 X X Return X End $ CALL UNPACK CALENDAR.FOR;1 806930897 $ create 'f' X1 CALENDAR X This program creates a monthly calendar for any month of the 20th X through the 23rd centuries with the day of the month and the day X of the year. If the current month (or any particular date) is X requested, the current day (or selected date) is highlighted. A X variety of standard date input formats are allowed. Output is X designed for DEC VTxxx terminals equipped with double width lines X and DEC special graphics. Any other terminal which accepts these X escape sequences should work. X X If the executable module is defined as a foreign command, the X input parameter can be specified on the command line. Define a X foreign command in your LOGIN.COM file, e.g., X `20 X DOY :== $ Disk$User:`5BJoe_User.Utilities`5DCALENDAR.EXE X `20 X DCL Execution format: X X DOY `5Bparameter`5D X X2 Parameter X These formats can be used on the DCL command line or for the X interactive prompt from the program CALENDAR. Note that any X leading zeros (0) are required. X X Time Formats Description Fortran Format X ------------ ------------------------ -------------------- X MON YR MONth, YeaR (A3, 1X, I2) X MON YEAR MONth, YEAR (A3, 1X, I4) X YR MON YEAR, 3-letter MONth (I2, 1X, A3) X YEAR MON YEAR, 3-letter MONth (I4, 1X, A3) X DOY-YR 3-digit Day Of Year, YeaR (I3, 1X, I2) X DOY-YEAR 3-digit Day Of Year, YEAR (I3, 1X, I4) X DD-MON-YR Day of month, MONth, YeaR (I2, 1X, A3, 1X, I2) X DD-MON-YEAR Day of month, MONth, YEAR (I2, 1X, A3, 1X, I2) X ? List of allowed formats (A1) X . current month (1X) X current month X Exit X anything else error $ CALL UNPACK CALENDAR.HLP;1 1966674320 $ create 'f' X X X------------------------------------------------------------------------ XModule: CALENDAR -- Produce graphical monthly calendar on ANSI terminal X------------------------------------------------------------------------ X X Program CALENDAR X`20 +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+- -- Richard L. Dyson INTERNET: Dyson@IowaSP.Physics.UIowa.EDU I have often had the impression that, to penguins, man is just another penguin -- different, less predictable, occasionally violent, but tolerable company when he sits still and minds his own business. --Bernard Stonehouse /* ---------- */