DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »algisocomp«

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

TextFile

;kemlab5 1
isocomp=set 40
permanent isocomp.15
isocomp=algol index.no
\f


ISOCOMP   DC/PAL  74
begin
comment Program til beregning af delvis isotopsubstituerede mole-
culers normalsvingningsfrekvenser (den komplette isotopregel)

S. Brodersen, A. Langseth, Kgl. Danske Videnskab.  Selskab, Mat.-
                           fys. Skrifter 1, No. 5 (1958)
S. Brodersen, A. Langseth, J. Mol. Spectr. 3, 114 (1959)

Inputregler:

   1) tekststreng i <>
   2) antal normalsvingningsfrekvenser i klasse 1
   3) antal normalsvingningsfrekvenser i klasse 2
   4) normalsvingningsfrekvenser for A-moleculet i klasse 1
   5) normalsvingningsfrekvneser for A-moleculet i klasse 2
   6) normalsvingningsfrekvenser for C-moleculet i klasse 1
   7) normalsvingningsfrekvenser for C-moleculet i klasse 2
   8) fmin, hvis fmin:=0 sættes fmin til mindste frekvens
      for C-moleculet
   9) fmax, hvis fmax:=0 sættes fmax til største frekvens
      for A-moleculet
  10) deltaf, benyt ikke værdier under 0.1;


integer i,j,p,q,n,k;
real x,y,y0,z,z0,xmin,xmax,deltax,fmin,fmax,deltaf,a1,a2,c1,c2,
tau1,tau2;
array head(1:12);
boolean nl,sp;

nl:=false add 10; sp:=false add 32;
readhead(in,head,1); read(in,p,q); n:=p+q;

begin
array A1(1:p),A2(1:q),C1(1:p),C2(1:q),B1(1:n),B2(1:n);
read(in,A1,A2,C1,C2); xmin:=C1(1); xmax:=A1(1); tau1:=tau2:=1;
for j:=1 step 1 until p do
begin if C1(j)<xmin then xmin:=C1(j);
      if A1(j)>xmax then xmax:=A1(j);
      tau1:=C1(j)/A1(j)*tau1; B1(j):=B2(j):=0;
      A1(j):=(A1(j)/1000)**2; C1(j):=(C1(j)/1000)**2;
end;
for j:=1 step 1 until q do
begin if C2(j)<xmin then xmin:=C2(j);
      if A2(j)>xmax then xmax:=A2(j);
      tau2:=C2(j)/A2(j)*tau2; B1(j+p):=B2(j+p):=0;
      A2(j):=(A2(j)/1000)**2; C2(j):=(C2(j)/1000)**2;
end;
read(in,fmin,fmax,deltaf); if deltaf<0.1 then deltaf:=0.1;
if fmin=0 then fmin:=xmin-5*deltaf;
if fmax=0 then fmax:=xmax+5*deltaf;
xmin:=fmin/1000; xmax:=fmax/1000;
deltax:=deltaf/1000; k:=1; y0:=0;
for z:=xmin step deltax until xmax do
begin a1:=a2:=c1:=c2:=1; x:=z**2;
      for j:=1 step 1 until p do
      begin a1:=a1*(x-A1(j)); c1:=c1*(x-C1(j)); end;
      for j:=1 step 1 until q do
      begin a2:=a2*(x-A2(j)); c2:=c2*(x-C2(j)); end;
      y:=a1*c2+a2*c1;
      if (sign(y0)=sign(y)) or (y0=0) then goto SLUT;
      B1(k):=z0*1000; B2(k):=z*1000;
      k:=k+1; SLUT: z0:=z; y0:=y;
end;
if n>k-1 then
begin write(out,nl,5,<:n = :>,<<dd>,n,<:   ANTAL NULPUNKTER: :>,
      <<dd>,k-1); goto F;
end;
i:=1; write(out,<:<12>:>,nl,5,string head(increase(i)),<:

BEREGNEDE  FREKVENSER  FOR
MONOSUBSTITUERET MOLECULE:

:>);
for j:=1 step 1 until n do
write(out,sp,3,<<dd>,j,sp,4,<<dddd.dd>,B1(j),<: - :>,B2(j),nl,1);
write(out,nl,3,<:
               USUBSTITUERET    DISUBSTITUERET
               MOLECULE (A):    MOLECULE (C):

KLASSE 1::>,sp,5);
for j:=1 step 1 until p do
write(out,<<dd>,j,sp,3,<<dddd.dd>,sqrt(A1(j))*1000,sp,10,
sqrt(C1(j))*1000,nl,1,sp,14);
write(out,nl,1,sp,15,<:TAU = :>,<<d.dddd>,tau1,nl,4,<:KLASSE 2::>,
sp,5);
for j:=1 step 1 until q do
write(out,<<dd>,j,sp,3,<<dddd.dd>,sqrt(A2(j))*1000,sp,10,
sqrt(C2(j))*1000,nl,1,sp,14); write(out,nl,1,sp,15,<:TAU = :>,
<<d.dddd>,tau2,nl,5,<:<12>:>);
end; F: end;
▶EOF◀