NETMGR@FINFUN.BITNET.UUCP (12/05/86)
Does anyone have the DTC calendar program, (DECUS: 11-597) on a VAX on BITNET. If You can send it to me, please reply by mail directly to me. Are there other calendar programs for a VAX? Pekka Kyt|laakso NETMGR@FINFUN.BITNET FSCC/USD (Finnish State CC. University Support Department)
u3369429@seismo.CSS.GOV@murdu.OZ.AU (12/09/86)
In article <8612062329.AA03624@ucbvax.Berkeley.EDU> NETMGR@FINFUN.BITNET writes: >Are there other calendar programs for a VAX? Hi! For all of you with some interest in calendars (New Year is coming up), here is my 2 cents contribution: CALENDAR.COM inspired by unix "cal" EASTER.FOR A subroutine to tell the date of Easter MMEASTER.FOR Finds min/max Easter dates FQEASTER.FOR Frequency tabulation of Easter Dates TEASTER.FOR A main program employing subroutine EASTER SUFFIX.FOR Suffixes for ordinal numbers, required by the above. JULGREG.FOR Two subroutines to perfom date conversion JULTST.FOR A main program employing subroutine JULGREG LEAP.FOR A function determining a leap year MYMOD.FOR A modified MOD function, required by the above. The comments in JULGREG re: the calendar reform refer to the European calendar reform. I believe the Poms had a different one (see cal(1) ). +++ Here comes: CALENDAR.COM $ Verify='F$Verify(F$TRNLNM("COMMAND_DEBUG")) $ On Control_Y then goto Clean_up $ Old_Msg=F$Environment("MESSAGE") ! save previous SET MESSAGE parms $ Set Message/Nofacility/NoIdentification/Noseverity/NoText $! CALENDAR.COM displays a monthly calendar $! Parameters (optional): $! P1=month as MON (e.g. Aug) $! P2=year as yyyy (e.g. 1986) $! ) Michael Bednarek, 1986 $! $ Say="Write SYS$OUTPUT" $ Days="Mon Tue Wed Thu Fri Sat Sun" ! The Days of the week $ Months=" January February March April May June " + - "July August September October November December" $! ! use only the first three characters $ MMM=F$Extract(0,3,F$Edit(P1,"COLLAPSE,UPCASE")) $ If F$Locate(" ''MMM'",F$Edit(Months,"UPCASE")).eq.F$Length(Months) - then goto Warning $ Month_Year="-''MMM'-''P2'" ! combine P1 and P2 into a date format $ A="1"+"''Month_Year'" ! Test for valid date $ On Warning then goto Warning ! because then an invalid date was given $ Weekday=F$Extract(0,3,F$CVTime(A,,"WEEKDAY")) $ Pos_WD=F$Locate(Weekday,Days)+1 ! Remember the first day's weekday $! $ L_Days=F$Length(Days) ! Length of array 'Days' $ Pos_Last_WD=L_Days-2 $ Stars=F$FAO("!''L_Days'**") ! A line of asterisks $! $ Say Stars ! First line of asterisk $ Month=F$CVTime(Month_Year,,"MONTH") ! Extract the month from parameters $ Year =F$CVTime(Month_Year,,"YEAR") ! ... and the year $! Translate the 2-digit month number into its name $ Month=F$Element(F$Integer(Month)," ",Months) $ Month=Month+" "+Year ! append a blank and the year $ l=F$Length(Month) ! find out this string's length $ k=(L_Days-2-l)/2 ! in order to center it above the box $ Month="*"+F$FAO("!''k'* ")+Month ! Centering 'Month Year' $ Month['L_Days'-1,1]:="*" ! and tuck an asterisk at the end $ Say Month ! Finally, display it $ Say Stars ! and the line of asterisks again. $! $ Say Days ! Day Header for the Calendar Box $! $ On Warning then goto n_Days ! This will tell us $ Day=29 ! how many days are there in this month $ Try_more: A="''Day'"+"''Month_Year'" ! Construct the string for F$CVTime $ k=F$CVTime(A) ! Make a fake call to F$CVTime, $ Day=Day+1 ! when success, try next day $ If Day.eq.32 then goto n_Days ! No month has 32 days $ Goto Try_more $ n_Days: n_Days=Day-1 ! Warning happened, now we know. $! $ Line="" $ Day=0 ! Off we go. $ On Warning then Exit ! We don't expect any. $ Next_Day: Day=Day+1 ! increment day $ If Day.gt.n_Days then goto EOJ ! Finished month ? $ Day_Num=F$FAO("!2UL",Day) ! integer to string (I2) $ Line['Pos_WD',2]:="''Day_Num'" ! insert this string into output line $ Pos_WD=Pos_WD+4 ! increment pointer $ If Pos_WD.le.Pos_Last_WD then goto Next_Day ! Finished this week ? $ Say Line ! Yes. Print this week. $ Line="" ! And initialize ... $ Pos_WD=1 ! ... variables for next week. $ Goto Next_Day $! $ Warning: $ Say "%Calendar-W-IVATIME, invalid parameter - use MON YYYY format" $ Say "\''P1' ''P2'\" $ Goto Clean_up $ EOJ: $ If Line.nes."" then Say Line ! Anything left ? $ Clean_up: $ Set Message 'Old_Msg ! Restore entry params $ Verify=F$Verify(Verify) --- Here ends: CALENDAR.COM +++ Here comes: EASTER.FOR Subroutine EASTER (yyyy,dd,m) ! ) Michael Bednarek, 1986 ! This subroutine caculates the date of easter in year yyyy, and returns ! the day dd and month m. The algorithm and all comments are taken from ! Donald E. Knuth's "Fundamental Algorithms", published in Vol.1 of ! The Art of Computer Programming, 2nd Edition, ISBN 0-201-03809-9, pp.155,156 ! The following algorithm, due to the Neapolitan Aloysius Lilius and the German ! Jesuit mathematician Christopher Clavius in the late 16th century, is used by ! most Western churches to determine the date of Easter Sunday for any year ! after 1582. [For previous years, see CACM 5 (1962), 209-210). The first sys- ! tematic algorithm for calculating the date of Easter was the "canon paschalis" ! due to Victorius of Aquitania (457 A.D.). There are many indications that the ! sole important application of arithmetic in Europe during the Middle Ages was ! the calculation of the Easter date, and so such algorithms are historically ! significant. For further commentary, see "Puzzles and Paradoxes" by ! T.H. O'Beirne (London: Oxford University Press, 1965), Chapter 10.] Implicit Integer (A-Z) ! Check parameters If (yyyy.lt.1583) then dd=-1 m=-1 else gold=MOD(yyyy,19)+1 ! the "golden number" in the ! Metonic cycle cent=yyyy/100+1 ! the century number x=3*cent/4-12 ! correction for leap years (divisible ! by 4, but not centuries, e.g. 1900) z=(8*cent+5)/25-5 ! synchronisation with moon's orbit sun=5*yyyy/4-x-10 ! March (-sun)MOD 7 is a Sunday epact=MOD(11*gold+20+z-x,30) ! specifies full moon If (epact.lt.0) epact=epact+30! compensate FORTAN's MOD deficiencies If (epact.eq.25 .and. gold.gt.11 .or. epact.eq.24) epact=epact+1 ! Easter is supposedly the "first Sunday following the first full moon which ! occurs on or after March 21." Actually perturbations in the moon's orbit do ! not make this strictly true, but we are concerned here with the "calendar ! moon" rather than the actual moon. The FULLth of March is a calendar full ! moon. full=44-epact ! find date of full moon If (full.lt.21) full=full+30 full=full+7-MOD(sun+full,7) ! advance to Sunday If (full.gt.31) then ! get month m=4 ! April dd=full-31 else m=3 ! March dd=full End If End If Return End --- Here ends: EASTER.FOR +++ Here comes: MMEASTER.FOR Program MMEASTER ! find min/max dates for easter Implicit Integer (A-Z) Character SUFFIX*2 Write (*,*) 'PGM=MMEASTER find min/max dates for Easter' 100 Write (*,*) 110 Write (*,'(A)') '$Enter start,end: ' Read (*,*,END=9000,ERR=110) start,end mdd=9999 xdd=-2 Do 2000 yyyy=start,end Call Easter (yyyy,dd,m) If (m.eq.3) then If (dd.le.mdd) then mdd=dd myy=yyyy Write (*,130) ' ','New Min:',mdd,SUFFIX(mdd),' March',myy 130 Format (A,A,I3,A,A,I5) End If else If (m.eq.4) then If (dd.ge.xdd) then xdd=dd xyy=yyyy Write (*,130) ' ', 1 'New Max:',xdd,SUFFIX(xdd),' April',xyy End If End If 2000 Continue Write (*,*) 'MIN:',mdd,SUFFIX(mdd),' March',myy Write (*,*) 'MAX:',xdd,SUFFIX(xdd),' April',xyy Go to 100 9000 Call Exit End --- Here ends: MMEASTER.FOR +++ Here comes: FQEASTER.FOR Program FQEASTER ! tabulates frequencies of Easter Implicit Integer (A-Z) Integer Tab(35) Character SUFFIX*2,Month*5 Write (*,*) 'PGM=FQEASTER find min/max dates for Easter' 100 Write (*,*) 110 Write (*,'(A)') '$Enter start,end: ' Read (*,*,END=9000,ERR=110) start,end Do 120 i=1,35 120 Tab(i)=0 n=0 Do 2000 yyyy=start,end Call Easter (yyyy,dd,m) If (m-3) 2000,1810,1820 1810 i=dd-21 ! 22-Mar...31-Mar -> 1...10 Go to 1900 1820 If (m-4) 2000,1830,2000 1830 i=dd+10 ! 01-Apr...25-Apr -> 11...35 1900 n=n+1 Tab(i)=Tab(i)+1 2000 Continue Write (*,*) 'Frequency distribution of Easter for',n,' years:' Do 3000 i=1,35 If (i.le.10) then Month='March' dd=i+21 else Month='April' dd=i-10 End If 3000 Write (*,*) dd,SUFFIX(dd),' ',Month, 1 Tab(i),FLOAT(Tab(i))/FLOAT(n)*100. Go to 100 9000 Call Exit End --- Here ends: FQEASTER.FOR +++ Here comes: TEASTER.FOR Program TEASTER ! testing subroutine EASTER Implicit Integer (A-Z) Character SUFFIX*2,Month(4)*5 Data Month/' ',' ','March','April'/ Write (*,*) 'PGM=TEASTER Dates of Easter between 1583 and 4200' 100 Write (*,*) 110 Write (*,'(A)') '$Enter a year (yyyy): ' Read (*,*,END=9000,ERR=110) yyyy Call Easter (yyyy,dd,m) If (dd.gt.0) then Write (*,*) 'Easter is on the ',dd,SUFFIX(dd),' ',Month(m) else Write (*,*) 'Invalid year, EASTER returns dd=',dd,' m=',m End If Go to 100 9000 Call Exit End --- Here ends: TEASTER.FOR +++ Here comes: SUFFIX.FOR CHARACTER*2 FUNCTION SUFFIX (N) C C provides appropriate suffix for N C L2=MOD(N,100)/10 ! the 2nd last digit IF (L2.EQ.1) GO TO 900 LAST=MOD(N,10) ! the last digit GO TO (100,200,300),LAST 900 SUFFIX='th' RETURN 100 SUFFIX='st' RETURN 200 SUFFIX='nd' RETURN 300 SUFFIX='rd' RETURN END --- Here ends: SUFFIX.FOR +++ Here comes: JULGREG.FOR Subroutine JULGREG ! This is a dummy subroutine name ! ) Michael Bednarek, 1986 ! Subroutines/Functions required: ! LEAP A logical*1 function returning TRUE for a leap year, else FALSE ! MYMOD A modified MOD(n,m) function which returns m where MOD would return 0 Implicit Integer (A-Z) Integer*4 M1(12),M2(12) Logical*1 Leap Data M1/31,28,31,30, 31, 30, 31, 31, 30, 31, 30, 31/, 2 M2/ 0,31,59,90,120,151,181,212,243,273,304,334/ Return !------------------------------------------------------------------------------- ENTRY JULIAN (Year,Month,Day, YJDay,AJDay,WDay) ! Converts Gregorian Date into Julian Day ! Input: (all parameters are Integer*4) ! Year = Year as yyyy ! Month = Month as mm ! Day = Day as dd ! Output: ! YJDay = Julian Day in this year ! AJDay = Julian Day since 1-Jan-0001 A.D. (can be used as input to GREGOR) ! WDay = Day of the week, 1=Monday, 7=Sunday ! BEWARE: Though the formula will return a "correct" value (correct within its ! design limits which does not include the Calendar Reform in 1582 which ! skipped ten days from 5-Oct to 14-Oct), its usage before this date is ! highly discouraged. ! The upper boundary for the year 5,879,490 is only to avoid integer ! overflow in the computaion of AJDay. The highest possible value the ! routine could process is 31-Dec-5,879,490 (or AJDay=2,147,439,626). ! If the expression: ! AJDay=L*365+L/4-L/100+L/400+YJDay ! would be rearranged, e.g. into: ! AJDay=L*365-L/100+L/4+L/400+YJDay ! the limit could possibly be stretched further. But who cares? ! Also, the routine doesn't work for years before 1. ! NOTE: Wolfgang Ernst at Melbourne University IAESR developed a set of ! similar routines which caters for all calendar anomalities: ! 1) Calendar Reform (see above) ! 2) There is no year zero ! 3) All centuries before the calendar reform were leap years ! 4) It works down to the date 1-Jan-4713 B.C. Check input parameters If (Year) 29,29, 1 1 If (Year-5879490)2, 2,29 2 If (Month) 29,29, 3 3 If (Month-12) 4, 4,29 4 If (Day) 29,29, 6 ! detect leap year 6 If (Leap(Year)) then L=1 else L=0 End If M1(2)=28+L If (M1(Month)-Day) 29, 9, 9 Calculate this year's Julian Day 9 YJDay=M2(Month)+Day If (Month.GT.2) YJDay=YJDay+L Caculate the Absolute Julian Day L=Year-1 AJDay=L*365+L/4-L/100+L/400+YJDay WDay=MyMOD(AJDay,7) 19 Return ! erroneous input 29 YJDay=-1 AJDay=-1 WDay=-1 Go to 19 !------------------------------------------------------------------------------- ENTRY GREGOR (AJDay, Year,Month,Day) ! Converts Julian Day into Gregorian Date ! Input: (all parameters are Integer*4) ! AJDay = Julian Day since 1-Jan-0001 A.D. (as obtained from JULIAN) ! Output: ! Year = Year as yyyy ! Month = Month as mm ! Day = Day as dd Check input parameter If (AJDay) 129,129,101 101 If (AJDay-2147439626) 102,102,129 i=AJDay im=i/146097 Year=im*400 i=i-im*146097 im=i/36524 Year=Year+im*100 i=i-im*36524 im=i/1461 Year=Year+im*4 i=i-im*1461 im=(i+364)/365-1 Year=Year+im YJDay=AJDay-Year*365-Year/4+Year/100-Year/400 Year=Year+1 If (Leap(Year) .and. YJDay.gt.59) then M1(2)=29 else M1(2)=28 End If n1=0 Do 105 Month=1,12 n2=n1 n1=n1+M1(Month) If (YJDay.le.n1) go to 107 105 Continue Month=12 107 Day=YJDay-n2 119 Return ! erroneous input 129 Year=-1 Month=-1 Day=-1 Go to 119 End --- Here ends: JULGREG.FOR +++ Here comes: JULTST.FOR Program JULTST C testing routines JULIAN & GREGOR ! ) Michael Bednarek, 1986 Implicit Integer (A-z) Integer*2 MD(12) Character Days(7)*2,Line*80 DATA Days/'Mo','Tu','We','Th','Fr','Sa','Su'/, 1 MD/31,17,31,30,31,30,31,31,30,31,30,31/ 5 WRITE (*,10) 10 FORMAT (' PGM=JULTST V.4 Calender Conversion' 1 /' ==========') 900 Write (*,*) 'F=G for Gregorian input, J for Julian input' 1000 WRITE (*,1010) 1010 FORMAT (/' Enter F dd,mm,yyyy: ',$) Read (*,'(A)',END=9000) Line ! discard leading spaces/tabs, compress, uppercase Call BAS$Edit(Line,Line,%VAL(56)) If (Line(1:1).eq.'G') then Read (Line(2:),*,ERR=900) Day,Month,Year Call Julian (Year,Month,Day, JDay,NDay,WDay) Write (*,*) 'JULIAN: JDay',JDay,', NDay ',NDay ,' ',Days(WDay) else if (Line(1:1).eq.'J') then Read (Line(2:),*,ERR=900) NDay Call Gregor (NDay, Year,Month,Day) Call Julian (Year,Month,Day, JDay,NDay,WDay) Write (*,*) 'GREGOR: Year',Year,', Month',Month,', Day',Day, 1 ' ',Days(WDay) else Go to 900 End If Go to 1000 9000 Call Exit End --- Here ends: JULTST.FOR +++ Here comes: LEAP.FOR Logical*1 Function LEAP (Year) ! ) Michael Bednarek, 1986 Integer Year ! Statement function to return TRUE if year is leap year Leap=MOD(Year,400).eq.0 .or. 1 MOD(Year,100).ne.0 .and. MOD(Year,4).eq.0 Return End --- Here ends: LEAP.FOR +++ Here comes: MYMOD.FOR Integer Function MyMOD (N,J) ! ) Michael Bednarek, 1986 ! Similar to MOD(N,J) but where MOD(N,J) returns 0, MyMOD(N,J) returns J If (J.eq.0) then MyMOD=0 else MyMOD=N-(((N+J-1)/J-1)*J) End If Return End --- Here ends: MYMOD.FOR