### kal_julgreg ### 6.2.2007; modified 12.7.2008 ### Maple procedures for the Julian and Gregorian calendars. ### (c) Svante Janson 2007-2008 ### May be freely used and modified for non-commercial properties. ### These procedures are drafts only and not in a final, polished ### version (and probably never will be). ### There is no guarantee that they are correct. ### There is, unfortunately, no further documentation. if # true or (not (Qkal_julgreg_LOADED=true)) then Qkal_julgreg_LOADED:=true; # NB final fi last in the file # To avoid unnecessary repeated loadings of the file, # the line "true or" should be commented away with "#" # While working on the file, remove this "#" if not (Qkal_bas_loaded=true) then read kal_bas fi: # JD för 1.1.1 Julianskt jul_epok:=1721424; # RD för 1.1.1 Julianskt jul_epok_RD:=-1; if not jul_epok_RD=RD4JD(jul_epok) then error "PROGRAM ERROR" fi; #consistency test # JD för Julianskt nyår y (astronomiskt, med år 0) JD4JulAstroNyar:=proc(y) (y-1)*365+floor((y-1)/4)+jul_epok; end; # JD för Julianskt nyår y (utan år 0, om ej ASTRO=true) JD4JulNyar:=proc(y) JD4JulAstroNyar(AstroAr(y)); end; #Juliansk årslängd JulArslangd:=proc(y) JD4JulAstroNyar(AstroAr(y)+1)-JD4JulAstroNyar(AstroAr(y)); end; # JD för julianskt datum JD4Jul:=proc(d,m,y) local korr; if m<=2 then korr:=0 else korr:=JulArslangd(y)-367; fi; JD4JulNyar(y)+floor((367*m-362)/12)+korr+d-1; end; # Julianskt årtal (astronomiskt) för JD JulAstroAr4JD:=proc(x) floor((4*(x-jul_epok)+1464)/1461); end; # Julianskt datum för JD Jul4JD:=proc(x) local ya,y,d1,d3,fd,korr,m,d; ya:=JulAstroAr4JD(x); y:=Ar4Astro(ya); d1:=JD4JulNyar(y); d3:=JD4Jul(1,3,y); fd:=x-d1; if xRD4JD(JD4Jul(d,m,y)); # Julianskt datum för RD Jul4RD:=x->Jul4JD(JD4RD(x)); ####### Gregorianskt # JD för 1.1.1 Gregorianskt greg_epok:=1721426; # RD för 1.1.1 Gregorianskt greg_epok_RD:=1; if not greg_epok_RD=RD4JD(greg_epok) then error "PROGRAM ERROR" fi; #consistency test # JD för Gregorianskt nyår y (astronomiskt, med år 0) JD4GregAstroNyar:=proc(y) (y-1)*365+floor((y-1)/4)-floor((y-1)/100)+floor((y-1)/400)+greg_epok; end; # JD för Gregorianskt nyår y (utan år 0, om ej ASTRO=true) JD4GregNyar:=proc(y) JD4GregAstroNyar(AstroAr(y)); end; #Gregoriansk årslängd GregArslangd:=proc(y) JD4GregAstroNyar(AstroAr(y)+1)-JD4GregAstroNyar(AstroAr(y)); end; # JD för gregorianskt datum JD4Greg:=proc(d,m,y) local korr; if m<=2 then korr:=0 else korr:=GregArslangd(y)-367; fi; JD4GregNyar(y)+floor((367*m-362)/12)+korr+d-1; end; # Gregorianskt årtal (astronomiskt) för JD GregAstroAr4JD:=proc(x) local d0,d1,d2,d3,n400,n100,n4,n1,korr; d0:=x-greg_epok; n400:=floor(d0/146097); d1:=d0 mod 146097; n100:=floor(d1/36524); d2:=d1 mod 36524; n4:=floor(d2/1461); d3:=d2 mod 1461; n1:=floor(d3/365); # d4:=d3 mod 365; if (n100=4) or (n1=4) then korr:=0 else korr:=1; fi; 400*n400+100*n100+4*n4+n1+korr; end; # Gregorianskt datum för JD Greg4JD:=proc(x) local ya,y,d1,d3,fd,korr,m,d; ya:=GregAstroAr4JD(x); y:=Ar4Astro(ya); d1:=JD4GregNyar(y); d3:=JD4Greg(1,3,y); fd:=x-d1; if xGreg4JD(JD4RD(x)); # Julianskt datum för gregorianskt Jul4Greg:=(d,m,y)->Jul4JD(JD4Greg(d,m,y)); # Gregorianskt datum för julianskt Greg4Jul:=(d,m,y)->Greg4JD(JD4Jul(d,m,y)); ######## Svensk svensk_x1:=2342042; #JD för 1.3.1700 = 29.2.1700 (Jul) svensk_x2:=2346425; #JD för 30.2.1712 = 29.2.1712 (Jul) svensk_x3:=2361390; #JD för 1.3.1753 = 18.2.1753 (Jul) svensk_x1_RD:=620617; #RD för 1.3.1700 = 29.2.1700 (Jul) svensk_x2_RD:=625000; #RD för 30.2.1712 = 29.2.1712 (Jul) svensk_x3_RD:=639965; #RD för 1.3.1753 = 18.2.1753 (Jul) # JD för svenskt datum JD4Svensk:=proc(d,m,y) if (y>1753) or ((y=1753) and (m>=3)) then RETURN(JD4Greg(d,m,y)); fi; if ((y=1700) and (m>2)) or ((y>1700) and (y<1712)) or ((y=1712) and (m<=2)) then RETURN(JD4Jul(d,m,y)-1); else RETURN(JD4Jul(d,m,y)); fi; end; # Svenskt datum för JD Svensk4JD:=proc(x) local julx; if x>=svensk_x3 then RETURN(Greg4JD(x)); fi; if (x>=svensk_x1) and (xSvensk4JD(JD4RD(x)); kontrollbokstavar:="ABCDEFGHIKLMNOPQRSTUVXYZ"; kontroll4y:=proc(y) local x,q,r,ch; x:=y-1759; r:=irem(x,24,'q')+1; if x<0 then error "År %1 före 1759",y fi; ch:=kontrollbokstavar[r]; if q=0 then ch else cat(ch,(q+1)); fi; end; y4kontroll:=proc(x) local a,l,n,s; s:=convert(x,string); a:=StringTools:-searchtext(s[1],kontrollbokstavar); if a=0 then error "%1 finns ej",s[1] fi; l:=length(s); if l=1 then n:=1 else n:=parse(substring(s,2..-1)); fi; 1758+a+24*(n-1); end; ##### Juliansk/Gregoriansk # JD för julianskt/gregorianskt datum, med byte fr.o.m. JD=jdx JD4JulGreg:=proc(d,m,y,jdx) local gr; gr:=JD4Greg(d,m,y); if gr>=jdx then RETURN(gr) else RETURN(JD4Jul(d,m,y)); fi; end; # julianskt/gregorianskt datum för JD, med byte fr.o.m. JD=jdx JulGreg4JD:=proc(x,jdx) if x>=jdx then RETURN(Greg4JD(x)); else RETURN(Jul4JD(x)); fi; end; # RD för julianskt/gregorianskt datum, med byte fr.o.m. RD=rdx RD4JulGreg:=proc(d,m,y,rdx) RD4JD(JD4JulGreg(d,m,y,JD4RD(rdx))); end; # julianskt/gregorianskt datum för RD, med byte fr.o.m. RD=rdx JulGreg4RD:=(x,rdx)->JulGreg4JD(JD4RD(x),JD4RD(rdx)); ####### Katolsk katolsk_x:=2299161; #JD för 15.10.1582 katolsk_x_RD:=577736; #RD för 15.10.1582 # JD för katolskt datum JD4Katolsk:=proc(d,m,y) JD4JulGreg(d,m,y,katolsk_x); end; # Katolskt datum för JD Katolsk4JD:=proc(x) JulGreg4JD(x,katolsk_x); end; # RD för katolskt datum RD4Katolsk:=proc(d,m,y) RD4JD(JD4Katolsk(d,m,y)); end; # Katolskt datum för RD Katolsk4RD:=x->Katolsk4JD(JD4RD(x)); ########### InitIndiction:=proc(m0,d0) global INDICTION_m, INDICTION_d; INDICTION_m:=m0; INDICTION_d:=d0; end; InitIndiction(9,24); #### Beda # The year, numbered with 3 BC as year 1, and with the year starting at # INDICTION_m, INDICTION_d. indictionyear_plus3:=proc(y,m:=1,d:=1) if (m