132 lines
4.5 KiB
Fortran
132 lines
4.5 KiB
Fortran
subroutine fingrd
|
|
c =================
|
|
c
|
|
c storing the complete, interpolated, opacity table
|
|
c
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
real*4 absgrd(mttab,mrtab,mfgrid)
|
|
common/gridp0/tempg(mttab),densg(mttab,mrtab),elecgr(mttab,mrtab),
|
|
* densg0(mttab),temp1,ntemp,ndens,nden(mttab)
|
|
common/gridf0/wlgrid(mfgrid),nfgrid
|
|
common/fintab/absgrd
|
|
common/relabu/relabn(matom),popul0(mlevel,1)
|
|
character*(80) tabname
|
|
common/tabout/tabname,ibingr,idens
|
|
c
|
|
if(ifeos.gt.0) return
|
|
c
|
|
close(53)
|
|
iophmp=iophmi
|
|
if(ielhm.gt.0.and.relabn(1).gt.0.) iophmp=1
|
|
if(ibingr.eq.0) then
|
|
open(53,file=tabname,status='unknown')
|
|
write(53,600)
|
|
do iat=1,92
|
|
write(53,601) typat(iat),abnd(iat),abnd(iat)*relabn(iat)
|
|
end do
|
|
write(53,602) ifmol,tmolim
|
|
write(53,603) iophmp,ioph2p,iophem,iopch,iopoh,ioph2m,
|
|
* ioh2h2,ioh2he,ioh2h1,iohhe
|
|
if(idens.lt.10) then
|
|
ndens=nden(1)
|
|
write(53,611) nfgrid,ntemp,nden(1)
|
|
write(53,612) (log(tempg(i)),i=1,ntemp)
|
|
write(53,613) (log(densg(1,j)),j=1,nden(1))
|
|
write(53,614) ((log(elecgr(i,j)),j=1,nden(1)),i=1,ntemp)
|
|
do k = 1, nfgrid
|
|
write(53,615) k,wlgrid(k),2.997925e18/wlgrid(k)
|
|
do j = 1,ndens
|
|
write(53,616) (absgrd(i,j,k),i=1,ntemp)
|
|
end do
|
|
end do
|
|
else
|
|
write(53,611) nfgrid,ntemp,-nden(1)
|
|
write(53,610) (nden(i),i=1,ntemp)
|
|
write(53,612) (log(tempg(i)),i=1,ntemp)
|
|
write(53,622)
|
|
do i=1,ntemp
|
|
ndens=nden(i)
|
|
write(53,623) (log(densg(i,j)),j=1,ndens)
|
|
end do
|
|
write(53,624)
|
|
do i=1,ntemp
|
|
ndens=nden(i)
|
|
write(53,623) (log(elecgr(i,j)),j=1,ndens)
|
|
end do
|
|
do k = 1,nfgrid
|
|
write(53,615) k,wlgrid(k),2.997925e18/wlgrid(k)
|
|
do i=1,ntemp
|
|
ndens=nden(i)
|
|
write(53,616) (absgrd(i,j,k),j=1,ndens)
|
|
end do
|
|
end do
|
|
end if
|
|
600 format('opacity table with element abundances:'/
|
|
* 'element for EOS for opacities')
|
|
601 format(' ',a4,1p2e12.3)
|
|
602 format(/'molecules - ifmol,tmolim:'/,i4,f10.1)
|
|
603 format('additional opacities'/
|
|
* ' H- H2+ He- CH OH H2- CIA: H2H2 H2He H2H HHe'/
|
|
* 6i4,4x,4i4)
|
|
610 format(30i3)
|
|
611 format(/'number of frequencies, temperatures, densities:'
|
|
* /10x,3i10)
|
|
612 format('log temperatures'/(6F11.6))
|
|
613 format('log densities'/(6F11.6))
|
|
614 format('log electron densities from EOS'/(6f11.6))
|
|
615 format(/' *** frequency # : ',i8,f15.5/1pe20.8)
|
|
616 format((1p6e14.6))
|
|
c 621 format('log temperatures')
|
|
622 format('log densities')
|
|
623 format(6f14.6)
|
|
624 format('log electron densities from EOS')
|
|
end if
|
|
do iat=1,92
|
|
write(63) typat(iat),abnd(iat),abnd(iat)*relabn(iat)
|
|
end do
|
|
write(63) ifmol,tmolim
|
|
write(63) iophmp,ioph2p,iophem,iopch,iopoh,ioph2m,
|
|
* ioh2h2,ioh2he,ioh2h1,iohhe
|
|
|
|
if(idens.lt.10) then
|
|
ndens=nden(1)
|
|
write(63) nfgrid,ntemp,nden(1)
|
|
write(63) (log(tempg(i)),i=1,ntemp)
|
|
write(63) (log(densg(1,j)),j=1,nden(1))
|
|
write(63) ((log(elecgr(i,j)),j=1,nden(1)),i=1,ntemp)
|
|
do k = 1, nfgrid
|
|
write(63) 2.997925e18/wlgrid(k)
|
|
do j = 1,ndens
|
|
write(63) (absgrd(i,j,k),i=1,ntemp)
|
|
end do
|
|
end do
|
|
else
|
|
write(63) nfgrid,ntemp,-nden(1)
|
|
write(63) (nden(i),i=1,ntemp)
|
|
write(63) (log(tempg(i)),i=1,ntemp)
|
|
do i=1,ntemp
|
|
ndens=nden(i)
|
|
write(63) (log(densg(i,j)),j=1,ndens)
|
|
end do
|
|
do i=1,ntemp
|
|
ndens=nden(i)
|
|
write(63) (log(elecgr(i,j)),j=1,ndens)
|
|
end do
|
|
do k = 1,nfgrid
|
|
write(63) 2.997925e18/wlgrid(k)
|
|
do i=1,ntemp
|
|
ndens=nden(i)
|
|
write(63) (absgrd(i,j,k),j=1,ndens)
|
|
if(k.le.100) write(*,*) 'abs(1)',i,ndens,
|
|
* (absgrd(i,j,k),j=1,ndens)
|
|
end do
|
|
end do
|
|
end if
|
|
c end if
|
|
c
|
|
close(63)
|
|
return
|
|
end
|