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

172 lines
5.9 KiB
Fortran

subroutine chctab
c =================
c
c check the consistency of the opacities in the opacity
c table; modify the input paramaters for additional opacities
c if needed
c
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'MODELQ.FOR'
common/abntab/abunt(matom),abuno(matom),tmolit,
* iophmt,ioph2t,iophet,iopcht,iopoht,
* ioh2mt,ih2h2t,ih2het,ioh2ht,iohhet,
* ifmolt
c
character*4 typ
dimension typ(matom)
c
DATA TYP/' H ',' He ',' Li ',' Be ',' B ',' C ',
* ' N ',' O ',' F ',' Ne ',' Na ',' Mg ',
* ' Al ',' Si ',' P ',' S ',' Cl ',' Ar ',
* ' K ',' Ca ',' Sc ',' Ti ',' V ',' Cr ',
* ' Mn ',' Fe ',' Co ',' Ni ',' Cu ',' Zn ',
* ' Ga ',' Ge ',' As ',' Se ',' Br ',' Kr ',
* ' Rb ',' Sr ',' Y ',' Zr ',' Nb ',' Mo ',
* ' Tc ',' Ru ',' Rh ',' Pd ',' Ag ',' Cd ',
* ' In ',' Sn ',' Sb ',' Te ',' I ',' Xe ',
* ' Cs ',' Ba ',' La ',' Ce ',' Pr ',' Nd ',
* ' Pm ',' Sm ',' Eu ',' Gd ',' Tb ',' Dy ',
* ' Ho ',' Er ',' Tm ',' Yb ',' Lu ',' Hf ',
* ' Ta ',' W ',' Re ',' Os ',' Ir ',' Pt ',
* ' Au ',' Hg ',' Tl ',' Pb ',' Bi ',' Po ',
* ' At ',' Rn ',' Fr ',' Ra ',' Ac ',' Th ',
* ' Pa ',' U ',' Np ',' Pu ',' Am ',' Cm ',
* ' Bk ',' Cf ',' Es '/
c
write(6,600)
do ia=1,matom
write(6,601) typ(ia),abndd(ia,1),abunt(ia),abuno(ia)
end do
600 format(
* ' chemical abundances:'//
* 7x,' HERE OP.TAB.EOS OP.TAB.OPACITIES')
601 format(2x,a4,1p3e12.3)
603 format(/' treatment of molecules: IFMOL here: ',i4/
* ' op.tab:',i4/
* ' TMOLIM here: ',f10.1/
* ' op.tab:',f10.1)
c
write(6,603) ifmol,ifmolt,tmolim,tmolit
if(ifmol.ne.ifmolt) then
if(keepop.eq.0) then
ifmol=ifmolt
tmolim=tmolit
write(6,*)
* ' IFMOL and TMILIM changed to the values of op.table'
else
write(6,*) ' but IFMOL and TMOLIM retained here'
end if
end if
c
write(6,604)
604 format(/' additional opacities'/)
if(iophmt.gt.0.and.(iophmi.gt.0.or.ielhm.gt.0)) then
write(6,*) 'H- opacity included in the op.table and here'
if(keepop.eq.0) then
iophmi=0
write(6,*) ' so removed here (IOPHMI=0)'
if(ielhm.gt.0)
* write(6,*) ' but H- is explicit here, needs to be changed!!'
* '
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
if(iophmi.gt.0.or.ielhm.gt.0) write(6,*)
* 'H- opacity included here'
c
if(ioph2t.gt.0.and.ioph2p.gt.0) then
write(6,*) 'H2+ opacity included in the op.table and here'
if(keepop.eq.0) then
ioph2p=0
write(6,*) ' so removed here (IOPH2P=0)'
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
if(ioph2p.gt.0) write(6,*) 'H2+ opacity included here'
c
if(iophet.gt.0.and.iophem.gt.0) then
write(6,*) 'He- opacity included in the op.table and here'
if(keepop.eq.0) then
iophem=0
write(6,*) ' so removed here (IOPHEM=0)'
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
c
if(iopcht.gt.0.and.iopch.gt.0) then
write(6,*) 'CH opacity included in the op.table and here'
if(keepop.eq.0) then
iopch=0
write(6,*) ' so removed here (IOPCH=0)'
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
c
if(iopoht.gt.0.and.iopoh.gt.0) then
write(6,*) 'OH opacity included in the op.table and here'
if(keepop.eq.0) then
iopoh=0
write(6,*) ' so removed here (IOPOH=0)'
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
c
if(ioh2mt.gt.0.and.ioph2m.gt.0) then
write(6,*) 'H2- opacity included in the op.table and here'
if(keepop.eq.0) then
ioph2m=0
write(6,*) ' so removed here (IOPH2M=0)'
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
c
if(ih2h2t.gt.0.and.ioh2h2.gt.0) then
write(6,*) 'CIA H2-H2 opacity included in the op.table and here'
if(keepop.eq.0) then
ioh2h2=0
write(6,*) ' so removed here (IOH2H2=0)'
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
c
if(ih2het.gt.0.and.ioh2he.gt.0) then
write(6,*) 'CIA H2-He opacity included in the op.table and here'
if(keepop.eq.0) then
ioh2he=0
write(6,*) ' so removed here (IOH2HE=0)'
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
c
if(ioh2ht.gt.0.and.ioh2h.gt.0) then
write(6,*) 'CIA H2-H opacity included in the op.table and here'
if(keepop.eq.0) then
ioh2h=0
write(6,*) ' so removed here (IOH2H=0)'
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
c
if(iohhet.gt.0.and.iohhe.gt.0) then
write(6,*) 'CIA H2-H2 opacity included in the op.table and here'
if(keepop.eq.0) then
iohhe=0
write(6,*) ' so removed here (IOHHE=0)'
else
write(6,*) ' but retained here, so it is taken twice!'
end if
end if
c
return
end