DataMuseum.dk

top - metrics - download

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

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

TextFile

;gosav
lookup krmn
if ok.no
(krmn=set 46
permanent krmn.17
krmn=algol index.no list.no)
\f





GENERELT KRAITCHMAN-PROGRAM.               19-5-1976, GOS.
begin
comment Programmet beregner substitutionskoordinater
        med usikkerheder. Hertil benyttes Ia, 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 og korrelationskoef-
        ficienterne Cab,Cbc,Cca, 
     4) Antallet af atomer i molekylet samt det tilsvarende
        antal atomsymboler.
     5) For hvert isotopsubst. molekyle: en overskrift i <>,
        inertimomenter analogt med pkt. 2 og 3 samt symboler
        for det substituerede atom og det nye atom.
     6) Regningerne standses ved <>;
integer i,j,k,N;
real my,a,da,b,db,c,dc,paa,pbb,pcc,pab,pbc,pca,m,dm,P,Q,X;
array R,dR,S,dS,CR,CS(1:3),d(1:6),head(1:12);
boolean closeres,nl;
zone res(128,1,stderror);
nl:= false add 10; closeres:= outmedium(res);
Q:= real <<_-ddd.dddddd>; X:= real <<-dd.ddddd>;
readhead(in,head,1); i:=1;
write(res,nl,1,string head(increase(i)),<:
Beregning med Kraitchman-program af 19-5-1976.:>);
read(in,R,dR,CR,N);
begin array mass(1:N);
if atomic(mass,N) then goto stop;
   m:= sum(mass(i),i,1,N)
end;
dR(3):= - dR(3);
P:= sum(dR(k)*(dR(k)+2*CR(k)*dR(k mod 3+1)),k,1,3);
dR(3):= - dR(3);
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 =:>,sqrt(P),<:
 Cij= :>,<<___-d.ddd>,CR(1),<<______-d.ddd>,CR(2),CR(3));
readhead(in,head,1);
SUB:  i:=1;
write(res,nl,2,string head(increase(i))); read(in,S,dS,CS);
if atomic(head,2) then goto stop;
dm:= head(2)-head(1);
dS(3):= - dS(3);
P:= sum(dS(k)*(dS(k)+2*CS(k)*dS(k mod 3+1)),k,1,3);
dS(3):= - dS(3);
write(res,<:-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 =:>,sqrt(P),<:
 Cij= :>,<<___-d.ddd>,CS(1),<<______-d.ddd>,CS(2),CS(3),nl,1);


my:=m*dm/(m+dm);
paa:= ( R(1)-R(2)-R(3)-S(1)+S(2)+S(3))*0.5;
pbb:= (-R(1)+R(2)-R(3)+S(1)-S(2)+S(3))*0.5;
pcc:= (-R(1)-R(2)+R(3)+S(1)+S(2)-S(3))*0.5;
pab:= R(2)-R(1);
pbc:= R(3)-R(2);
pca:= R(1)-R(3);

for j:=1 step 1 until 3 do begin
   c:= paa*(1-pbb/pab)*(1+pcc/pca)/my;

   d(1):= (0.5/paa-0.5/(pab-pbb)+0.5/(pca+pcc)+1/pab-1/pca)*dR(1);
   d(2):= (0.5/paa-0.5/(pab-pbb)+0.5/(pca+pcc)+1/pab)*dR(2);
   d(3):= (0.5/paa-0.5/(pab-pbb)+0.5/(pca+pcc)-1/pca)*dR(3);
   d(4):= (0.5/paa+0.5/(pab-pbb)-0.5/(pca+pcc))*dS(1);
   d(5):= (0.5/paa+0.5/(pab-pbb)+0.5/(pca+pcc))*dS(2);
   d(6):= (0.5/paa-0.5/(pab-pbb)-0.5/(pca+pcc))*dS(3);

   dc:= sum(d(k)*d(k),k,1,6)  +
      2*sum(CR(k)*d(k)*d(k mod 3+1) +
            CS(k)*d(k+3)*d(k mod 3+4),k,1,3);
   dc:= dc*c/4;
   if j=1 then begin a:= c; da:= dc end else
   if j=2 then begin b:= c; db:= dc end;
   P:= paa; paa:= pbb; pbb:= pcc; pcc:= P;
   P:= pab; pab:= pbc; pbc:= pca; pca:= P;
end;
write(res,<:
a = :>); if a>0.0 then
   write(res,string X, sqrt(a),<:  :>, sqrt(da))
else write(res,<:ubestemt:>);
write(res,<:
b = :>); if b>0.0 then
   write(res,string X, sqrt(b),<:  :>, sqrt(db))
else write(res,<:ubestemt:>);
write(res,<:
c = :>); if c>0.0 then
   write(res,string X, sqrt(c),<:  :>, sqrt(dc))
else write(res,<:ubestemt:>);
write(res,<:   af Ia, Ib og Ic,:>,nl,1);
i:= readhead(in,head,1);
if i > 0 then goto SUB;
stop:
write(res,<:<25>:>); close(res,closeres)
end;
▶EOF◀