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

40 lines
1.0 KiB
Fortran

SUBROUTINE WNSTOR(ID)
C =====================
C
C Stores occupation probabilities for hydrogen levels
C in common WNCOM for further use
C
INCLUDE 'PARAMS.FOR'
INCLUDE 'MODELP.FOR'
PARAMETER (UN=1.,TWO=2.,SIXTH=1./6.,CCOR=0.09)
parameter (p1=0.1402,p2=0.1285,p3=1.,p4=3.15,p5=4.)
parameter (tkn=3.01,ckn=5.33333333,cb=8.59d14,f23=-2./3.)
C
ANE=ELEC(ID)
A=CCOR*EXP(SIXTH*LOG(ANE))/SQRT(TEMP(ID))
DO 20 I=1,NLMX
XN=I
WNHINT(I,ID)=wn(xn,a,id,un)
WNHE2(I,ID)=wn(xn,a,id,two)
20 CONTINUE
C
C array WOP - occupation probabilities for explicit levels
C
do 30 ii=1,nlevel
wop(ii,id)=un
if(ifwop(ii).le.0) go to 30
ie=iel(ii)
nq=nquant(ii)
if(iz(ie).eq.1) then
wop(ii,id)=wnhint(nq,id)
else if(iz(ie).eq.2) then
wop(ii,id)=wnhe2(nq,id)
else
z=iz(ie)
xn=nq
wop(ii,id)=wn(xn,a,id,z)
end if
30 continue
RETURN
END