165 lines
4.7 KiB
Fortran
165 lines
4.7 KiB
Fortran
SUBROUTINE TEMPER(ID,TAUF,ITGR)
|
|
C ===============================
|
|
C
|
|
C Auxiliary procedure for LTEGR
|
|
C Evaluation of temperature, electron density, Rosseland opacity
|
|
C and Planck mean opacity for at a given depth point
|
|
C
|
|
C Input parameters:
|
|
C ID - depth index
|
|
C TAUF - Rosseland optical depth (if ITGR = -1, 0 or 1
|
|
C - flux mean opacity (if ITGR > 1)
|
|
C ITGR = -1, 0, 1 - means that TEMPER is called in the first
|
|
C iteration of the pseudo-grey model;
|
|
C temperature is evaluated;
|
|
C > 1 - next iterations; temperature is given,
|
|
C only evaluation of electron density and
|
|
C populations
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ALIPAR.FOR'
|
|
COMMON/PRSAUX/VSND2(MDEPTH),HG1,HR1,RR1
|
|
COMMON/FLXAUX/T4,PGAS,PRAD,PGM,PRADM,ITGMAX,ITGMX0
|
|
COMMON/FACTRS/GAMJ(MDEPTH),GAMH,FAK0
|
|
PARAMETER (ERRT=1.D-3)
|
|
C
|
|
IT=0
|
|
IF(ITGR.GT.1.AND.ITGMAX.GT.0) THEN
|
|
T=TEMP(ID)
|
|
GO TO 10
|
|
END IF
|
|
C
|
|
IF(ID.EQ.1) THEN
|
|
DDM=HALF*DM(ID)
|
|
ELSE
|
|
DDM=DM(ID)-DM(ID-1)
|
|
END IF
|
|
C
|
|
C
|
|
C Initial estimate of temperature for current values of Rosseland
|
|
C and Planck mean opacities
|
|
C
|
|
call tlocal(id,tauf,t)
|
|
C
|
|
C ********** Iteration loop for determining temperature at depth ID
|
|
C for a given total pressure
|
|
C
|
|
10 IT=IT+1
|
|
TEMP(ID)=T
|
|
C
|
|
C Estimate of the gas pressure
|
|
C
|
|
PRAD=1.8912D-15*T4*(GAMH*5.7735D-1+TAUF-TAUTHE(ID))
|
|
PTURB=HALF*DENS(ID)*VTURB(ID)*VTURB(ID)
|
|
PGAS=PGS(ID)
|
|
PTOT=PGAS+PRAD+PTURB
|
|
PTOTAL(ID)=PTOT
|
|
PRADT(ID)=PRAD
|
|
IF(PGAS.LE.0.) WRITE(6,603) ID,IT,PGAS,PTOT,PTURB,PRAD
|
|
603 format(' negative gas pressure!! id,it,pgas,p,pturb,prad =',
|
|
* 2i3,1p4d9.2)
|
|
C
|
|
C Determination of electron density from the known temperature
|
|
C and total pressure
|
|
C
|
|
if(ioptab.ge.-1) then
|
|
AN=PGAS/T/BOLK
|
|
CALL ELDENS(ID,T,AN,ANE,ENRG,ENTT,WM,1)
|
|
ELEC(ID)=ANE
|
|
DENS(ID)=WMM(ID)*(AN-ANE)
|
|
PHMOL(ID)=AHMOL
|
|
VSND2(ID)=PTOTAL(ID)/DENS(ID)
|
|
if(ioptab.ge.0) then
|
|
CALL WNSTOR(ID)
|
|
CALL STEQEQ(ID,POP,1)
|
|
end if
|
|
end if
|
|
c IF(IT.GT.1.AND.REL.LT.ERRT) GO TO 30
|
|
C
|
|
C For itgr.gt.1 - only new electron density and populations
|
|
C
|
|
IF(ITGR.GT.1) RETURN
|
|
C
|
|
C Evaluation of the Rosseland and Planck mean opacities
|
|
C for the new values of temperature, electron density, and
|
|
C populations (OPROS - Rosseland opacity per 1 cm**3; OPPLA - Planck
|
|
C mean opacity per 1 cm**3)
|
|
C
|
|
if(ioptab.ge.0) then
|
|
CALL OPACF0(ID,NFREQ)
|
|
CALL MEANOP(T,ABSO,SCAT,OPROS,OPPLA)
|
|
ABROS=OPROS/DENS(ID)
|
|
ABPLA=OPPLA/DENS(ID)
|
|
if(abpla.lt.abpmin) abpla=abpmin
|
|
ABFLX=ABROS
|
|
ABPLAD(ID)=ABPLA
|
|
ABROSD(ID)=ABROS
|
|
else if(ioptab.eq.-1) then
|
|
rho=dens(id)
|
|
call meanopt(t,id,rho,opros,oppla)
|
|
abrosd(id)=opros
|
|
abplad(id)=oppla
|
|
abros=opros
|
|
abpla=oppla
|
|
else
|
|
temp(id)=t
|
|
rho=rhoeos(t,p)
|
|
dens(id)=rho
|
|
call meanopt(t,id,rho,opros,oppla)
|
|
abrosd(id)=opros
|
|
abplad(id)=oppla
|
|
abros=opros
|
|
abpla=oppla
|
|
end if
|
|
c
|
|
IF(IT.GT.1.AND.REL.LT.ERRT) GO TO 30
|
|
C
|
|
C New values of the Rosseland opacity and function tauthe
|
|
C
|
|
IF(ID.EQ.1) THEN
|
|
TAUR=DM(ID)*ABROS
|
|
TAUTHE(ID)=DM(ID)*ABFLX*THETA(ID)/(ZETA1+TWO)
|
|
ELSE
|
|
TAUR=TAUROS(ID-1)+DDM*HALF*(ABROSD(ID-1)+ABROS)
|
|
ABFLXM=ABROSD(ID-1)
|
|
ZETAD=ZETA0
|
|
IF(DM(ID).LE.DMVISC*DM(ND)) ZETAD=ZETA1
|
|
A0=(ABFLXM*DM(ID)-ABFLX*DM(ID-1))/DDM/(ZETAD+TWO)
|
|
A1=(ABFLX-ABFLXM)/DDM/(ZETAD+3.D0)
|
|
TAUTHE(ID)=TAUTHE(ID-1)+
|
|
* A0*(THETA(ID)*DM(ID)-THETA(ID-1)*DM(ID-1))+
|
|
* A1*(THETA(ID)*DM(ID)**2-THETA(ID-1)*DM(ID-1)**2)
|
|
END IF
|
|
TAUF=TAUR
|
|
C
|
|
C New value of temperature
|
|
C
|
|
call tlocal(id,tauf,t)
|
|
C
|
|
C Convergence criterion for temperature
|
|
C (if REL < 1e-3, temperature is not recalculated again, but for
|
|
C consistency the electron density and pressures are still
|
|
C calculated consistently with the last temperature)
|
|
C
|
|
REL=ABS(T-TEMP(ID))/TEMP(ID)
|
|
IF(IT.LE.5) GO TO 10
|
|
C
|
|
C Store the final quantitites
|
|
C
|
|
30 TEMP(ID)=T
|
|
PGS(ID)=PGAS
|
|
VSND2(ID)=PTOTAL(ID)/DENS(ID)
|
|
ABROSD(ID)=ABROS
|
|
ABPLAD(ID)=ABPLA
|
|
TAUROS(ID)=TAUR
|
|
TAUFLX(ID)=TAUF
|
|
IF(ID.NE.1) RETURN
|
|
DPRAD=1.8912D-15*T4*(TAUF-TAUTHE(ID))
|
|
HG1=SQRT(2.D0*PGS(1)/DENS(1)/QGRAV)
|
|
HR1=DPRAD/DM(1)/QGRAV
|
|
RR1=HR1/HG1
|
|
RETURN
|
|
END
|