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

45 lines
1.2 KiB
Fortran

subroutine angset
c =================
c
c sets up angles points and angle-dependent quantities for treating
c the Compton scattering
c
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
parameter(three=3.d0, five=5.d0, zero=0.d0, tr16=3.d0/16.d0)
dimension amu0(mmuc),wtmu0(mmuc)
c
c amu=cos(angle between line of sight and normal to slab) grid and
c gauss-legendre integration weights for the interval mu=[0,1]
c
call gauleg(zero,un,amu0,wtmu0,nmuc,mmuc)
c
do i=1,nmuc
amuc(i)=-amu0(nmuc-i+1)
amuc(i+nmuc)=amu0(i)
wtmuc(i)=wtmu0(nmuc-i+1)
wtmuc(i+nmuc)=wtmu0(i)
end do
nmuc=2*nmuc
c
do i=1,nmuc
amuc1(i)=amuc(i)*wtmuc(i)
amuc2(i)=amuc(i)*amuc(i)*wtmuc(i)
amuc3(i)=amuc(i)*amuc(i)*amuc(i)*wtmuc(i)
a1=amuc(i)
a2=a1*a1
a3=a1*a2
do i1=1,nmuc
b1=amuc(i1)
b2=b1*b1
b3=b1*b2
trw=tr16*wtmuc(i1)
calph(i,i1)=(three*a2*b2-a2-b2+three)*trw
cbeta(i,i1)=(five*(a1*b1+a3*b3)-three*(a3*b1+a1*b3))*trw
cgamm(i,i1)=a1*b1*trw
end do
end do
c
return
end