⟦249a258d9⟧

TextFile

;gosav lines.10000 time.180
goout=set 200
permanent goout.15
o goout
clear rotcpl
cpltxt=set 50
cpltxt=edit algrotfit
g5/rotfit/rotcpl/,g/.no/.yes/,r/yes)/no)/
l-2,r/95/120/,l3,r/CON/AND COUPLING CON/,r/3-3-1975/21-5-1980/
l./Rot/,r/D,/Gcp(4:9), D,/,l15,r/Rot/Rot,Gcp/
l7,r/FIT of 3-3-1975/CPL of 21-5-1980/,l6,r/8/14/,r/15/21/
l6,r/8/14/,r/15/21/,l8,r/7/13/,r/8/14/,l7,r/8/14/
l./oblat:=/,r/;/ == N>=0; N:= abs N;/
l./DR(/,r/3/10/,l4,r/4/10/,l./.dddd>/,d,i/
   end else if l<10 then begin
   so:=Gcp(l); write(res,<:G:>,case l-3 of
   (<:a:>,<:b:>,<:c:>,<:bc:>,<:ca:>,<:ab:>),<: = :>)
/,l3,r/, if/)
/,d1,r/d/d;
   j:=3; k:=0; write(res,string format(j,k,so,s),so)/
l./DR(i)<>0/,r/4/10/,l3,r/r1/Cx1,Cy1,Cz1,Cx2,Cy2,Cz2,
     r1/,l2,r/;/,hc;/,l./DR(i+3)/,g1/i+3/i+9/,l9,g5/j+3/j+9/
l-4,g28/DR(4)/DR(10)/,l-28,g29/DR(5)/DR(11)/,l-29
g32/DR(6)/DR(12)/,l-32,g32/DR(7)/DR(13)/,l-32,g32/DR(8)/DR(14)/
l./if i>3/,r/3/9/,l./if quartic/,i/
   write(res,<:

Coupling constants (MHz):
  :>); j:=j+5; for k:=6,9 do begin
   for i:=k-2 step 1 until k do begin y:=Gcp(i);
   write(res,string format(lw(i),exp(i),y,lo(i)),y) end;
   if ha then begin write(res,<:
+-:>); for i:=k-2 step 1 until k do begin
   j:=j+1; y:=sqrt(col(i,i)*s);
   if y=0 then write(res,sp,lw(i)-5,<:fixed:>)
          else write(res,string lo(i),y) end end;
   if k=6 then write(res,nl,2,sp,2) end;
/,g8/for i:=4/for i:=10/,l./Q+1;/,i/
Cx1:= Gcp(xx+3); Cy1:= Gcp(yy+3); Cz1:= Gcp(zz+3);
Cx2:= Gcp(xx+6); Cy2:= Gcp(yy+6); Cz2:= Gcp(zz+6);
/,l4,r/norm,//,l./k:=-1,1/,i/
j0:= if J1>J2 then J1 else J2;
begin
integer Nt,i0,i1,i2;
array e(1:j0+j0+1,-5:8),Py,Py2(1:j0);
/,l3,r/2+1/2+1; hc:= true/,l2,r/2+1/2+1; hc:= J1<>J2/
l5,r/;/; Nt:= j0+j0+1;
/,d,i/

if j0>0 then begin
array Pdif,S(1:N),a,b(1:Nt),PG(1:21),PS(1:6);

if hc then begin
/,l6,d1,r/./. They are stored
   according to (with i<j)
             reel  part:  H(i,j) = e(j,j-i),
             imag. part:  H(i,j) = e(j,i-j).
/,d1,l3,d./alfa(2)/,i?
for i:=1 step 1 until Nt do
for j:=-5 step 1 until 8 do e(i,j):= 0;
Py(1):= sqrt(JJ*2); Py2(1):= 0;
for j:=j0-1 step -1 until 1 do Py(j+1):= sqrt((j0-j)*(j0+j+1));
for j:=j0 step -1 until 2 do Py2(j):= Py(j)*Py(j-1);
e(1,0):= F;
for j:=j0 step -1 until 1 do begin
  i1:= j+j; i2:= i1+1; K2:= j*j; Pz4:= K2; Pz4:= Pz4*K2;
  e(i1,0):= e(i2,0):= ((G2*K2+G1)*K2+G)*K2+F;
  e(i2,1):= Cz1*j; p:= Py(j)/2;
  if j>1 then begin
    e(i1,1) := e(i2,3) := Cx2*i2*p;
    e(i1,2) := e(i2,2) := Cy1*p;
    e(i1,-1):= e(i2,-3):= Cx1*p;
    e(i1,-2):= e(i2,-2):= Cy2*i2*p;
    y:= H2*Pz4+H1*K2+H; p:= Py2(j);
    if j>2 then begin
      e(i1,-3):= e(i2,-5):= Cz2*p/2;
      K2:= (j-2)**2; Pz4:= K2; Pz4:= Pz4*K2;
      e(i1,4) := e(i2,4) := -(H2*Pz4+H1*K2+y)*p;
      p:= -DW*p*Py2(j-2);
      if j>4 then e(i1,8):= e(i2,8):= p else
      if j=4 then e(i1,7):= p else
      if j=3 then begin
        y:= e(i1,4); p:= DW*JJ*Py2(j);
        e(i1,4):= y-p; e(i2,4):= y+p;
    end end else begin
      e(i1,3):= -y*p; e(i2,-4):= Cz2*p/2;
      y:= e(i1,0); p:= (JJ-2)*JJ*DW;
      e(i1,0):= y-p; e(i2,0):= y+p
  end end else begin
    e(i1,1):= Cy1*p; e(i1,-1):= Cy2*p;
    e(i2,2):= Cx2*p; e(i1,-2):= Cx1*p;
    y:= e(i1,0); p:= (H+(H1+H2)*2)*JJ;
    e(i1,0):= y-p; e(i2,0):= y+p;
end end end hc;
j:= i1:= case matr of (4,5,2,3);
i2:= if matr=1 then 2 else 1;
if N>2 and DW<>0 then begin
  comment The pentadiagonal matrix of the uncoupled
    state is reduced to tridiagonal form by succesive
    Jacobi rotations, Swartz: Numer. Math. 12, 231 (1968),
    modified by replacing a(i,j) and b by v(i+j,j) and p;
  integer k;
  real c,s,c2,s2,cs,u,u1;
  array v(1:N,0:2);
  for i:=i2 step 1 until N do begin
    for k:=0,1,2 do v(i,k):=e(j,k*4);
    j:=j+4
  end;
  if matr =1 then begin
    v(1,0):= e(1,0); v(1,1):= v(1,2):= 0;
    if N>1 then v(2,1):= e(4,3);
    if N>2 then v(3,2):= e(8,7);
  end;
  comment v(1,1):=v(1,2):=v(2,2):=0;
  for k:=1 step 1 until N-2 do begin
    for j:=k+2 step 2 until N do begin
      if j=k+2 then begin
        if v(k+2,2)=0 then goto endk;
        p:=-v(k+1,1)/v(k+2,2);
      end else begin
        if G=0 then goto endk;
        p:=-v(j-1,2)/G;
      end;
      s2:=1/(p*p+1); s:=sqrt(s2); c:=p*s;
      c2:=c*c; cs:=c*s;
      u:=c2*v(j-1,0)-2*cs*v(j,1)+s2*v(j,0);
      u1:=s2*v(j-1,0)+2*cs*v(j,1)+c2*v(j,0);
      v(j,1):=cs*(v(j-1,0)-v(j,0))+(c2-s2)*v(j,1);
      v(j-1,0):=u; v(j,0):=u1;
      u:=c*v(j-1,1)-s*v(j,2);
      v(j,2):=s*v(j-1,1)+c*v(j,2);
      v(j-1,1):=u;
      if j<>k+2 then 
        v(j-1,2):=c*v(j-1,2)-s*G;
      if j<N then begin
        u:=c*v(j+1,2)-s*v(j+1,1);
        v(j+1,1):=s*v(j+1,2)+c*v(j+1,1);
        v(j+1,2):=u
      end;
      if j+2<=N then begin
        G:=-s*v(j+2,2);
        v(j+2,2):=c*v(j+2,2)
    end end j;
endk: end k;
  for i:=1 step 1 until N do begin
    a(i):=v(i,0); b(i):=v(i,1) end
end else begin
  for i:=i2 step 1 until N do begin
    a(i):= e(j,0);
    b(i):= e(j,4);
    j:= j+4;
  end;
  if matr=1 then begin
    a(1):= e(1,0); b(1):= 0;
    if N>1 then b(2):= e(4,3);
end end;
for i:=2 step 1 until N do Pdif(i):= -Py2(k0+i+i);
Pdif(1):= (case matr of (0,0,-1,1))*JJ//2;
k0:=k0+N+N; K2:= k0*k0;
?,l./sqrt/,g1/sqrt(beta/abs b/,l-1,g1/) else/ else/
l2,g/alfa/a/,l1,i/
for i:=2 step 1 until N do b(i):= b(i)*b(i);
/,l4,r/alfa/a/,r/beta/b/,l7,d./N:= N+1;/,i?

      begin
        integer k;
        array d(-8:7),u(1:Nt-1,1:8);
        k:= if matr>1 then i1-4 else if j=1 then -3 else -4;
        i0:= k+j*4; G:=e(i0,0);
        for i:=1 step 1 until 8 do begin
          d(-i):= if i0-i>0 then e(i0,i) else 0;
          d(i-1):= if i0+i<=Nt then e(i0+i,i) else 0
        end i;
        it:=0; Nt:=Nt-1; y:=lambda;

repeat:
        for i:=Nt step -1 until 1 do b(i):=0;
        for i:=-8 step 1 until 7 do
        if d(i)<>0 then b(i0+i):=-d(i);
        for i:=Nt step -1 until 1 do begin
          for j:=0,j+1 while i-j>0 and j<=8 do begin
            p:= if i<i0 then e(i,j) else
                if j-1<i-i0 then e(i+1,j) else
                if j<8 then e(i+1,j+1) else 0;
            k:= i;
            for k:=k+1 while k<=Nt and k-i+j<=8 do
            p:=p-a(k)*u(k,k-i)*u(k,k-i+j);
            if j=0 then a(i):=p-lambda
                   else u(i,j):=p/a(i)
          end j;
          p:=b(i); k:=i;
          for k:=k+1 while k<=Nt and k-i<=8 do
          p:=p-u(k,k-i)*b(k);
          b(i):=p
        end i;
        qd:=1;
        for i:=1 step 1 until Nt do begin
          p:=if b(i)=0 then 0 else b(i)/a(i); k:=i;
          for k:=k-1 while k>0 and i-k<=8 do
          p:=p-u(i,i-k)*b(k);
          b(i):=p; qd:=qd+p*p
        end i;

        if Nt>0 then begin
          H:=G-lambda;
          for i:=-8 step 1 until 7 do
          if d(i)<>0 then H:= H+d(i)*b(i0+i);
          H:=H/qd;
          if it<2 or (abs H<abs y and lambda+H<>lambda) then begin
            lambda:=lambda+H; it:=it+1; y:=H; goto repeat
          end
        end;
        qd:= 1/sqrt(qd);
        for i:=Nt step -1 until i0 do b(i+1):=b(i)*qd;
        for i:=i0-1 step -1 until 1 do b(i):=b(i)*qd;
        b(i0):=qd; Nt:=Nt+1
      end;
for i:=i2 step 1 until N do begin
  S(i):= b(i1); i1:= i1+4 end;
if matr=1 then S(1):= b(1);
?,l./norm/,g3/)*norm//,l-3,g3/(//,l1,r/:= Pz*norm//,l3,d,i/
for i:=4 step 1 until 9 do PG(i):= 0;
if j0<6 and -,ha then begin
  writecr; if k=-1 then writecr;
  for i:=1 step 1 until Nt do begin
  write(res,<<   -d.dddddddd'-d>,b(i));
  if i mod 4 = 0 then writecr end;
  write(res,<<    dd>,it); writecr;
  write(res,<<   -d.dddddddd'-d>,lambda,Pz,Pz4,Pz6,nl,1,
        Pxy,Pzxy,Pxyxy,Pzzd); linecount:= linecount+1;
  writecr
end;
/,l./PG(4)/,g15/*norm//,l-15,g25/PG(4/PG(10/,l-25,g26/PG(5/PG(11/,l-25
g26/PG(6/PG(12/,l-26,g27/PG(7/PG(13/,l-26,g27/PG(8/PG(14/
l1,r/8/14/,r/4/10/,l-28,r/12/18/,l1,r/15/21/,l1,r/7,8/13,14/
l1,r/4,5,6/10,11,12/,l7,r/9/15/,r/10/16/
l1,r/11/17/,r/12/18/,l1,r/13/19/,r/14/20/,l1,r/15/21/
l./end k;/,r/;/ end e;/,l./for j:=4/,r/4/10/,l17,r/-1/5/
l./if k>3/,r/3/9/,l./DR(i)-AO/,r/4/10/
f
i cpltxt
o c
edit goout
l b,l-21,p20,f
;gosav time.300
rotcpl
<15-N 2H-triazole, 26-1-76.>
8003 4
9320.226100 9266.540991 4645.1344
-62
0 0 0 0 0 0
-9.6719 -0.00638 -3.273080 -2
4 5 6 7 8 9 13 14
9 8 2 9 8 1 1 12752.99
8 7 2 8 7 1 1 12988.59
34 32 3 34 32 2 1 13421.52
5 4 2 5 4 1 1 13543.85
33 31 3 33 31 2 1 14095.37
4 2 2 4 4 1 1 14220.69
5 3 2 5 5 1 1 14364.88
6 4 2 6 6 1 1 14543.33
7 5 2 7 7 1 1 14758.96
32 30 3 32 30 2 1 14760.65
10 8 2 10 10 1 1 15663.32
30 28 3 30 28 2 1 16054.21
12 10 2 12 12 1 1 16520.59
28 26 3 28 26 2 1 17280.40
49 46 4 49 46 3 1 17603.52
14 12 2 14 14 1 1 17620.62
26 24 3 26 24 2 1 18419.16
25 23 3 25 23 2 1 18949.995
16 14 2 16 16 1 1 18995.04
47 44 4 47 44 3 1 19325.83
24 22 3 24 22 2 1 19452.37
23 21 3 23 21 2 1 19924.37
22 20 3 22 20 2 1 20364.41
18 16 2 18 18 1 1 20669.43
45 42 4 45 42 3 1 21013.37
20 18 3 20 18 2 1 21143.53
19 17 3 19 17 2 1 21480.94
18 16 3 18 16 2 1 21783.22
17 15 3 17 15 2 1 22050.685
16 14 3 16 14 2 1 22284.15
15 13 3 15 13 2 1 22484.99
43 40 4 43 40 3 1 22640.27
14 12 3 14 12 2 1 22654.95
20 18 2 20 20 1 1 22660.43
13 11 3 13 11 2 1 22796.30
12 10 3 12 10 2 1 22911.62
11 9 3 11 9 2 1 23003.67
10 8 3 10 8 2 1 23075.34
1 1 1 2 1 2 1 23201.91
6 3 3 6 5 2 1 23249.32
1 0 1 2 0 2 1 23255.135
7 4 3 7 6 2 1 23256.62
8 5 3 8 7 2 1 23267.78
9 6 3 9 8 2 1 23283.98
10 7 3 10 9 2 1 23306.61
11 8 3 11 10 2 1 23337.20
12 9 3 12 11 2 1 23377.47
13 10 3 13 12 2 1 23429.37
14 11 3 14 13 2 1 23495.08
15 12 3 15 14 2 1 23576.98
17 14 3 17 16 2 1 23800.11
18 15 3 18 17 2 1 23947.34
19 16 3 19 18 2 1 24122.79
41 38 4 41 38 3 1 24181.85
20 17 3 20 19 2 1 24330.01
21 18 3 21 20 2 1 24572.93
22 19 3 22 21 2 1 24855.55
22 20 2 22 22 1 1 24974.62
23 20 3 23 22 2 1 25182.17
24 21 3 24 23 2 1 25557.15
25 22 3 25 24 2 1 25984.89
26 23 3 26 25 2 1 26469.85
 21 20  2 21 20  1 1    33
 20 19  2 20 19  1 1    22
 19 18  2 19 18  1 1    39
 18 17  2 18 17  1 1    25
 17 16  2 17 16  1 1    44
-1
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦249a258d9⟧ TextFile

Derivation

TextFile
