DataMuseum.dk

top - metrics - download

    Length: 96768 (0x17a00)
    Types: TextFile
    Names: »datodagtx   «

└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
    └─⟦a957ba283⟧ 
        └─⟦this⟧ »datodagtx   « 

TextFile

datodag=algol
external
  procedure datodag(år,måned,dag,uge,ugedag,ugeår,årdag);
    value           år,måned,dag;
    integer         år,måned,dag,uge,ugedag,ugeår,årdag;
<* Ugedage:
   ========
     1: mandag, 2: tirsdag, . . ., 7: søndag

   880223 ho: Original version.
   900703 ho: Fejl omkring årdag i uge 53 og først i år efter skudår rettet.
*>
    begin
      integer
        i,md,åd,før_første_januar;
      integer array
        mdlgd(1:12);

      for i:=1 step 1 until 12 do
        mdlgd(i):=case i of (31,28,31,30,31,30,31,31,30,31,30,31);
      ugeår:=år;
      md:=måned;
      årdag:=0;

      repeat
        if ugeår mod 4=0 and (ugeår mod 100 <>0 or ugeår mod 400 =0) then
          mdlgd(2):=29 else mdlgd(2):=28;

        åd:=dag;
        for i:=md-1 step -1 until 1 do åd:=åd+mdlgd(i);
        if årdag=0 then årdag:=åd;
        før_første_januar:=((ugeår-1)//4 -(ugeår-1)//100 +(ugeår-1)//400
                           +ugeår-1) mod 7;
        ugedag:=(før_første_januar+åd-1) mod 7 +1;
        uge:=(før_første_januar+åd-1)//7;
        if før_første_januar<4 then uge:=uge+1;

        if uge=53 and ugedag<4 then
        begin
          uge:=1;
          ugeår:=ugeår+1;
        end;

        if uge=0 then
        begin
          ugeår:=ugeår-1;
          md:=13;
        end;
      until uge<>0;
    end procedure datodag;
  end
end
▶EOF◀