94 lines
2.7 KiB
Fortran
94 lines
2.7 KiB
Fortran
SUBROUTINE SIGAVE
|
|
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
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
PARAMETER (HCCM=H*2.997925D10)
|
|
PARAMETER (TX=2.30258509299405,BAM=1.e-18)
|
|
DIMENSION XIFE(8)
|
|
DIMENSION FRINSG(MFREQ),CRIN(MFREQ),JKF(MFREQ)
|
|
C
|
|
DATA XIFE/63480.,130563.,247220.,442000.,605000.,799000.,
|
|
* 1008000.,1218380./
|
|
C
|
|
NFREQB=NFREQ
|
|
IF(IBFINT.GT.0) NFREQB=NFREQC
|
|
ITR=0
|
|
10 ITR=ITR+1
|
|
IF(ITR.GT.NTRANS) RETURN
|
|
IC=ITRA(IUP(ITR),ILOW(ITR))
|
|
INSA=IBF(IC)
|
|
IF(INSA.LT.50 .OR. INSA.GT.100) GO TO 10
|
|
IE=IEL(ILOW(ITR))
|
|
ITR=ITR-1
|
|
NL1=NFIRST(IE)
|
|
NL2=NLAST(IE)
|
|
IF(FIBFCS(IE).NE.' ') THEN
|
|
INSA=INBFCS(IE)
|
|
OPEN(INSA,FILE=FIBFCS(IE),STATUS='OLD')
|
|
END IF
|
|
READ(INSA,*,END=500,ERR=500) IERR,IZRR,NLRR
|
|
DO 100 I=NL1,NL2
|
|
ITR=ITR+1
|
|
IF(INDEXP(ITR).EQ.0) GO TO 100
|
|
IC=ITRA(IUP(ITR),ILOW(ITR))
|
|
READ(INSA,*) INL,ECMR,GDUM,NFIS
|
|
IF(IERR.NE.26) GO TO 20
|
|
ECMR=XIFE(IZRR)-ECMR
|
|
DE=ABS((ENION(ILOW(ITR))-HCCM*ECMR)/ENION(ILOW(ITR)))
|
|
IF(DE.GT.2.D-2) THEN
|
|
PRINT *,INSA,IE,ITR,I
|
|
END IF
|
|
20 DO IJ=1,NFIS
|
|
JI=NFIS-IJ+1
|
|
READ(INSA,*,END=500,ERR=500) FRINSG(JI),CRIN(JI)
|
|
END DO
|
|
DO IJ=1,NFREQB
|
|
JK=0
|
|
FR=FREQ(IJ)
|
|
IF(ISPODF.GE.1) FR=FREQ(IFREQB(IJ))
|
|
DO IK=1,NFIS
|
|
IF(FR.GT.FRINSG(IK)) THEN
|
|
JK=IK
|
|
GO TO 40
|
|
END IF
|
|
END DO
|
|
JK=NFIS
|
|
40 IF(JK.EQ.1) JK=2
|
|
JKF(IJ)=JK
|
|
END DO
|
|
DO IJ=1,NFREQB
|
|
JK=JKF(IJ)
|
|
FR=FREQ(IJ)
|
|
IF(ISPODF.GE.1) FR=FREQ(IFREQB(IJ))
|
|
IF(CRIN(JK-1).EQ.0. .OR. CRIN(JK).EQ.0.) THEN
|
|
BFCS (IC,IJ)=real(CRIN(JK)+(FR-FRINSG(JK))/
|
|
* (FRINSG(JK-1)-FRINSG(JK))*(CRIN(JK-1)-CRIN(JK)))
|
|
ELSE
|
|
XF1=LOG10(FRINSG(JK-1))
|
|
XF2=LOG10(FRINSG(JK))
|
|
YS1=LOG10(CRIN(JK-1))
|
|
YS2=LOG10(CRIN(JK))
|
|
XXF=LOG10(FR)
|
|
YYF=(XXF-XF2)/(XF1-XF2)*(YS1-YS2)+YS2
|
|
EXTX=EXP(TX*YYF)
|
|
BFCS(IC,IJ)=real(EXTX)
|
|
END IF
|
|
BFCS(IC,IJ)=real(BAM*BFCS(IC,IJ))
|
|
END DO
|
|
100 CONTINUE
|
|
GO TO 10
|
|
500 CALL QUIT
|
|
*('error in data for bf-cs of averaged levels - itr,ie:',
|
|
* itr,ie)
|
|
RETURN
|
|
END
|