⟦1d90c1844⟧

TextFile

;gosav
lookup plankrmn
if ok.no
(r=algol index.no
rename r.plankrmn
permanent plankrmn.17)
\f





KRAITCHMAN-PROGRAM FOR PLANE MOLEKYLER.            28-4-71. GOS.
begin
comment Programmet beregner substitutionskoordinater med
        usikkerheder. Hertil benyttes Ia og Ib samt, for
        Ib-Ia > 100*ID, Ib og Ic. 
        Som input kræves:
     1) En overskrift i < >,
        (molekylets navn, evt. dato, initialer etc.)
     2) Inertimomenter for modermolekylet Ia, Ib, Ic uÅ**2. 
     3) De tilsvarende usikkerheder, uÅ**2, samt correlations-
        koefficienterne Cab, Cac og Cbc.
     4) Antallet af atomer i molekylet samt det tilsvarende
        antal symboler for modermolekylets atomer.
     5) For hvert isotopsubst. molekyle: en overskrift i < >,
        Ia, Ib, Ic, dIa, dIb, dIc, Cab, Cac, Cbc, symboler for
        det substituerede atom og det nye atom samt to styretal:
        a) M = 0, hvis subst. paa a-axen, ellers 1,
        b) L = 0, hvis subst. paa b-axen, ellers 1
        (herved benyttes lineære Kraitchman-formler),
     6) Umiddelbart efter styretallet L benyttes som sidste
        skilletegn (delimiter) s;
integer i,N,M,L;
real my,a,da,b,db,m,dm,x,y,z,v,Q,X,V;
array R,dR,S,dS,CR,CS(1:3),dX(1:4),head(1:10);
boolean closeres,nl,sp;
zone res(128,1,stderror);
closeres:= outmedium(res);
Q:= real<<-dddd.dddddd>; X:= real<<d.dddddd>; V:= real<<___ddd.dd>;
readhead(in,head,1); i:=1; nl:= false add 10; sp:= false add 32;
write(res,<:<12>:>,nl,2,string head(increase(i)),<:
Beregning med plant Kraitchman-program af 28-4-1971. :>);
read(in,R,dR,CR,N);
for i:=1,2,3 do dX(i):= CR(i);
write(res,nl,1,<:
  I = :>,string Q, R(1), R(2), R(3),<:    ID =:>,R(3)-R(1)-R(2),<:
 dI = :>,dR(1),dR(2),dR(3),<:   dID =:>);
CR(1):= CR(1)*dR(1)*dR(2)*2;
CR(2):= CR(2)*dR(1)*dR(3)*2;
CR(3):= CR(3)*dR(2)*dR(3)*2;  v:= 0;
for i:=1,2,3 do begin
   dR(i):= dR(i)**2; v:= v+dR(i)+CR(i)*(if i=1 then 1 else -1)
end;
write(res,string Q,sqrt(v),<:
Correlations, Cab, Cac, Cbc: :>,
<<_-d.ddd>,dX(1),dX(2),dX(3),nl,1);

begin array mass(1:N);
if atomic(mass,N) then goto stop;
m:= sum(mass(i),i,1,N);
SUB:
readhead(in,head,1); read(in,S,dS,CS);
for i:=1,2,3 do dX(i):= CS(i);
if atomic(mass,2) then goto stop;
dm:= mass(2)-mass(1); read(in,M,L);
i:= 1; write(res,nl,2,string head(increase(i)),<:-subst.
  I = :>,string Q, S(1), S(2), S(3),<:    ID =:>,S(3)-S(1)-S(2),<:
 dI = :>,dS(1),dS(2),dS(3),<:   dID =:>);
CS(1):= CS(1)*dS(1)*dS(2)*2;
CS(2):= CS(2)*dS(1)*dS(3)*2;
CS(3):= CS(3)*dS(2)*dS(3)*2;  v:= 0;
for i:=1,2,3 do begin
   dS(i):= dS(i)**2; v:= v+dS(i)+CS(i)*(if i=1 then 1 else -1)
end;
write(res,string Q,sqrt(v),<:
Correlations, Cab, Cac, Cbc: :>,
<<_-d.ddd>,dX(1),dX(2),dX(3),nl,1);
my:= (m+dm)/(m*dm);  v:= R(2)-R(1);
x:= S(1)-R(1);  y:= S(2)-R(2);  z:= S(3)-R(3);
a:= my*y*L*(1-M*x/v);  b:= my*x*M*(1+L*y/v);
dX(1):= -M/(v-x); dX(2):= 1/y; dX(3):= M/v;
dX(4):=-dX(1)-dX(2)-dX(3);
da:= (dX(1)**2*dS(1)+dX(2)**2*dS(2)+dX(1)*dX(2)*CS(1)
     +dX(3)**2*dR(1)+dX(4)**2*dR(2)+dX(3)*dX(4)*CR(1))*a/4;
dX(1):= 1/x; dX(2):= L/(v+y); dX(4):= -L/v; 
dX(3):=-dX(1)-dX(2)-dX(4);
db:= (dX(1)**2*dS(1)+dX(2)**2*dS(2)+dX(1)*dX(2)*CS(1)
     +dX(3)**2*dR(1)+dX(4)**2*dR(2)+dX(3)*dX(4)*CR(1))*b/4;
v:= v*my+a-b;
v:= (arctan(2*sqrt(abs(a*b))/v) + (if v<0 then pi else 0))*0.5;
write(res,<:
  a = :>); if a>0.0 then begin
write(res,string X, sqrt(a),<:  :>, sqrt(da))
end else write(res,<:ubestemt:>);
write(res,<:   b = :>); if b>0.0 then begin
write(res,string X, sqrt(b),<:  :>,sqrt(db))
end else write(res,<:ubestemt:>);
write(res,<:   af :>, if M=0 then <:Ib:> else
if L=0 then <:Ia:> else <:Ia og Ib:>,<:.
  v = :>); if v=0 then write(res,<:0:>) else begin
write(res,string X, v,string V, v*180/pi,<: grader.:>) end;
write(res,nl,1);
if (R(2)-R(1))>100*(R(3)-R(1)-R(2)) then begin
x:= z-y; v:= R(2)*2-R(3);
a:= my*(y*M+z*(1-M))*L*(1-M*x/v);  b:= my*x*M*(1+L*y/v);
dX(1):= M/y+M/(v-x); dX(2):= (1-M)/z-M/(v-x);
dX(3):= -M/y-2*M/v+M/(v-x); dX(4):= -(1-M)/z+M/v;
da:= (dX(1)**2*dS(2)+dX(2)**2*dS(3)+dX(1)*dX(2)*CS(3)
     +dX(3)**2*dR(2)+dX(4)**2*dR(3)+dX(3)*dX(4)*CR(3))*a/4;
dX(1):= -1/x+L/(v+y); dX(2):= 1/x;
dX(3):= 1/x-2*L/v+L/(v+y); dX(4):= -1/x+L/v-L/(v+y);
db:= (dX(1)**2*dS(3)+dX(2)**2*dS(3)+dX(1)*dX(2)*CS(3)
     +dX(3)**2*dR(2)+dX(4)**2*dR(3)+dX(3)*dX(4)*CR(3))*b/4;
v:= v*my+a-b;
v:= (arctan(2*sqrt(abs(a*b))/v) + (if v<0 then pi else 0))*0.5;
write(res,<:
  a = :>); if a>0.0 then begin
write(res,string X, sqrt(a),<:  :>, sqrt(da))
end else write(res,<:ubestemt:>);
write(res,<:   b = :>); if b>0.0 then begin
write(res,string X, sqrt(b),<:  :>,sqrt(db))
end else write(res,<:ubestemt:>);
write(res,<:   af :>, if M=0 then <:Ic:> else <:Ib og Ic:>,<:.
  v = :>); if v=0 then write(res,<:0:>) else begin
write(res,string X, v,string V, v*180/pi,<: grader.:>) end end;
write(res,nl,1); repeatchar(in);
readchar(in,i); if i<>115 then goto SUB;
stop:  write(res,<:<25>:>); close(res,closeres)
end end
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦1d90c1844⟧ TextFile

Derivation

TextFile
