DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »goozon«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦1248b0c55⟧ »gobib« 
            └─⟦this⟧ 

TextFile

;gosav
r=algol list.yes
begin
comment test of formulae for ozon G-matrix;
integer i,j,k,l;
real a,b,c,d,u,z,cos3,sq2,sq3;
boolean nl,bo;
array r,khi,phi(1:3),t,g,h(1:3,1:3);
nl:= false add 10; sq2:= sqrt(2); sq3:= sqrt(3);
rep:
read(in,u);
if u>0 then begin
  read(in,z,khi(1)); bo:= true;
  khi(1):= khi(1)*pi/180;
  khi(2):= khi(1)-2*pi/3;
  khi(3):= khi(1)+2*pi/3;
  for i:=1,2,3 do begin
    r(i):= (1+z*sq2*cos(khi(i)))*u/sq3;
    t(1,i):= 1/sq3;
    t(2,i):= (cos(khi(i))*sq2-z)/(u*sq3);
    t(3,i):= -sin(khi(i))*sq2/(u*sq3);
  end;
  for i:=1,2,3 do begin
    j:= i mod 3 + 1; k:= j mod 3 + 1;
    phi(i):= (r(j)**2+r(k)**2-r(i)**2)/(2*r(j)*r(k));
    g(j,k):= g(k,j):= phi(i);
    g(i,i):= 2;
  end;
  write(out,nl,2,<:u, z, khi::>,<<-dddd.dddddd>,u,z,khi(1),
            nl,2,<:r1,r2,r3: :>,r(1),r(2),r(3),
            nl,2,<:G-matrix::>);
  writemat(out,<<-ddddd.dddddd>,g,3,3);
  for i:=1,2,3 do
  for j:=1,2,3 do h(i,j):= sum(t(i,k)*g(k,j),k,1,3);
  for j:=1,2,3 do
  for i:=j step 1 until 3 do 
                  g(i,j):= sum(h(i,k)*t(j,k),k,1,3);
  writemat(out,<<-ddddd.dddddd>,g,3,3);
  if bo then begin
    bo:=false;
    cos3:= cos(3*khi(1));
    c:= 2-3*z**2+sq2*z**3*cos3;
    g(1,1):= 6*(1-2*z**2)/c;
    g(2,2):= (1-sq2*z*cos3-4*z**2)*3*(1+z**2)/(u**2*c);
    g(3,3):= (1+sq2*z*cos3)*3*(1+z**2)/(u**2*c);
    writemat(out,<<-ddddd.dddddd>,g,3,3);
  end;
  write(out,nl,2);
  setposition(out,0,0); goto rep;
end end;
clear ozon
rename r.ozon
permanent ozon.15
head 1

ozon
1 0.1 30
1 0.01 30
1 0.01 10
1 0.01  1
1 0.1 0
1 0 0
0
;gosav
r=algol list.yes
external
real procedure dV(x,pm,dy,b);
value b; boolean b; array x,pm,dy;
begin
real r1,r2,r3,f,s,c,sq2,sq3,u,z,z2,v,v2,du,cos3khi,dcos,rho;
integer i,t;
rho:= x(3)*pi/180; t:=x(4); sq2:=sqrt(2); sq3:=sqrt(3);
if t>0 and t<6 then begin
  du:=0; c:=cos(rho/2); s:=sin(rho/2);
  for i:=1 step 1 until 11 do dy(i):=0;
  rep:
  r2:=r3:=1+x(1)/sq2; r1:=r2*c*2;
  u:=(r1+r2+r3)/sq3;  z2:=r2*r2*(4*c*c+2)/(u*u)-1;
  z:=if z2>0 then sqrt(z2) else 0;
  f:=1-6*z2-4*sq2*z2*z;
  if t=3 then begin
    dV:=0;
  end else begin
    r1:=sq2+x(1); r2:=r1*r1;
    if t<>2 then begin
      v:=pm(4)*3/4*(u-4/sq3)*u/r1;
      dy(6):=f*u/r1; dy(7):=dy(6)*f;
      for i:=6 step 1 until 7 do v:=v+pm(i)*dy(i);
      if t=1 then dV:=v;
    end;
    if t<>1 then begin
      v2:=pm(4)*2;
      if t=2 then dV:=0;
    end;
    if t>2 then begin
      r1:=x(1)-v/v2;
      if r1-x(1)<>0 and (du=0 or abs du>abs v) then begin
          x(1):=r1; du:=v; goto rep
      end;
end end end;
if t=0 or t>3 then begin
  r2:= 1+(x(1)+x(2))/sq2; r3:= 1+(x(1)-x(2))/sq2;
  r1:=sqrt(r2*r2+r3*r3+2*r2*r3*cos(rho));
  u:=(r1+r2+r3)/sq3;
  z2:=(r1*r1+r2*r2+r3*r3)/(u*u)-1;
  z:=if z2>0 then sqrt(z2) else 0;
  cos3khi:=if z=0 then 1 else
           (r1*sq3/u-1)*(r2*sq3/u-1)*(r3*sq3/u-1)*4/(z*sq2)**3;
  f:=1-6*z2-4*sq2*cos3khi*z2*z;
  dy(6):=u*f; dy(7):=dy(6)*f; dy(8):=f;
  dy(9):=f*z2; dy(10):=dy(9)*z*cos3khi; dy(11):=dy(9)*z2;
  z:=pm(1)*rho**2+pm(2)*rho**4+pm(3)*rho**6;
  if t=0 then z:=z+pm(4)*x(1)**2+pm(5)*x(2)**2;
  u:= pm(4)*3/8*(u-4/sq3)**2+pm(5)*16/3*(z2-1/8);
  for i:=6 step 1 until 11 do u:=pm(i)*dy(i)+u;
  dV:=if t>4 then -u else u-z;
end end;
end

clear funcfit vfit funclinda
rename r.funclinda
r=set
i algfuncfit
rename funcfit.vfit
;gosav
vfit
<C3 pot.>
65 4 11
5
138.3849 95.8967 57.9710 911140 826780
0 0 0 0 0 0
1 2 3 4 5
0 0 0 0 0 w0
 0.01 0 0 0 0 w0
-0.01 0 0 0 0 w0
0  0.01 0 0 0 w0
0 -0.01 0 0 0 w0
0 0 0 1 0 w0
0 0 1 1 0 w50
0 0 2 1 0 w50
0 0 3 1 0 w50
0 0 5 1 0 w50
0 0 10 1 0 w50
0 0 15 1 0 w50
0 0 20 1 0 w50
0 0 30 1 0 w50
0 0 40 1 0 w50
0 0 50 1 0 w0
0 0 70 1 0 w0
0 0 80 1 0 w0
0 0 90 1 0 w0
0 0 100 1 0 w0
0 0 110 1 0 w0
0 0 120 1 0 w0
0 0 0 3 0 w0
0 0 0 4 0 w0
-1.1111 0 1 4 0 w1
0 0 2 4 0 w1
0 0 3 4 0 w1
0 0 5 4 0 w1
0 0 10 4 0 w1
0 0 15 4 0 w1
0 0 20 4 0 w1
0 0 30 4 0 w1
0 0 40 4 0 w1
0 0 50 4 0 w1
0 0 70 4 0 w1
0 0 80 4 0 w1
0 0 90 4 0 w1
0 0 100 4 0 w0
0 0 110 4 0 w0
0 0 120 4 0 w0
0 0   1 5 0 w0
0 0   2 5 0 w0
0 0   3 5 0 w0
0 0   4 5 0 w0
0 0   5 5 0 w0
0 0  10 5 0 w0
0 0  20 5 0 w0
0 0  30 5 0 w0
0 0  40 5 0 w0
0 0  50 5 0 w0
0 0  60 5 0 w0
0 0  70 5 0 w0
0 0  80 5 0 w0
0 0  90 5 0 w0
0 0 100 5 0 w0
0 0 110 5 0 w0
0 0 115 5 0 w0
0 0 116 5 0 w0
0 0 117 5 0 w0
0 0 118 5 0 w0
0 0 119 5 0 w0
0 0 120 5 0 w0
0 0 121 5 0 w0
0  0.01 120 5 0 w0
0 -0.01 120 5 0 w0
▶EOF◀