DataMuseum.dk

begin
_____
real al,c,d,r1,r2,r,gamma,delta,dr,ke,pe,alg,cg;
____
integer i,j,k,gem,itr;
_______
boolean lay;
_______
array G[1:40,1:8];
_____
real  procedure expint(y);
____  _________
value y; real y;
_____    ____
begin
_____
real u,v,b,t,a0,a1,b0,b1;
____
integer i,c,p,a;
_______
if y_1 then
__  >  ____
  begin
  _____
  a0:=0; b0:=a1:=1; b1:=y;
  c:=p:=0;
  v:=(if abs(y)<10-154 then 10154 else 1/y);
      __              ____      ____
  rep:
   b:=y∧p;
       |
   c:=c+p; p:=1-p;
   a:=p+c;
     t:=b⨯b0+a⨯a0; a0:=b0; b0:=t;
    t:=b⨯b1+a⨯a1; a1:=b1; b1:=t;
   u:=(if abs(b0)⨯10-154<abs(b1) then b0/b1 else 10154);
       __                       ____       ____
   if abs(u/v-1)>510-9 then begin v:=u; goto rep end;
   __                 ____ _____       ____     ___
expint:=u⨯exp(-y);
   end else
   ___ ____
expint:=((((.00107857⨯y-.00976004)⨯y+.05519968)⨯y
-.24991055)⨯y+.99999193)⨯y-.57721566-ln(y);
end expint;
___
procedure DATO;
_________
begin
_____
integer date,i;
_______
boolean da;
_______
where(|<date|,date);da:=boolean(date);
      <     >           _______
i:=integer((da∧__0__m)shift(-20));
   _______     10 10  _____
writeinteger(|dd|,i);
             <  >
i:=integer((da∧__0__m)shift(-10));
   _______     20 10  _____
writeinteger(|-dd|,-i);
             <   >
i:=integer(da∧__0__m);
   _______    30 10
writeinteger(|-dd|,-i);
             <   >
end;
___
procedure ws(i);
_________
valuei; integeri;
_____   _______
for i:=i step -1 until 1 do
___      ____    _____   __
writechar(0);
procedure wr;
_________
writecr;
procedure wt(t);
_________
string t;
______
writetext(t);
procedure min2(x,y,dr,delta,f,itr);
_________
value dr,delta; real x,y,dr,delta;
_____           ____
integer itr;
_______
real procedure f;
____ _________
begin
_____
real p1,p2,p3,p4,p0,dx,dy;
____
itr:=0; dx:=dr⨯x; dy:=dr⨯y;
LI:
p0:=f(x,y);
L:
p1:=f(x,y+dy); p2:=f(x-dx,y);
p3:=f(x,y-dy); p4:=f(x+dx,y);
if kbon then begin
__      ____ _____
  write(lay,p0,p1,p2,p3,p4,dx,dy); wr end;
                                      ___
LL:
itr:=itr+1;
if p0<p1∧p0<p2∧p0<p3∧p0<p4 then
__                         ____
  begin
  _____
  dx:=dx/2; dy:=dy/2;
  if abs(dx)>delta/2⨯abs(x)∨abs(dy)>delta/2⨯abs(y) then goto L
  __                                               ____ ____
  end else begin
  ___ ____ _____
    if p1<p0∧p1<p2∧p1<p3∧p1<p4 then begin
    __                         ____ _____
       y:=y+dy; p3:=p0; p0:=p1; p1:=f(x,y+dy);
      p2:=f(x-dx,y); p4:=f(x+dx,y) end else
                                   ___ ____
    if p2<p0∧p2<p1∧p2<p3∧p2<p4 thenbegin
    __                         _________
       x:=x-dx; p4:=p0; p0:=p2; p1:=f(x,y+dy);
      p2:=f(x-dx,y); p3:=f(x,y-dy) end else
                                   ___ ____
    if p3<p0∧p3<p2∧p3<p1∧p3<p4 then begin
    __                         ____ _____
       y:=y-dy; p1:=p0; p0:=p3; p2:=f(x-dx,y);
      p3:=f(x,y-dy); p4:=f(x+dx,y) end else begin
                                   ___ ____ _____
      x:=x+dx; p2:=p0; p0:=p4; p1:=f(x,y+dy);
      p3:=f(x,y-dy); p4:=f(x+dx,y) end;
                                   ___
    goto LL
    ____
  end
  ___
end min2;
___
real procedure wei(al,c);
____ _________
real al,c;
____
begin
_____
real ro1,ro2,ro3,e1ro,e2ro,s,s1,s2,ke0,ke1,pe0,pe1
____
     ,expi2,expi4,cou,ion,e1,e2,ex1;
ro1:=al⨯r;
  ro2:=ro1∧2; ro3:=ro2⨯ro1;
          |
  e1ro:=exp(-ro1);
  e2ro:=e1ro∧2;
            |
expi2:=expint(2⨯ro1);
expi4:=expint(4⨯ro1);
  s:=e1ro⨯(1+ro1 +ro2/3);
s1:=(1-e2ro⨯(1+ro1))/ro1 + 1;
  ke0:=1+s⨯e1ro⨯(1 +ro1-ro2/3);
  ke1:=2⨯e1ro⨯(1+ro1);
  s2:=(1-ro1+ro2/3)/e1ro;
  e1:=((s∧2⨯(ln(ro1)+gamma)+2⨯s⨯s2⨯expi2)
         |
      -s2∧2⨯expi4)/ro1;
         |
  e2:=e2ro⨯(.625 -1.15⨯ro1 -.6⨯ro2 -ro3/15);
  ex1:=1.2⨯e1+e2;
cou:=(1-e2ro⨯(1 +1.375⨯ro1 +.75⨯ro2 +ro3/6))/ro1;
ion:=(e1ro⨯(5 +2⨯ro1 +16⨯ro2) -e2ro⨯e1ro⨯(5+2⨯ro1))/8/ro1;
pe0:= -2⨯(s1 + s⨯ke1) + ex1;
pe1:= -2⨯ke1 -2⨯s⨯(s1) + ion;
d:=2⨯(c∧2⨯((1-s)∧2)+(s+1)∧2);
       |        |        |
ke:=2⨯al⨯al⨯(c∧2⨯(ke0-ke1)+ke0+ke1);
              |
pe:=al⨯(c∧2⨯(2⨯pe0-2⨯pe1+.625+cou)+2⨯c⨯(.625-cou)+2⨯pe0+2⨯pe1+cou+.625);
         |
wei:=(pe+ke)/d;
if kbon then begin
__      ____ _____
wr; write(lay,al,c,ke,pe,d,(pe+ke)/d); wr end;
                                          ___
end wei;
___
select(17);
comment r=1.2 => al=1.25 ∧ c=-.59;
_______
r1:=read real;
dr:=read real;
r2:=read real;
delta:=read real;
al:=read real;
c:=read real;
gamma:=.577215665;
lay:=|  -d.dddddd|;
     <           >
k:=entier((r2-r1)/dr);
   ______
reserve(|<wein|,k_8+1);
        <     >  :
where(|<wein|,gem);
      <     >
wr; ws(10);DATO;wr;
wt(|<Weinbaum beregning|); wr;
   <                   >
wt(|<   R |); ws(4); wt(|<alfa|); ws(8);
   <      >             <     >
wt(|<c|); ws(10); wt(|<Ep|); ws(9); wt(|<Ek|);
   <  >              <   >             <   >
ws(9); wt(|<E|); ws(9); wt(|<norm|); ws(5); wt(|<iterationer|); wr;
          <  >             <     >             <            >
for i:=1 step 1 until k do
___      ____   _____   __
 begin
 _____
 r:=r1+i⨯dr;
  min2(al,c,.1,delta,wei,itr);
  write(|-dd.d|,r);
        <     >
  write(lay,al,c,pe/d,ke/d,(pe+ke)/d+(if r>0 then 1/r else 0),
                                      __     ____     ____
        1/sqrt(2⨯d));
  writeinteger(|  -ddddd|,itr); wr;
               <        >
  alg:=G[i,1]:=al; cg:=G[i,2]:=c; G[i,3]:=d; G[i,4]:=ke;
G[i,5]:=pe; G[i,6]:=r; G[i,7]:=realitr;
                               ____
if imod40=0 then put(G,gem,1+(i-1)_40⨯8);
__  ___     ____                  :
end forstatement
___
end t<
___