DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »algcoriolis«

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

TextFile

;gosav
coriolis=set 41
permanent coriolis.17
coriolis=algol index.no
\f





CORIOLIS PERTURBATION
GOS:  6-4-73

begin
comment
   The program calculates second order corrections to rotational
states and frequencies arising from the perturbation operator
                   Ga*Pa + Gb*Pb + Gc*Pc
where the Gg-operators are vibrational operators nondiagonal in
the vibrational quantum numbers.
   Only the matrix elements  <V(lower)!Gg!V(upper)>  connectiong
two vibrational states are taken into account when forming the
perturbation sums. While the three Gg-matrix elements must be gi-
ven in the input, the necessary Pg-matrix elements must be evalua-
ted (approximately) in advance by means of the program ROTCOR. The 
matrix elements are stored on the disc in areas to be characteri-
zed by appropiate names in the input. The approximation is:
     2 * <V(l),R1 ! Pg ! V(u),R2> =
         <V(l),R1 ! Pg ! V(l),R2> + <V(u),R1 ! Pg ! V(u),R2> .
The input requirements are:
   1)  A textstring in < >, max. 72 characters.
   2)  Two textstrings in < >, giving the names of two disc areas
          containing the Pg-matrix elements for upper and lower
          state respectively (as produced by the ROTCOR program).
   3)  The vibrational energy difference, dW(vib) in MHz.
   4)  The three coupling constants, Ga, Gb, Gc (MHz).
   5)  The number of rotational transitions to be analyzed for
          Coriolis coupling effects, N.
   6)  For each of these:
          a) Quantum numbers,  J, K(-1), K(+1) for lower(1) and
             upper(2) rotational state.
          b) Two observed frequencies corresponding to upper
             and lower vibrational state respectively. If a
             transition is unobserved a zero is written.
   The output for each rotational transition and each of the two
vibrational states contains:
   a)  Jacobi corrections to each of the rotational states:
                                             dW(1) , dW(2).
   b)  Correction to the frequency:          d(ny) = dW(2)-dW(1).
   c)  Ordinary perturbation correction to the frequency.
   d)  A coriolis corrected ny(obs):         ny = ny(obs)-d(ny).
   e-h) Partial derivatives of d(ny) with respect to Ga, Gb,Gc
       and dW(vib);
integer i,j,k,ku,kl,t,J,k1,k2,Jm,N;
real delta,a,au,al,b,c,d,e,f,fu,fl;
boolean nl, sp, bu, bl, closeres;
array head(1:12), name(1:2), G(1:3);
zone res, Lu,Ll(128,1,stderror);
readhead(in,head,1);  readhead(in,name,1);  i:= 1;
open(Lu,4,string name(increase(i)),0);
readhead(in,name,1); i:= 1;
open(Ll,4,string name(increase(i)),0);
closeres:= outmedium(res);
read(in,delta,G,N);
sp:= false add 32;  nl:= false add 10; i:= 1;
write(res,<:<12>:>,nl,3,string head(increase(i)), nl,2,
      <<ddd ddd ddd.000>,<:delta: :>,delta,nl,1,<:G: :>,
      G(1),G(2),G(3));
Jm:= 0;
begin
array trans(1:N,1:14);
integer array qtn(1:N,1:4);
for i:=1 step 1 until  N do begin
for j:=1 step 1 until 12 do trans(i,j):= 0;
for j:=1,2 do begin
   read(in,J,k1,k2); if Jm<J then Jm:= J;
   qtn(i, j ):=  J shift 8 add k1 shift 8 add k2;
   qtn(i,j+2):= (J*(J+1)//2)**2
end;
read(in,trans(i,13),trans(i,14))
end;
ku:= kl:= 0; inrec(Ll,128); inrec(Lu,128);
al:= Ll(1); au:= Lu(1);
repeat:
for i:=1 step 1 until N do
for j:=1,2 do begin
   t:= qtn(i,j);
   J:= if t = al shift (-24) extract 24 then 2 else
       if t = al extract 24 then 3 else 0;
   if J<>0 then begin
      k1:= (al shift (-32) extract 8)-(al shift (-8) extract 8);
      k2:= (al shift (-24) extract 8)-(al extract 8);
      bu:= k1 = k1//2*2;  bl:= k2 = k2//2*2;
      t:= if   bu and -,bl then 1 else
          if -,bu and -,bl then 2 else
          if -,bu and   bl then 3 else 0;
      if t=0 then goto stop;
      c:= (Lu(ku+4)+Ll(kl+4))*qtn(i,j+2)*G(t); b:= G(t)*c*0.5;
      e:= Lu(ku+J) - Ll(kl+5-J) + delta;
      f:= Ll(kl+J) - Lu(ku+5-J) - delta;
      trans(i, j ):= trans(i, j )
                     + (b+b)/(sign(e)*sqrt(4*b+e*e)+e);
      trans(i,j+2):= trans(i,j+2)
                     + (b+b)/(sign(f)*sqrt(4*b+f*f)+f);
      if j=1 then begin c:= -c; b:= -b end;
      trans(i,4+t):= trans(i,4+t) + c/e;
      trans(i,7+t):= trans(i,7+t) + c/f;
      trans(i, 11):= trans(i, 11) - b/(e*e);
      trans(i, 12):= trans(i, 12) + b/(f*f)
end end;
ku:= (ku+4) mod 128; kl:= (kl+4) mod 128;
if ku=0 then inrec(Lu,128); if kl=0 then inrec(Ll,128);
au:= Lu(ku+1); al:= Ll(kl+1);
if au<>al then begin
   if au=Ll(kl+5) then begin kl:= kl+4; al:= Ll(kl+1) end else
   if al=Lu(ku+5) then begin ku:= ku+4; au:= Lu(ku+1) end
   else goto stop
end;
J:= al shift (-16) extract 8;
if J>=0 and J<=Jm then goto repeat;
close(Lu,true); close(Ll,true);
write(res,nl,2,<:
     Transition       deltaEu1    deltaEu2    deltaEl1    deltaEl2
                           deltany(u)              deltany(l):>);
for i:=1 step 1 until N do begin
   j:= qtn(i,1); k:= qtn(i,2);
   a:= trans(i,1); b:= trans(i,2); c:= trans(i,3); d:= trans(i,4);
   fu:= trans(i,13)+a-b; fl:= trans(i,14)+c-d;
   e:= f:= 0;  for t:=1,2,3 do begin
      e:= e + trans(i,4+t)*G(t);
      f:= f + trans(i,7+t)*G(t) end;
   e:= e*0.5;  f:= f*0.5;
   write(res,nl,2,<<ddd>,
   j shift(-16) extract 8,j shift(-8) extract 8,j extract 8,sp,1,
   k shift(-16) extract 8,k shift(-8) extract 8,k extract 8,sp,1,
   <<-ddddddd.ddd>,a,b,c,d,nl,1,sp,26,b-a,sp,12,d-c,
   nl,1,sp,26,e,sp,12,f,nl,1,sp,26,fu,sp,12,fl,<<-d.dddddd'-d>,
   nl,1,sp,26,trans(i,5),sp,12,trans(i,8),
   nl,1,sp,26,trans(i,6),sp,12,trans(i,9),
   nl,1,sp,26,trans(i,7),sp,12,trans(i,10),
   nl,1,sp,26,trans(i,11),sp,12,trans(i,12),nl,1)
end;
stop:   write(res,<:<12>:>,<:<25>:>);   close(res,closeres)
end end
▶EOF◀