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

58 lines
1.7 KiB
Fortran

subroutine densit(rho,idens)
C ============================
C
C determining the state parameters for the opacity grid
C calculations
C
INCLUDE 'PARAMS.FOR'
INCLUDE 'MODELP.FOR'
DIMENSION ES(MLEVEL,MLEVEL),BS(MLEVEL),POPLTE(MLEVEL)
c
id=1
dm(id)=0.
IF(IFMOL.EQ.0.OR.TEMP(ID).GT.TMOLIM)
* WMM(ID)=WMY(ID)*HMASS/YTOT(ID)
if(idens.eq.0) then
ELEC(ID)=rho
ane=elec(id)
call todens(id,temp(id),an,ane)
DENS(ID)=(an-ane)*wmm(id)
p=an*bolk*temp(id)
c WRITE(6,602) ID,TEMP(ID),DENS(ID),ELEC(ID)
else if(idens.lt.0) then
AN=rho/TEMP(ID)/BOLK
CALL ELDENS(ID,TEMP(ID),AN,ANE)
ELEC(ID)=ANE
DENS(ID)=WMM(ID)*(AN-ELEC(ID))
c WRITE(6,601) ID,TEMP(ID),DENS(ID),ELEC(ID),ane0,an
else if(idens.eq.1) then
DENS(ID)=RHO
CALL RHONEN(ID,TEMP(ID),RHO,AN,ANE)
ELEC(ID)=ANE
DENS(ID)=RHO
rho0=WMM(ID)*(AN-ANE)
c WRITE(6,601) IDens,TEMP(ID),DENS(ID),ane,rho0,an
else if(idens.eq.2) then
CALL RHONEN(ID,TEMP(ID),RHO,AN,ANE)
DENS(ID)=RHO
ANE=ELEC(ID)
rho0=WMM(ID)*(AN-ANE)
c WRITE(6,601) idens,TEMP(ID),DENS(ID),ane,rho0,an
end if
c 601 FORMAT(' **densit** t,rho,ne,rho0,an',I3,0PF10.1,1P5D11.3)
c 602 FORMAT(' **densit** t,rho,ne',I3,0PF10.1,1P5D11.3)
CALL INIMOD
c
CALL WNSTOR(ID)
CALL SABOLF(ID)
CALL RATMAT(ID,ES,BS)
CALL LEVSOL(ES,BS,POPLTE,NLEVEL)
DO J=1,NLEVEL
POPUL(J,ID)=POPLTE(J)
END DO
c
return
end