121 lines
3.5 KiB
Fortran
121 lines
3.5 KiB
Fortran
subroutine rdatax(itr,ic,iunit)
|
|
c ===============================
|
|
c
|
|
c for itr, itrx ne 0 - read input data for an individual transition
|
|
c and prepare necessary auxiliary arrays
|
|
c
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
c
|
|
parameter (mtrx=1000)
|
|
dimension iex(mtrx),itrind(mtrx),izx0(mtrx),izx1(mtrx),
|
|
* nmaxx(mtrx),izx(mtrx),nshx(mtrx),nax(mtrx),icx(mtrx),
|
|
* etx(mtrx),ssx(mtrx),dx(mtrx),
|
|
* aphx(11,5,mtrx),bphx(5,mtrx),a(11,5),b(5)
|
|
c
|
|
if(itr.gt.0) then
|
|
itrx=itrx+1
|
|
ntrx=itrx
|
|
ii=ilow(itr)
|
|
ie=iel(ii)
|
|
jj=iup(itr)
|
|
iex(itrx)=ie
|
|
icx(itrx)=ic
|
|
itrind(itrx)=itr
|
|
izx0(itrx)=iz(ie)
|
|
izx1(itrx)=jj-1000
|
|
c
|
|
c read inner-shell photoionization data from Omer's tables
|
|
c
|
|
read(iunit,*) etx(itrx)
|
|
read(iunit,*) nmaxx(itrx),izx(itrx),nshx(itrx)
|
|
read(iunit,*) ssx(itrx)
|
|
read(iunit,*) nax(itrx)
|
|
read(iunit,*) dx(itrx)
|
|
do i=1,nax(itrx)
|
|
read(iunit,*) bphx(i,itrx)
|
|
end do
|
|
do j=1,nax(itrx)
|
|
do i=1,11
|
|
read(iunit,*) aphx(i,j,itrx)
|
|
end do
|
|
end do
|
|
else if(itr.eq.0) then
|
|
c
|
|
c for itr=0 - set up array BFCS with actual cross-sections
|
|
c
|
|
if(ntrx.gt.0) then
|
|
do itx=1,ntrx
|
|
ie=iex(itx)
|
|
it=itrind(itx)
|
|
ii=ilow(it)
|
|
ia=iatm(ii)
|
|
iz1=izx1(itx)
|
|
ic=icx(itx)
|
|
jj=0
|
|
do i=1,nlevel
|
|
if(iatm(i).eq.ia) then
|
|
if(iz(iel(i)).eq.iz1) then
|
|
jj=i
|
|
go to 10
|
|
end if
|
|
end if
|
|
end do
|
|
10 continue
|
|
if(jj.eq.0) then
|
|
if(iz1.eq.iz(iel(nka(ia)-1))+1) jj=nka(ia)
|
|
end if
|
|
if(jj.eq.0) indexp(it)=0
|
|
c
|
|
if(indexp(it).ne.0) then
|
|
iup(it)=jj
|
|
fr0(it)=etx(itx)/4.1357e-15
|
|
line(it)=.false.
|
|
itrcon(it)=ic
|
|
if(icol(it).ne.99) then
|
|
itra(ii,jj)=it
|
|
itra(jj,ii)=ic
|
|
end if
|
|
c
|
|
write(6,601) itx,it,ii,jj,ia,
|
|
* itra(ii,jj),itra(jj,ii),
|
|
* icol(it),fr0(it),etx(itx)
|
|
601 format(8i4,1pe12.4,0pf10.2)
|
|
end if
|
|
end do
|
|
end if
|
|
c
|
|
else
|
|
nfreqb=nfreq
|
|
if(ibfint.gt.0) nfreqb=nfreqc
|
|
if(ntrx.gt.0) then
|
|
do itx=1,ntrx
|
|
it=itrind(itx)
|
|
ic=icx(itx)
|
|
if(indexp(it).ne.0) then
|
|
na=nax(itx)
|
|
do i=1,na
|
|
b(i)=bphx(i,itx)
|
|
end do
|
|
do j=1,na
|
|
do i=1,11
|
|
a(i,j)=aphx(i,j,itx)
|
|
end do
|
|
end do
|
|
c
|
|
do ij=1,nfreqb
|
|
call bkhsgo(freq(ij),etx(itx),dx(itx),b,na,a,
|
|
* ssx(itx),nmaxx(itx),izx(itx),nshx(itx),sg)
|
|
bfcs(ic,ij)=real(sg)
|
|
end do
|
|
write(97,681) it,ic,ilow(it),iup(it),bfcs(ic,1)
|
|
681 format(4i5,1p1e15.5)
|
|
end if
|
|
end do
|
|
end if
|
|
end if
|
|
return
|
|
end
|