git push -u origin main
This commit is contained in:
@@ -0,0 +1,383 @@
|
||||
SUBROUTINE INILIN_grid
|
||||
C ======================
|
||||
C
|
||||
C read in the input line list,
|
||||
C selection of lines that may contribute,
|
||||
C set up auxiliary fields containing line parameters,
|
||||
C
|
||||
C Input of line data - unit 19:
|
||||
C
|
||||
C For each line, one (or two) records, containing:
|
||||
C
|
||||
C ALAM - wavelength (in nm)
|
||||
C ANUM - code of the element and ion (as in Kurucz-Peytremann)
|
||||
C (eg. 2.00 = HeI; 26.00 = FeI; 26.01 = FeII; 6.03 = C IV)
|
||||
C GF - log gf
|
||||
C EXCL - excitation potential of the lower level (in cm*-1)
|
||||
C QL - the J quantum number of the lower level
|
||||
C EXCU - excitation potential of the upper level (in cm*-1)
|
||||
C QU - the J quantum number of the upper level
|
||||
C AGAM = 0. - radiation damping taken classical
|
||||
C > 0. - the value of Gamma(rad)
|
||||
C
|
||||
C There are now two possibilities, called NEW and OLD, of the next
|
||||
C parameters:
|
||||
C a) NEW, next parameters are:
|
||||
C GS = 0. - Stark broadening taken classical
|
||||
C > 0. - value of log gamma(Stark)
|
||||
C GW = 0. - Van der Waals broadening taken classical
|
||||
C > 0. - value of log gamma(VdW)
|
||||
C INEXT = 0 - no other record necessary for a given line
|
||||
C > 0 - next record is read, which contains:
|
||||
C WGR1,WGR2,WGR3,WGR4 - Stark broadening values from Griem (in Angst)
|
||||
C for T=5000,10000,20000,40000 K, respectively;
|
||||
C and n(el)=1e16 for neutrals, =1e17 for ions.
|
||||
C ILWN = 0 - line taken in LTE (default)
|
||||
C > 0 - line taken in NLTE, ILWN is then index of the
|
||||
C lower level
|
||||
C =-1 - line taken in approx. NLTE, with Doppler K2 function
|
||||
C =-2 - line taken in approx. NLTE, with Lorentz K2 function
|
||||
C IUN = 0 - population of the upper level in LTE (default)
|
||||
C > 0 - index of the lower level
|
||||
C IPRF = 0 - Stark broadening determined by GS
|
||||
C < 0 - Stark broadening determined by WGR1 - WGR4
|
||||
C > 0 - index for a special evaluation of the Stark
|
||||
C broadening (in the present version inly for He I -
|
||||
C see procedure GAMHE)
|
||||
C b) OLD, next parameters are
|
||||
C IPRF,ILWN,IUN - the same meaning as above
|
||||
C next record with WGR1-WGR4 - again the same meaning as above
|
||||
C (this record is automatically read if IPRF<0
|
||||
C
|
||||
C The only differences between NEW and OLD is the occurence of
|
||||
C GS and GW in NEW, and slightly different format of reading.
|
||||
C
|
||||
C
|
||||
INCLUDE 'PARAMS.FOR'
|
||||
INCLUDE 'MODELP.FOR'
|
||||
INCLUDE 'SYNTHP.FOR'
|
||||
INCLUDE 'LINDAT.FOR'
|
||||
COMMON/LIMPAR/ALAM0,ALAM1,FRMIN,FRLAST,FRLI0,FRLIM
|
||||
COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
|
||||
common/igrddd/igrdd,irelin
|
||||
common/plaopa/plalin,plcint,chcint
|
||||
common/conabs/absoc(mfreqc),emisc(mfreqc),scatc(mfreqc),
|
||||
* plac(mfreqc)
|
||||
C
|
||||
PARAMETER (C1 = 2.3025851,
|
||||
* C2 = 4.2014672,
|
||||
* C3 = 1.4387886,
|
||||
* CNM = 2.997925D17,
|
||||
* ANUMIN = 1.9,
|
||||
* ANUMAX = 99.31,
|
||||
* AHE2 = 2.01,
|
||||
* EXT0 = 3.17,
|
||||
* UN = 1.0,
|
||||
* TEN = 10.,
|
||||
* HUND = 1.D2,
|
||||
* TENM4 = 1.D-4,
|
||||
* TENM8 = 1.D-8,
|
||||
* OP4 = 0.4,
|
||||
* AGR0=2.4734E-22,
|
||||
* XEH=13.595, XET=8067.6, XNF=25.,
|
||||
* R02=2.5, R12=45., VW0=4.5E-9,
|
||||
* bnc=1.4743e-2,hkc=4.79928e-11)
|
||||
PARAMETER (ENHE1=198310.76, ENHE2=438908.85)
|
||||
|
||||
DATA INLSET /0/
|
||||
C
|
||||
if(irelin.eq.0) return
|
||||
c
|
||||
relop0=relop
|
||||
relop=1.e-3*relop
|
||||
if(relop.gt.1.e-4) relop=1.e-4
|
||||
if(relop.lt.1.e-5) relop=1.e-5
|
||||
plalin=0.
|
||||
ijcon=2
|
||||
IL=0
|
||||
INNLT0=0
|
||||
IGRIE0=0
|
||||
IF(NXTSET.EQ.1) THEN
|
||||
ALAM0=ALM00
|
||||
ALAST=ALST00
|
||||
FRLAST=CNM/ALAST
|
||||
NXTSET=0
|
||||
REWIND 19
|
||||
END IF
|
||||
ALAM00=ALAM0
|
||||
ALAST=CNM/FRLAST
|
||||
ALAST0=ALAST
|
||||
DOPSTD=1.E7/ALAM0*DSTD
|
||||
DOPLAM=ALAM0*ALAM0/CNM*DOPSTD
|
||||
AVAB=ABSTD(IDSTD)*RELOP
|
||||
id=idstd
|
||||
dstdid=sqrt(1.4e7*temp(idstd))
|
||||
ASTD=1.0
|
||||
c IF(GRAV.GT.6.) ASTD=0.1
|
||||
CUTOFF=CUTOF0
|
||||
ALAST=CNM/FRLAST
|
||||
absta=absoc(1)
|
||||
write(6,630) alam0,alast,abstd(idstd),absta
|
||||
630 format(/' read line list with alam0, alast',2f10.3,1p3e11.3/)
|
||||
c
|
||||
rstd=1.e4
|
||||
if(relop.gt.0.) rstd=1./relop
|
||||
afac=10.
|
||||
if(iat.gt.15.and.iat.ne.26) afac=1.
|
||||
afac=afac*rstd*astd
|
||||
C
|
||||
afac=afac*rstd*astd
|
||||
afilin=alast
|
||||
C
|
||||
C first part of reading line list - read only lambda, and
|
||||
C skip all lines with wavelength below ALAM0-CUTOFF
|
||||
C
|
||||
ALAM=0.
|
||||
7 continue
|
||||
if(ibin(0).eq.0) then
|
||||
read(19,510) alam
|
||||
else
|
||||
read(19) alam
|
||||
end if
|
||||
510 FORMAT(F10.4)
|
||||
IF(ALAM.LT.ALAM0-CUTOFF) GO TO 7
|
||||
BACKSPACE(19)
|
||||
GO TO 10
|
||||
c
|
||||
8 continue
|
||||
10 ILWN=0
|
||||
IUN=0
|
||||
IPRF=0
|
||||
GS=0.
|
||||
GW=0.
|
||||
IF(IBIN(0).EQ.0) THEN
|
||||
READ(19,*,END=100,err=8) ALAM,ANUM,GF,EXCL,QL,EXCU,QU,AGAM,
|
||||
* GS,GW
|
||||
else
|
||||
read(19,end=100) ALAM,ANUM,GF,EXCL,QL,EXCU,QU,AGAM,
|
||||
* GS,GW
|
||||
end if
|
||||
c
|
||||
c change wavelength to vacuum for lambda > 2000
|
||||
c
|
||||
if(alam.gt.200..and.vaclim.gt.2000.) then
|
||||
wl0=alam*10.
|
||||
ALM=1.E8/(WL0*WL0)
|
||||
XN1=64.328+29498.1/(146.-ALM)+255.4/(41.-ALM)
|
||||
WL0=WL0*(XN1*1.D-6+UN)
|
||||
alam=wl0*0.1
|
||||
END IF
|
||||
C
|
||||
C first selection : for a given interval a atomic number
|
||||
C
|
||||
IF(ALAM.GT.ALAST+CUTOFF) GO TO 100
|
||||
C
|
||||
C second selection : for line strengths
|
||||
C
|
||||
FR0=CNM/ALAM
|
||||
if(inlist.ge.0) then
|
||||
IAT=ifix(real(ANUM,4))
|
||||
FRA=(ANUM-FLOAT(IAT)+TENM4)*HUND
|
||||
ION=INT(FRA)+1
|
||||
IF(ION.GT.IONIZ(IAT)) GO TO 10
|
||||
IEVEN=1
|
||||
EXCL=ABS(EXCL)
|
||||
EXCU=ABS(EXCU)
|
||||
IF(EXCL.GT.EXCU) THEN
|
||||
FRA=EXCL
|
||||
EXCL=EXCU
|
||||
EXCU=FRA
|
||||
FRA=QL
|
||||
QL=QU
|
||||
QU=FRA
|
||||
IEVEN=0
|
||||
END IF
|
||||
GFP=C1*GF-C2
|
||||
EPP=C3*EXCL
|
||||
else
|
||||
IF(ION.GT.IONIZ(IAT)) GO TO 10
|
||||
end if
|
||||
C
|
||||
if(fr0.lt.freqc(ijcon)) then
|
||||
ijcon=ijcon+1
|
||||
absta=0.5*(absoc(ijcon)+scatc(ijcon)+
|
||||
* absoc(ijcon-1)+scatc(ijcon-1))
|
||||
end if
|
||||
abstd(id)=absta
|
||||
c
|
||||
dop=1.e7/alam*dstdid
|
||||
abct=exp(gfp-epp/temp(id))*rrr(id,ion,iat)
|
||||
abid=abct/dop/absta
|
||||
ext=sqrt(abid*afac)*dop
|
||||
c
|
||||
c line part of the Planck mean opacity
|
||||
c
|
||||
c if(alam.ge.alam0.and.alam.le.alast) then
|
||||
c if(abid.ge.relop) then
|
||||
c xx=exp(-hkc*fr0/temp(id))
|
||||
c pln=bnc*(fr0*1.e-15)**3*xx/(un-xx)
|
||||
c abct=abct*(un-xx)
|
||||
c plalin=plalin+pln*abct
|
||||
c write(16,643) iat,ion,alam*10.,abct,dop,absta,abid
|
||||
c 643 format(2i4,0pf12.3,1p6e12.4)
|
||||
c end if
|
||||
c
|
||||
ALAX0=12.
|
||||
c
|
||||
c alax0=0
|
||||
c
|
||||
if(imode.eq.-6) go to 10
|
||||
if(alam.lt.afilin) then
|
||||
if(abid.ge.relop) then
|
||||
afilin=alam
|
||||
else
|
||||
if(abid.lt.relop*1.e-6) go to 10
|
||||
end if
|
||||
else if(alam.lt.9500.) then
|
||||
if(abid.lt.relop) go to 10
|
||||
else if(alam.lt.9950.) then
|
||||
if(abid.lt.relop*1.e-9) go to 10
|
||||
else
|
||||
if(abid.lt.relop*1.e-19) go to 10
|
||||
end if
|
||||
c
|
||||
c if(abid.lt.relop.and.alam.gt.alax0) go to 10
|
||||
c if(abid.lt.1.e-10*relop.and.alam.lt.alax0) go to 10
|
||||
IF(ANUM.LT.ANUMIN.OR.ANUM.GT.ANUMAX) GO TO 10
|
||||
IF(ANUM.GT.ANUMAX) GO TO 10
|
||||
IF(ABS(ANUM-AHE2).LT.TENM4.AND.IFHE2.GT.0) GO TO 10
|
||||
c
|
||||
extin0=ext
|
||||
C
|
||||
C truncate line list if there are more lines than maximum allowable
|
||||
C (given by MLIN0 - see include file LINDAT.FOR)
|
||||
C
|
||||
IL=IL+1
|
||||
IF(IL.GT.MLIN0) THEN
|
||||
WRITE(6,601) ALAM
|
||||
IL=MLIN0
|
||||
ALAST=CNM/FREQ0(IL)-CUTOFF
|
||||
FRLAST=CNM/ALAST
|
||||
NXTSET=1
|
||||
GO TO 100
|
||||
END IF
|
||||
C
|
||||
C =============================================
|
||||
C line is selected, set up necessary parameters
|
||||
C =============================================
|
||||
C
|
||||
C evaluation of EXTIN0 - the distance (in delta frequency) where
|
||||
C the line is supposed to contribute to the total opacity
|
||||
C
|
||||
C store parameters for selected lines
|
||||
C
|
||||
FREQ0(IL)=FR0
|
||||
EXCL0(IL)=real(EPP,4)
|
||||
EXCU0(IL)=real(EXCU*C3,4)
|
||||
GF0(IL)=real(GFP,4)
|
||||
EXTIN(IL)=real(EXTIN0,4)
|
||||
INDAT(IL)=100*IAT+ION
|
||||
C
|
||||
C ****** line broadening parameters *****
|
||||
C
|
||||
C 1) natural broadening
|
||||
C
|
||||
IF(AGAM.GT.0.) THEN
|
||||
GAMR0(IL)=real(EXP(C1*AGAM),4)
|
||||
ELSE
|
||||
GAMR0(IL)=real(AGR0*FR0*FR0,4)
|
||||
END IF
|
||||
C
|
||||
C if Stark or Van der Waals broadening assumed classical,
|
||||
C evaluate the effective quantum number
|
||||
C
|
||||
IF(GS.EQ.0..OR.GW.EQ.0) THEN
|
||||
Z=FLOAT(ION)
|
||||
XNEFF2=Z**2*(XEH/(ENEV(IAT,ION)-EXCU/XET))
|
||||
IF(XNEFF2.LE.0..OR.XNEFF2.GT.XNF) XNEFF2=XNF
|
||||
END IF
|
||||
C
|
||||
C 2) Stark broadening
|
||||
C
|
||||
IF(GS.NE.0.) THEN
|
||||
GS0(IL)=real(EXP(C1*GS),4)
|
||||
ELSE
|
||||
GS0(IL)=real(TENM8*XNEFF2*XNEFF2*SQRT(XNEFF2),4)
|
||||
END IF
|
||||
C
|
||||
C 3) Van der Waals broadening
|
||||
C
|
||||
IF(GW.NE.0.) THEN
|
||||
GW0(IL)=real(EXP(C1*GW),4)
|
||||
ELSE
|
||||
IF(IAT.LT.21) THEN
|
||||
R2=R02*(XNEFF2/Z)**2
|
||||
ELSE IF(IAT.LT.45) then
|
||||
R2=(R12-FLOAT(IAT))/Z
|
||||
ELSE
|
||||
R2=0.5
|
||||
END IF
|
||||
GW0(IL)=real(VW0*R2**OP4,4)
|
||||
END IF
|
||||
C
|
||||
C 4) parameters for a special profile evaluation:
|
||||
C
|
||||
C a) special He I and He II line broadening parameters
|
||||
C
|
||||
ISPRFF=0
|
||||
IF(IAT.LE.2) ISPRFF=ISPEC(IAT,ION,ALAM)
|
||||
IF(IAT.EQ.2) CALL HESET(IL,ALAM,EXCL,EXCU,ION,IPRF,ILWN,IUN)
|
||||
ISPRF(IL)=ISPRFF
|
||||
IPRF0(IL)=IPRF
|
||||
C
|
||||
C b) parameters for Griem values of Stark broadening
|
||||
C
|
||||
IF(IPRF.LT.0) THEN
|
||||
IGRIE0=IGRIE0+1
|
||||
IGRIEM(IL)=IGRIE0
|
||||
IF(IGRIE0.GT.MGRIEM) THEN
|
||||
WRITE(6,603) ALAM
|
||||
GO TO 20
|
||||
END IF
|
||||
WGR0(1,IGRIE0)=real(WGR1,4)
|
||||
WGR0(2,IGRIE0)=real(WGR2,4)
|
||||
WGR0(3,IGRIE0)=real(WGR3,4)
|
||||
WGR0(4,IGRIE0)=real(WGR4,4)
|
||||
END IF
|
||||
20 CONTINUE
|
||||
GO TO 10
|
||||
C
|
||||
100 NLIN0=IL
|
||||
NNLT=INNLT0
|
||||
NGRIEM=IGRIE0
|
||||
ALM1=CNM/FREQ0(1)
|
||||
IF(ALAM0.LT.ALM1.AND.IMODE.NE.1) THEN
|
||||
ALAM0=ALM1-4.*DOPLAM
|
||||
IF(ALAM0.LT.ALAM00) ALAM0=ALAM00
|
||||
END IF
|
||||
ALM2=CNM/FREQ0(NLIN0)
|
||||
IF(NLIN0.GT.1) ALM2=CNM/FREQ0(NLIN0-1)
|
||||
IF(ALAST.GT.ALM2.AND.IMODE.NE.1) THEN
|
||||
ALAST=ALM2-4.*DOPLAM
|
||||
IF(ALAST.GT.ALAST0) ALAST=ALAST0
|
||||
FRLAST=CNM/ALAST
|
||||
END IF
|
||||
IBLANK=0
|
||||
relop=relop0
|
||||
C
|
||||
WRITE(6,611) NLIN0
|
||||
611 FORMAT(/' ATOMIC LINES :',I10/)
|
||||
c WRITE(6,611) NLIN0,NNLT,NGRIEM
|
||||
c 611 FORMAT(/' LINES - TOTAL :',I10
|
||||
c * /' LINES - NLTE :',I10
|
||||
c * /' LINES - GRIEM :',I10/)
|
||||
601 FORMAT('0 **** MORE LINES THAN MLIN0, LINE LIST TRUNCATED '/
|
||||
*' AT LAMBDA',F15.4,' NM'/)
|
||||
c 602 FORMAT('0 **** MORE LINES WITH SPECIAL PROFILES THAN MPRF'/
|
||||
c *' FOR LINES WITH LAMBDA GREATER THAN',F15.4,' NM'/)
|
||||
603 FORMAT('0 **** MORE LINES WITH GRIEM PROFILES THAN MGRIEM'/
|
||||
*' FOR LINES WITH LAMBDA GREATER THAN',F15.4,' NM'/)
|
||||
c 604 FORMAT('0 **** MORE LINES IN NLTE OPTION THAN MNLT'/
|
||||
c *' FOR LINES WITH LAMBDA GREATER THAN',F15.4,' NM'/)
|
||||
RETURN
|
||||
END
|
||||
Reference in New Issue
Block a user