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

65 lines
1.7 KiB
Fortran

SUBROUTINE RTEANG
C =================
C
C initialization of the angle quadrature points for the radiative
C transfer equation
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'MODELQ.FOR'
INCLUDE 'ALIPAR.FOR'
PARAMETER (NMU3=3, NMU5=5, ZERO=0.D0)
COMMON/EXTINT/WANGLE,EXTIN(MFREQ)
COMMON/SURFEX/EXTJ(MFREQ),EXTH(MFREQ)
DIMENSION AMU0(MMU),WTMU0(MMU)
C
C If irradiation is neglected, the angular quadrature is a standard
C NMU-point Gaussian quadrature
C
X=WANGLE*HALF
XJ=0.
XH=0.
IF(X.LE.0.) THEN
call gauleg(zero,un,amu0,wtmu0,nmu,mmu)
do i=1,nmu
amu(i)=amu0(i)
wtmu(i)=wtmu0(i)
fmu(i)=0.
end do
ELSE
C
C Here, allowance is made for irradiation by central star.
C First, establish angular integration that takes into account
C angles with mu < 0; instead of the standard 3-point integration
C over angles, we have now a more general NMU5-point integration
C
X0=HALF-X
X1=HALF+X
call gauleg(-un,un,amu0,wtmu0,nmu3,mmu)
DO I=1,NMU3
AMU(I)=X0*AMU0(I)+X1
WTMU(I)=X0*WTMU0(I)
FMU(I)=0.
END DO
NMU=NMU5
i4=nmu3+1
i5=nmu3+2
AMU(i4)=X*(UN+0.577350269189626D0)
AMU(i5)=X*(UN-0.577350269189626D0)
DO I=NMU3+1,NMU5
WTMU(I)=X
FMU(I)=ASIN(SQRT((WANGLE**2-AMU(I)**2)/(UN-AMU(I)**2)))/
* 3.141592653589793D0
XJ=XJ+WTMU(I)*FMU(I)
XH=XH+WTMU(I)*AMU(I)*FMU(I)
END DO
END IF
C
DO IJ=1,NFREQ
EXTJ(IJ)=XJ*EXTIN(IJ)*HALF
EXTH(IJ)=XH*EXTIN(IJ)*HALF
END DO
C
RETURN
END