126 lines
3.7 KiB
Fortran
126 lines
3.7 KiB
Fortran
SUBROUTINE INIBLH
|
|
C =================
|
|
C
|
|
C output information about hydrogen lines
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
CHARACTER*4 TYPION(30)
|
|
CHARACTER*4 APB,AP0,AP1,AP2,AP3,AP4,APR
|
|
COMMON/PRFQUA/DOPA1(MATOM,MDEPTH),VDWC(MDEPTH)
|
|
C
|
|
PARAMETER (C1=2.3025851, C2=4.2014672, C3=1.4387886)
|
|
PARAMETER (DP0=3.33564E-11, DP1=1.651E8,
|
|
* VW1=0.42, VW2=0.45,TENM4=1.E-4)
|
|
PARAMETER (UN=1.)
|
|
|
|
DATA TYPION /' I ',' II ',' III',' IV ',' V ',
|
|
* ' VI ',' VII','VIII',' IX ',' X ',
|
|
* ' XI ',' XII','XIII',' XIV',' XV ',
|
|
* ' XVI','XVII',' 18 ',' XIX',' XX ',
|
|
* ' XXI','XXII',' 23 ','XXIV','XXV ',
|
|
* 'XXVI',' 27 ',' 28 ','XXIX',' XXX'/
|
|
DATA APB,AP0,AP1,AP2,AP3,AP4 /' ',' .',' *',' **',' ***',
|
|
* '****'/
|
|
C
|
|
IF(IPRIN.LE.-2.OR.IHYL.LT.0) RETURN
|
|
ALM0=2.997925D18/FREQ(1)
|
|
ALM1=2.997925D18/FREQ(2)
|
|
XX=FREQ(1)
|
|
IF(NFREQ.GE.2) XX=0.5*(FREQ(1)+FREQ(2))
|
|
BNU=BN*(XX*1.E-15)**3
|
|
HKF=HK*XX
|
|
C
|
|
IAT=1
|
|
ION=1
|
|
IZZ=1
|
|
ID=IDSTD
|
|
T=TEMP(ID)
|
|
ANE=ELEC(ID)
|
|
EXH=EXP(HKF/T)
|
|
EXHK(ID)=UN/EXH
|
|
PLAN(ID)=BNU/(EXH-UN)
|
|
STIM(ID)=UN-EXHK(ID)
|
|
DOPA1(IAT,ID)=UN/(XX*DP0*SQRT(DP1*T/AMAS(IAT)+VTURB(ID)))
|
|
ISERL=ILOWH
|
|
ISERU=ILOWH
|
|
IF(alm0.GT.17000..AND.alm1.LT.21000.) THEN
|
|
ISERL=3
|
|
ISERU=4
|
|
ELSE IF(alm0.GT.22700.) THEN
|
|
ISERL=4
|
|
ISERU=5
|
|
IF(alm0.GT.32800.) ISERU=6
|
|
IF(alm0.GT.44660.) ISERU=7
|
|
END IF
|
|
C
|
|
DO I=ISERL,ISERU
|
|
II=I*I
|
|
XII=UN/II
|
|
M1=M10
|
|
IF(I.LT.ILOWH) M1=ILOWH-1
|
|
M2=M1+1
|
|
IF(M1.LT.I+1) M1=I+1
|
|
M1=M1-1
|
|
M2=M20+3
|
|
IF(M1.LT.I+1) M1=I+1
|
|
if(grav.gt.3.) then
|
|
m2=m2+5
|
|
m1=m1-3
|
|
if(m1.gt.i+6) m1=m1-3
|
|
end if
|
|
if(grav.gt.6.) then
|
|
m2=m2+2
|
|
m1=m1-1
|
|
if(m1.gt.i+6) m1=m1-1
|
|
end if
|
|
IF(M1.LT.I+1) M1=I+1
|
|
IF(M2.GT.20) M2=20
|
|
ILINH=0
|
|
DO J=M2,M1,-1
|
|
CALL STARK0(I,J,izz,XKIJ,WL0,FIJ,FIJ0)
|
|
ALAM=WL0
|
|
if(alam.ge.alm0.and.alam.lt.alm1) then
|
|
ILINH=ILINH+1
|
|
GH=2.*II
|
|
GF=LOG10(FIJ*GH)
|
|
EXCL=109679.*(1.-XII)
|
|
EXCL0H=EXCL*C3
|
|
GF0H=GF*C1-C2
|
|
ABCNT=EXP(GF0H-EXCL0H/TEMP(ID))*RRR(ID,ION,IAT)*
|
|
* DOPA1(IAT,ID)*STIM(ID)
|
|
STR0=ABCNT/ABSTD(ID)
|
|
IF(STR0.LE.1.2) THEN
|
|
WW1=0.886*STR0*(1.-STR0*(0.707-STR0*0.577))
|
|
ELSE
|
|
WW1=SQRT(LOG(STR0))
|
|
END IF
|
|
IF(STR0.GT.55.) THEN
|
|
agam=0.01
|
|
WW2=0.5*SQRT(3.14*AGAM*STR0)
|
|
IF(WW2.GT.WW1) WW1=WW2
|
|
END IF
|
|
EQW=ALAM*ALAM/3.E18*1.E3/DOPA1(IAT,ID)*WW1
|
|
STR=EQW*10.
|
|
APR=APB
|
|
IF(STR.GE.1.E0.AND.STR.LT.1.E1) APR=AP0
|
|
IF(STR.GE.1.E1.AND.STR.LT.1.E2) APR=AP1
|
|
IF(STR.GE.1.E2.AND.STR.LT.1.E3) APR=AP2
|
|
IF(STR.GE.1.E3.AND.STR.LT.1.E4) APR=AP3
|
|
IF(STR.GE.1.E4) APR=AP4
|
|
c if(iprin.ge.2)
|
|
c * WRITE(6,601) ALAM,TYPAT(IAT),TYPION(ION),GF,EXCL,
|
|
c * STR0,EQW,APR,i,j
|
|
WRITE(14,601) ALAM,TYPAT(IAT),TYPION(ION),GF,EXCL,
|
|
* STR0,EQW,APR,i,j
|
|
end if
|
|
END DO
|
|
END DO
|
|
C
|
|
601 FORMAT(F10.3,2X,2A4,F7.2,F12.3,1PE11.2,0PF8.1,1X,A4,2i3)
|
|
C
|
|
RETURN
|
|
END
|