132 lines
3.2 KiB
Fortran
132 lines
3.2 KiB
Fortran
SUBROUTINE OPAHST
|
|
C =================
|
|
C
|
|
C Auxiliary routine for START
|
|
C sets up necessary parameters for routines OPAHYL and OPHYL1, i.e.
|
|
C for opacity and emissivity in higher hydrogen lines
|
|
C Also sets up Stark parameters for OPAHYL
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
C
|
|
ALLIM1=1450.
|
|
ABLIM1=6650.
|
|
ABLIM2=5000.
|
|
ABLIM3=6500.
|
|
C
|
|
C Lyman lines
|
|
C
|
|
ILOW=1
|
|
IF(IABS(IOPHL1).EQ.1) IOPHL2=IOPHL2*2
|
|
DO I=1,4
|
|
M1FILE(I,ILOW)=MAX(I,IABS(IOPHL1))
|
|
M2FILE(I,ILOW)=I+1
|
|
END DO
|
|
DO I=5,NLMX
|
|
M1FILE(I,ILOW)=MAX(I-1,IABS(IOPHL1))
|
|
M2FILE(I,ILOW)=MIN(I+3,NLMX)
|
|
END DO
|
|
M1FILE(NLMX,ILOW)=NLMX+1
|
|
M2FILE(NLMX,ILOW)=NLMX
|
|
C
|
|
IF(IABS(IOPHL1).GT.100) THEN
|
|
IOPHL1=MOD(IOPHL1,100)
|
|
ISET=0
|
|
40 CONTINUE
|
|
READ(IBUFF,*,ERR=90) IL1,IU1,IM1,IP1
|
|
ISET=ISET+1
|
|
IF(IL1.LE.0.AND.ISET.EQ.1) THEN
|
|
IL1=1
|
|
IU1=4
|
|
IM1=0
|
|
IP1=1
|
|
END IF
|
|
IF(IL1.LE.0.AND.ISET.EQ.2) THEN
|
|
IL1=5
|
|
IU1=NLMX
|
|
IM1=1
|
|
IP1=3
|
|
END IF
|
|
IUP1=MIN(IU1,NLMX)
|
|
DO I=IL1,IUP1
|
|
M1FILE(I,ILOW)=MAX(I-IM1,IABS(IOPHL1))
|
|
M2FILE(I,ILOW)=MIN(I+IP1,NLMX)
|
|
END DO
|
|
IF(IU1.LT.NLMX) GO TO 40
|
|
90 CONTINUE
|
|
READ(IBUFF,*,ERR=100) ALLIM1
|
|
IF(ALLIM1.LE.0) ALLIM1=1450.
|
|
END IF
|
|
M1FILE(NLMX,ILOW)=NLMX+1
|
|
M2FILE(NLMX,ILOW)=NLMX
|
|
C
|
|
C Balmer lines
|
|
C
|
|
100 ILOW=2
|
|
IF(IABS(IOPHL2).EQ.1) IOPHL2=IOPHL2*3
|
|
IF(IABS(IOPHL2).EQ.2) IOPHL2=IOPHL2*3/2
|
|
DO I=1,6
|
|
M1FILE(I,ILOW)=MAX(I,IABS(IOPHL2))
|
|
M2FILE(I,ILOW)=I+1
|
|
END DO
|
|
DO I=7,NLMX
|
|
M1FILE(I,ILOW)=MAX(I-1,IABS(IOPHL2))
|
|
M2FILE(I,ILOW)=MIN(I+3,NLMX)
|
|
END DO
|
|
IF(IABS(IOPHL2).GT.100) THEN
|
|
IOPHL2=MOD(IOPHL2,100)
|
|
ISET=0
|
|
140 CONTINUE
|
|
READ(IBUFF,*,ERR=190) IL1,IU1,IM1,IP1
|
|
ISET=ISET+1
|
|
IF(IL1.LE.0.AND.ISET.EQ.1) THEN
|
|
IL1=1
|
|
IU1=6
|
|
IM1=0
|
|
IP1=1
|
|
END IF
|
|
IF(IL1.LE.0.AND.ISET.EQ.2) THEN
|
|
IL1=7
|
|
IU1=NLMX
|
|
IM1=1
|
|
IP1=3
|
|
END IF
|
|
IUP1=MIN(IU1,NLMX)
|
|
DO I=IL1,IUP1
|
|
M1FILE(I,ILOW)=MAX(I-IM1,IABS(IOPHL2))
|
|
M2FILE(I,ILOW)=MIN(I+IP1,NLMX)
|
|
END DO
|
|
IF(IU1.LT.NLMX) GO TO 140
|
|
190 CONTINUE
|
|
READ(IBUFF,*,ERR=200,END=200) ABLIM1,ABLIM2,ABLIM3
|
|
IF(ABLIM1.LE.0) ABLIM1=6650.
|
|
IF(ABLIM2.LE.0) ABLIM2=5000.
|
|
IF(ABLIM3.LE.0) ABLIM3=6500.
|
|
END IF
|
|
200 CONTINUE
|
|
M1FILE(NLMX,ILOW)=NLMX+1
|
|
M2FILE(NLMX,ILOW)=NLMX
|
|
c
|
|
C -------------------
|
|
C Stark paramereters
|
|
C -------------------
|
|
C
|
|
izzh=1
|
|
IF(IOPHL1.NE.0) THEN
|
|
I=1
|
|
I1=MAX(2,IABS(IOPHL1))
|
|
DO J=I1,NLMX
|
|
CALL STARK0(I,J,izzh,XKIJ(I,J),WL0(I,J),FIJ(I,J))
|
|
END DO
|
|
END IF
|
|
IF(IOPHL2.NE.0) THEN
|
|
I=2
|
|
I2=MAX(3,IABS(IOPHL2))
|
|
DO J=I2,NLMX
|
|
CALL STARK0(I,J,izzh,XKIJ(I,J),WL0(I,J),FIJ(I,J))
|
|
END DO
|
|
END IF
|
|
RETURN
|
|
END
|