git push -u origin main
This commit is contained in:
@@ -0,0 +1,150 @@
|
||||
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
|
||||
Reference in New Issue
Block a user