203 lines
6.1 KiB
Fortran
203 lines
6.1 KiB
Fortran
SUBROUTINE SIGAVS
|
|
C =================
|
|
C
|
|
C Read bound-free cross-sections for averaged levels
|
|
C from the unit INSA (given by IFANCY), with increasing frequencies
|
|
C It assumes that all continuum transitions for a given ion are
|
|
C given in a successive order in the data (i.e. as in TLUSTY for
|
|
C explicit levels. For other levels, additional input data in
|
|
C unit 54 !!
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
PARAMETER (HCCM=H*2.997925D10,BAM=1.D-18)
|
|
DIMENSION CRD(MFCRA),XIFE(8),FRD(MFCRA)
|
|
CHARACTER*40 FIDATA(MION),FIODF1(MION),FIODF2(MION),FIBFCS(MION)
|
|
COMMON/IONFIL/FIDATA,FIODF1,FIODF2,FIBFCS
|
|
C
|
|
DATA XIFE/63480.,130563.,247220.,442000.,605000.,799000.,
|
|
& 1008000.,1218380./
|
|
C
|
|
FR1=FREQ(1)
|
|
FR2=FREQ(2)
|
|
NUNIT=0
|
|
NQHT=0
|
|
IF(IASV.EQ.0) GOTO 100
|
|
c WRITE(6,600)
|
|
c 600 FORMAT(///,' DETAILED PHOTOIONIZATION CROSS-SECTIONS',
|
|
c * ' (EXPLICIT LEVELS)',/,
|
|
c * ' ---------------------------------------',/)
|
|
DO 10 I=1,NION
|
|
N1=NFIRST(I)
|
|
N2=NLAST(I)
|
|
INSA=0
|
|
DO 11 II=N1,N2
|
|
NFCR(II)=2
|
|
FRECR(II,1)=FR1
|
|
FRECR(II,2)=FR2
|
|
CROSR(II,1)=0.
|
|
CROSR(II,2)=0.
|
|
INSB=IBF(II)
|
|
IF(INSB.LT.50.OR.INSB.GT.100) GO TO 11
|
|
IF(INSA.EQ.0) INSA=INSB
|
|
IF(INSA.NE.INSB)
|
|
* call quit(' Incoherent file units in SIGAVS')
|
|
11 CONTINUE
|
|
IF(INSA.EQ.0) GOTO 10
|
|
IF(FIBFCS(I).NE.' ') THEN
|
|
INSA=INBFCS(I)
|
|
OPEN(INSA,FILE=FIBFCS(I),STATUS='OLD')
|
|
END IF
|
|
READ(INSA,*,END=500,ERR=500) IIAT,IIZ,NSUP
|
|
ATI=IIAT+0.01*(IIZ-1)
|
|
NBFI=NSUP
|
|
IF(NSUP.GT.(N2-N1+1)) NBFI=(N2-N1+1)
|
|
c * call quit(' Too many bf-trans. in input file (SIGAVS)')
|
|
c WRITE(6,601) ATI,INSA
|
|
DO 12 II=1,NBFI
|
|
READ(INSA,*,END=500,ERR=500) IILO,EELO,GGLO,NFCRR
|
|
IK=N1+IILO-1
|
|
IF (IK.GT.N2 .OR. IK.LT.N1)
|
|
* call quit(' Inconsistent level numbering in SIGAVS')
|
|
IF(IIAT.NE.26) GOTO 13
|
|
ECMR=XIFE(IIZ)-EELO
|
|
c DE=ABS((ENION(IK)-HCCM*ECMR)/ENION(IK))
|
|
c IF(DE.GT.1.D-4) call quit(' Incorrect energy level in SIGAVS')
|
|
13 READ(INSA,*,END=500,ERR=500) FR0,CR0
|
|
NFD=1
|
|
FRD(NFD)=FR0
|
|
CRD(NFD)=CR0
|
|
LUV=.FALSE.
|
|
DO 14 IJ=1,NFCRR-1
|
|
READ(INSA,*,END=500,ERR=500) FRIN,CRIN
|
|
IF(LUV) GOTO 14
|
|
IF(FRIN.GT.FR1) THEN
|
|
IF(FR0.LE.FR2.AND.IJ.GT.1) THEN
|
|
NFD=NFD+1
|
|
FRD(NFD)=FR0
|
|
CRD(NFD)=CR0
|
|
ENDIF
|
|
NFD=NFD+1
|
|
FRD(NFD)=FRIN
|
|
CRD(NFD)=CRIN
|
|
LUV=.TRUE.
|
|
ELSE IF(FRIN.GT.FR2) THEN
|
|
IF(FR0.LE.FR2.AND.IJ.GT.1) THEN
|
|
NFD=NFD+1
|
|
FRD(NFD)=FR0
|
|
CRD(NFD)=CR0
|
|
ENDIF
|
|
NFD=NFD+1
|
|
FRD(NFD)=FRIN
|
|
CRD(NFD)=CRIN
|
|
FR0=FRIN
|
|
CR0=CRIN
|
|
ELSE
|
|
FR0=FRIN
|
|
CR0=CRIN
|
|
ENDIF
|
|
IF(NFD.GT.MFCRA)
|
|
* call quit(' Too many frequencies in SIGAVS')
|
|
14 CONTINUE
|
|
CRMX(IK)=0.
|
|
DO 15 IJ=1,NFD
|
|
CRMX(IK)=MAX(CRMX(IK),CRD(IJ))
|
|
15 CONTINUE
|
|
IF(CRMX(IK).GT.0.) THEN
|
|
c WRITE(6,601) ATI,IILO,EELO,NFD
|
|
c 601 FORMAT(F7.2,I6,F13.3,I8)
|
|
NFCR(IK)=NFD
|
|
DO 16 IJ=1,NFD
|
|
FRECR(IK,IJ)=FRD(NFD-IJ+1)
|
|
CROSR(IK,IJ)=CRD(NFD-IJ+1)*BAM
|
|
16 CONTINUE
|
|
ENDIF
|
|
12 CONTINUE
|
|
10 CONTINUE
|
|
C
|
|
100 READ(50,*,END=540,ERR=540) NUNIT
|
|
IF(NUNIT.LE.0) RETURN
|
|
WRITE(6,602)
|
|
602 FORMAT(///,' DETAILED PHOTOIONIZATION CROSS-SECTIONS',
|
|
* ' (NON-EXPLICIT LEVELS)',/,
|
|
* ' ---------------------------------------',/)
|
|
DO 110 IN=1,NUNIT
|
|
READ(50,*,END=540,ERR=540) ATIR,INSA,NQHTR
|
|
NQHT=NQHT+NQHTR
|
|
IF(NQHT.GT.MPHOT)
|
|
* call quit(' Too many BF cross-sections in SIGAVS')
|
|
READ(INSA,*,END=501,ERR=501) IIAT,IIZ,NSUP
|
|
C
|
|
c check the total number of superlevels
|
|
c
|
|
IF(NQHTR.GT.NSUP) THEN
|
|
WRITE(6,603) NQHTR,NSUP
|
|
603 FORMAT(' NQHTR=',i4,' in Unit 50 input greater than NSUP=',
|
|
* i4,/' program resets NQHTR to NSUP'/)
|
|
NQHTR=NSUP
|
|
END IF
|
|
c
|
|
C loop over superlevels - read cross-sections
|
|
c
|
|
DO 120 I=1,NQHTR
|
|
IK=NQHT-NQHTR+I
|
|
READ(INSA,*,END=501,ERR=501) IILO,EELO,GGLO,NFCRR
|
|
AQHT(IK)=ATIR
|
|
EQHT(IK)=EELO
|
|
GQHT(IK)=GGLO
|
|
READ(INSA,*) FR0,CR0
|
|
NFD=1
|
|
FRD(NFD)=FR0
|
|
CRD(NFD)=CR0
|
|
LUV=.FALSE.
|
|
DO 130 IJ=1,NFCRR-1
|
|
READ(INSA,*) FRIN,CRIN
|
|
IF(LUV) GOTO 130
|
|
IF(FRIN.GT.FR1) THEN
|
|
IF(FR0.LE.FR2.AND.IJ.GT.1) THEN
|
|
NFD=NFD+1
|
|
FRD(NFD)=FR0
|
|
CRD(NFD)=CR0
|
|
ENDIF
|
|
NFD=NFD+1
|
|
FRD(NFD)=FRIN
|
|
CRD(NFD)=CRIN
|
|
LUV=.TRUE.
|
|
ELSE IF(FRIN.GT.FR2) THEN
|
|
IF(FR0.LE.FR2.AND.IJ.GT.1) THEN
|
|
NFD=NFD+1
|
|
FRD(NFD)=FR0
|
|
CRD(NFD)=CR0
|
|
ENDIF
|
|
NFD=NFD+1
|
|
FRD(NFD)=FRIN
|
|
CRD(NFD)=CRIN
|
|
FR0=FRIN
|
|
CR0=CRIN
|
|
ELSE
|
|
FR0=FRIN
|
|
CR0=CRIN
|
|
ENDIF
|
|
130 CONTINUE
|
|
CRMY(IK)=0.
|
|
DO 140 IJ=1,NFD
|
|
CRMY(IK)=MAX(CRMY(IK),CRD(IJ))
|
|
140 CONTINUE
|
|
IF(CRMY(IK).GT.0.) THEN
|
|
WRITE(6,611) ATIR,IILO,EELO,NFD
|
|
611 FORMAT(F7.2,I6,F13.3,I8)
|
|
NFQHT(IK)=NFD
|
|
DO 150 IJ=1,NFD
|
|
FRECQ(IK,IJ)=FRD(NFD-IJ+1)
|
|
QHOT(IK,IJ)=CRD(NFD-IJ+1)*BAM
|
|
150 CONTINUE
|
|
ENDIF
|
|
120 CONTINUE
|
|
110 CONTINUE
|
|
540 RETURN
|
|
C
|
|
500 call quit(' ERROR IN DATA FILE FOR BF SIG OF AVERAGED LEVELS (1)')
|
|
501 call quit(' ERROR IN DATA FILE FOR BF SIG OF AVERAGED LEVELS (2)')
|
|
C
|
|
END
|