74 lines
2.0 KiB
Fortran
74 lines
2.0 KiB
Fortran
subroutine prnt
|
|
c
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
dimension ipop(4)
|
|
c
|
|
data ipop /98,99,100,115/
|
|
c
|
|
do id=1,nd,69
|
|
hkt=hk/temp(id)
|
|
ane=elec(id)
|
|
call sabolf(id)
|
|
c do k=1,4
|
|
do k=3,3
|
|
ii=ipop(k)-3
|
|
iat=iatm(ii)
|
|
ie=iel(ii)
|
|
psum=0.
|
|
psuu=0.
|
|
do j=n0a(iat),nka(iat)
|
|
psum=psum+popul(j,id)
|
|
if(ilk(j).gt.0)
|
|
* psuu=psuu+usum(ilk(j))*elec(id)*popul(j,id)
|
|
end do
|
|
BB=DENS(ID)/WMM(ID)/YTOT(ID)*ABUND(IAT,ID)
|
|
rin=0.
|
|
rou=0.
|
|
c write(63,601) id,ii,psum,bb,popul(ii,id)
|
|
do jj=nfirst(ie),ii-1
|
|
itr=itra(jj,ii)
|
|
ru=rru(itr,id)*wop(ii,id)
|
|
cu=colrat(itr,id)*wop(ii,id)
|
|
if(ii.le.nlast(ie)) then
|
|
rd=rrd(itr,id)*g(jj)/g(ii)*exp(hkt*fr0(itr))*wop(jj,id)
|
|
else
|
|
rd=rrd(itr,id)*sbf(jj)*ane*wop(jj,id)
|
|
end if
|
|
cd=coltar(itr,id)*wop(jj,id)
|
|
c write(63,602) jj,itr,popul(jj,id),ru,cu,rd,cd
|
|
rin=rin+(ru+cu)*popul(jj,id)
|
|
rou=rou+(rd+cd)*popul(ii,id)
|
|
end do
|
|
c
|
|
do jj=ii+1,nnext(ie)
|
|
itr=itra(ii,jj)
|
|
ru=rru(itr,id)*wop(jj,id)
|
|
cu=colrat(itr,id)*wop(jj,id)
|
|
if(jj.le.nlast(ie)) then
|
|
rd=rrd(itr,id)*g(ii)/g(jj)*exp(hkt*fr0(itr))*wop(ii,id)
|
|
else
|
|
rd=rrd(itr,id)*sbf(ii)*ane*wop(ii,id)
|
|
end if
|
|
cd=coltar(itr,id)*wop(ii,id)
|
|
c write(63,602) jj,itr,popul(jj,id),rd,cd,ru,cu
|
|
rou=rou+(ru+cu)*popul(ii,id)
|
|
rin=rin+(rd+cd)*popul(jj,id)
|
|
end do
|
|
c
|
|
c write(63,603) id,ii,rou,rin,(rou-rin)/rin
|
|
end do
|
|
c write(63,*)
|
|
end do
|
|
c write(63,*) '=============================='
|
|
c write(63,*)
|
|
c
|
|
c 601 format('id,ii',2i4,1p4e12.4)
|
|
c 602 format(' jj ',i4,i5,1p5e12.4)
|
|
c 603 format('iitot',2i4,1p3e12.4/)
|
|
c
|
|
return
|
|
end
|