151 lines
5.2 KiB
Fortran
151 lines
5.2 KiB
Fortran
SUBROUTINE HESET(IL,ALM,EXCL,EXCU,ION,IPRF0,ILWN,IUPN)
|
|
C ======================================================
|
|
C
|
|
C Auxiliary procedure for INISET - set up quantities:
|
|
C IPRF0 - index for the procedure evaluating standard absorption
|
|
C profile coefficient for He I lines - see GAMHE
|
|
C ILWN,IUPN - only in NLTE option is switched on;
|
|
C indices of the lower and upper level associated with
|
|
C the given line
|
|
C
|
|
C Input: IL - line index
|
|
C ALM - line wavelength in nm
|
|
C EXCL - excitation potential of the lower level (in cm**-1)
|
|
C EXCU - excitation potential of the upper level (in cm**-1)
|
|
C ION - ionisation degree (1=neutrals, 2=once ionized, etc.)
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
DIMENSION JU(24),NU(24),IT(24)
|
|
DATA IT/1,1,0,1,0,0,0,1,0,0,0,1,1,0,0,0,1,0,1,0,0,0,0,0/
|
|
DATA NU/6,6,9,3,8,4,7,5,6,6,5,4,4,4,3,4,3,3,5,5,7,8,10,2/
|
|
DATA JU/15,3,5,9,5,3,5,3,5,1,1,15,3,5,3,1,15,5,15,5,1,1,1,9/
|
|
C
|
|
C ******* He I ***********
|
|
C
|
|
IF(ION.NE.1) GO TO 20
|
|
C
|
|
C switch IPRF0 - see GAMHE
|
|
C
|
|
IL1=IL
|
|
ALAM=ALM*10.
|
|
IPRF=0
|
|
IF(ABS(ALAM-3819.60).LT.1.) IPRF=1
|
|
IF(ABS(ALAM-3867.50).LT.1.) IPRF=2
|
|
IF(ABS(ALAM-3871.79).LT.1.) IPRF=3
|
|
IF(ABS(ALAM-3888.65).LT.1.) IPRF=4
|
|
IF(ABS(ALAM-3926.53).LT.1.) IPRF=5
|
|
IF(ABS(ALAM-3964.73).LT.1.) IPRF=6
|
|
IF(ABS(ALAM-4009.27).LT.1.) IPRF=7
|
|
IF(ABS(ALAM-4120.80).LT.1.) IPRF=8
|
|
IF(ABS(ALAM-4143.76).LT.1.) IPRF=9
|
|
IF(ABS(ALAM-4168.97).LT.1.) IPRF=10
|
|
IF(ABS(ALAM-4437.55).LT.1.) IPRF=11
|
|
IF(ABS(ALAM-4471.50).LT.1.) IPRF=12
|
|
IF(ABS(ALAM-4713.20).LT.1.) IPRF=13
|
|
IF(ABS(ALAM-4921.93).LT.1.) IPRF=14
|
|
IF(ABS(ALAM-5015.68).LT.1.) IPRF=15
|
|
IF(ABS(ALAM-5047.74).LT.1.) IPRF=16
|
|
IF(ABS(ALAM-5875.70).LT.1.) IPRF=17
|
|
IF(ABS(ALAM-6678.15).LT.1.) IPRF=18
|
|
IF(ABS(ALAM-4026.20).LT.1.) IPRF=19
|
|
IF(ABS(ALAM-4387.93).LT.1.) IPRF=20
|
|
IF(ABS(ALAM-4023.97).LT.1.) IPRF=21
|
|
IF(ABS(ALAM-3935.91).LT.1.) IPRF=22
|
|
IF(ABS(ALAM-3833.55).LT.1.) IPRF=23
|
|
IF(ABS(ALAM-10830.0).LT.1.) IPRF=24
|
|
IF(IPRF.GT.0.AND.IPRF.LE.20) IPRF0=IPRF
|
|
C
|
|
C Indices of NLTE levels associated with the given line
|
|
C
|
|
IF(INLTE.gt.5.OR.IELHE1.EQ.0) RETURN
|
|
N0I=NFIRST(IELHE1)
|
|
N1I=NLAST(IELHE1)
|
|
HC=CL*H
|
|
EION=ENION(N0I)/HC
|
|
ILW=0
|
|
IUN=0
|
|
NQL=0
|
|
IF(IPRF.GT.0) NQL=NU(IPRF)
|
|
DO 10 I=N0I,N1I
|
|
NQ=NQUANT(I)
|
|
EX=EION-ENION(I)/HC
|
|
IF(ABS(EXCL-EX).LT.100.) THEN
|
|
ILW=I
|
|
IGL=INT(G(I)+0.001)
|
|
END IF
|
|
IF(NQ.EQ.NQL) THEN
|
|
IG=INT(G(I)+0.001)
|
|
IF(IT(IPRF).EQ.0) THEN
|
|
IF(NQ.EQ.2.AND.IG.EQ.JU(IPRF)) IUN=I
|
|
IF(NQ.EQ.3) THEN
|
|
IF(IG.EQ.JU(IPRF)) THEN
|
|
IF(IG.EQ.1.OR.IG.EQ.5) IUN=I
|
|
IF(IG.EQ.3.AND.IGL.EQ.1) IUN=I
|
|
ELSE
|
|
IF(IG.EQ.9) IUN=I
|
|
END IF
|
|
END IF
|
|
IF(NQ.EQ.4) THEN
|
|
IF(IG.EQ.JU(IPRF)) THEN
|
|
IF(IG.EQ.1.OR.IG.EQ.5.OR.IG.EQ.7) IUN=I
|
|
IF(IG.EQ.3.AND.IGL.EQ.1) IUN=I
|
|
ELSE
|
|
IF(IG.EQ.16) IUN=I
|
|
END IF
|
|
END IF
|
|
IF(IG.EQ.25.OR.IG.EQ.36) IUN=I
|
|
IF(IG.EQ.49.OR.IG.EQ.64.OR.IG.EQ.81) IUN=I
|
|
IF(IG.EQ.100.OR.IG.EQ.121.OR.IG.EQ.144) IUN=I
|
|
ELSE
|
|
IF(NQ.EQ.3) THEN
|
|
IF(IG.EQ.JU(IPRF)) THEN
|
|
IF(IG.EQ.9.OR.IG.EQ.15) IUN=I
|
|
IF(IG.EQ.3.AND.IGL.EQ.9) IUN=I
|
|
ELSE
|
|
IF(IG.EQ.27) IUN=I
|
|
END IF
|
|
END IF
|
|
IF(NQ.EQ.4) THEN
|
|
IF(IG.EQ.JU(IPRF)) THEN
|
|
IF(IG.EQ.9.OR.IG.EQ.15.OR.IG.EQ.21) IUN=I
|
|
IF(IG.EQ.3.AND.IGL.EQ.9) IUN=I
|
|
ELSE
|
|
IF(IG.EQ.48) IUN=I
|
|
END IF
|
|
END IF
|
|
IF(IG.EQ.75) IUN=I
|
|
IF(IG.EQ.108.OR.IG.EQ.147.OR.IG.EQ.192) IUN=I
|
|
IF(IG.EQ.243.OR.IG.EQ.300.OR.IG.EQ.363) IUN=I
|
|
END IF
|
|
IF(NQ.EQ.2.AND.IG.EQ.16) IUN=I
|
|
IF(NQ.EQ.3.AND.IG.EQ.36) IUN=I
|
|
IF(NQ.EQ.4.AND.IG.EQ.64) IUN=I
|
|
IF(NQ.EQ.5.AND.IG.EQ.100) IUN=I
|
|
IF(NQ.EQ.6.AND.IG.EQ.144) IUN=I
|
|
IF(NQ.EQ.7.AND.IG.EQ.196) IUN=I
|
|
IF(NQ.EQ.8.AND.IG.EQ.256) IUN=I
|
|
IF(NQ.EQ.9.AND.IG.EQ.324) IUN=I
|
|
IF(NQ.EQ.10.AND.IG.EQ.400) IUN=I
|
|
END IF
|
|
10 CONTINUE
|
|
c print *, 'il,iprof,ilw,iupn',il,iprf,ilw,iun
|
|
ILWN=ILW
|
|
IUPN=IUN
|
|
C
|
|
C ******* He II ***********
|
|
C
|
|
20 IF(ION.NE.2.OR.IELHE2.LE.0) RETURN
|
|
N0I=NFIRST(IELHE2)
|
|
NLHE2=NLAST(IELHE2)-N0I+1
|
|
XL=SQRT(1./(1.-EXCL/438916.146))
|
|
ILW=INT(XL)
|
|
IF((FLOAT(ILW)-XL).LT.0.) ILW=ILW+1
|
|
XU=SQRT(1./(1.-EXCU/438916.146))
|
|
IUN=INT(XU)
|
|
IF((FLOAT(IUN)-XU).LT.0.) IUN=IUN+1
|
|
IF(ILW.LE.NLHE2) ILWN=ILW+N0I-1
|
|
IF(IUN.LE.NLHE2) IUPN=IUN+N0I-1
|
|
RETURN
|
|
END
|