SpectraRust/tlusty/extracted/rechck.f
2026-03-19 14:05:33 +08:00

36 lines
852 B
Fortran

subroutine rechck
c =================
c
c check of radiative equilibrium - integral version
c
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'ATOMIC.FOR'
INCLUDE 'MODELQ.FOR'
dimension abt(mdepth),emt(mdepth)
c
do id=1,nd
abt(id)=0.
emt(id)=0.
end do
c
do ij=1,nfreq
call opacf1(ij)
call rtefr1(ij)
do id=1,nd
abt(id)=abt(id)+(abso1(id)-scat1(id))*rad1(id)*w(ij)
emt(id)=emt(id)+emis1(id)*w(ij)
end do
end do
c
write(17,600)
600 format(/' id dm T int(kappa*J) int(emis) rel'/)
do id=1,nd
re=(abt(id)-emt(id))/emt(id)
write(17,601) id,dm(id),temp(id),abt(id),emt(id),re
end do
601 format(i4,1pe11.3,0pf10.1,2x,1p3e13.5)
c
return
end