504 lines
15 KiB
Fortran
504 lines
15 KiB
Fortran
SUBROUTINE INIFRS
|
|
C =================
|
|
C
|
|
C Setup frequencies in opacity sampling mode
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
PARAMETER (THIRD=UN/3.,FTH=4./3.)
|
|
DIMENSION FRLEV(MLEVEL),IENS(MLEVEL),ITRL(MLEVEL)
|
|
DIMENSION FRL0(MTRANS),FRL1(MTRANS),FRLC(5*MTRANS)
|
|
DIMENSION IKC(5*MTRANS),ITKC(5*MTRANS),ITJNU(5*MTRANS)
|
|
DIMENSION FLNU(2*MATOM+3),DLNU(2*MATOM+3),ILNU(2*MATOM+3)
|
|
DIMENSION XMASS(30)
|
|
DATA XMASS/ 1.008, 4.003, 6.941, 9.012,10.810,12.011,14.007,
|
|
& 16.000,18.918,20.179,22.990,24.305,26.982,28.086,
|
|
& 30.974,32.060,35.453,39.948,39.098,40.080,44.956,
|
|
& 47.900,50.941,51.996,54.938,55.847,58.933,58.700,
|
|
& 63.546,65.380/
|
|
|
|
C
|
|
IF(TSNU.EQ.0.) TSNU=TEFF
|
|
IF(VTNU.EQ.0.) VTNU=VTB
|
|
IF(VTNU.LT.1.D4) VTNU=VTNU*1.D5
|
|
FRS1=CNU1*1.D11*TSNU
|
|
FRS2=3.28805D15/CNU2/CNU2
|
|
C
|
|
DO IAT=1,NATOM
|
|
CDOP=TWO*BOLK/AMASS(IAT)
|
|
DLNU(IAT)=0.375/2.997925D10*SQRT(CDOP*TSNU+VTNU*VTNU)
|
|
DLNU(IAT+NATOM)=20.*DLNU(IAT)
|
|
FLNU(IAT)=DLOG(FRS1)
|
|
FLNU(IAT+NATOM)=DLOG(FRS1)
|
|
END DO
|
|
C
|
|
XPNU=24.
|
|
CDOP=TWO*BOLK/XMASS(1)/HMASS
|
|
DLNU(2*NATOM+1)=50./2.997925D10*SQRT(CDOP*TSNU+VTNU*VTNU)
|
|
DLNU(2*NATOM+2)=5.*DLNU(2*NATOM+1)
|
|
FLNU(2*NATOM+1)=DLOG(FRS2)
|
|
FLNU(2*NATOM+2)=DLOG(FRCMIN)
|
|
NNU=2*NATOM+3
|
|
IF(ISPODF.EQ.1 .AND. DDNU.GT.0.) THEN
|
|
CDOP=TWO*BOLK/AMASS(NATOM)
|
|
IF(IELNU.GT.0) CDOP=TWO*BOLK/XMASS(IELNU)/HMASS
|
|
DLNU(NNU)=DDNU/2.997925D10*SQRT(CDOP*TSNU+VTNU*VTNU)
|
|
FLNU(NNU)=DLOG(FRS2)
|
|
ELSE
|
|
DLNU(NNU)=DLNU(2*NATOM+2)
|
|
FLNU(NNU)=DLOG(FRS1)
|
|
END IF
|
|
CALL INDEXX(NNU,DLNU,ILNU)
|
|
C
|
|
C Store line and continua frequencies
|
|
C
|
|
NLIC=0
|
|
DO 10 ITR=1,NTRANS
|
|
IJTC(ITR)=0
|
|
INDXPA=IABS(INDEXP(ITR))
|
|
IF(INDXPA.EQ.0) GO TO 10
|
|
IF(INDXPA.EQ.3 .OR. INDXPA.EQ.4) GO TO 10
|
|
IF(FR0(ITR).EQ.0.) GO TO 10
|
|
IF(LINE(ITR)) THEN
|
|
ILV0=ILOW(ITR)
|
|
IAT=IATM(ILV0)
|
|
ITC=ITRA(ILV0,NNEXT(IEL(ILV0)))
|
|
IF(ITC.EQ.0) ITC=ITRA(ILV0,NNEXT(IEL(ILV0))+1)
|
|
IF(INDXPA.NE.2) THEN
|
|
FRLC(NLIC+1)=FR0(ITR)
|
|
ITKC(NLIC+1)=ITR
|
|
IJTC(ITR)=NLIC+1
|
|
ITJNU(NLIC+1)=IAT
|
|
FRLC(NLIC+2)=FREQ(IFR0(ITR))
|
|
FRL0(ITR)=FRLC(NLIC+2)
|
|
ITKC(NLIC+2)=ITR
|
|
IF(ITC.GT.0 .AND. FREQ(IFR0(ITR)).GT.FR0(ITC) .AND.
|
|
* FR0(ITC).GT.FR0(ITR)) FRLC(NLIC+2)=0.999999*FR0(ITC)
|
|
ITJNU(NLIC+2)=IAT
|
|
FRLC(NLIC+3)=FREQ(IFR1(ITR))
|
|
FRL1(ITR)=FRLC(NLIC+3)
|
|
ITKC(NLIC+3)=ITR
|
|
ITJNU(NLIC+3)=2*NATOM+1
|
|
NLIC=NLIC+3
|
|
D0=DLOG(FRL0(ITR))-DLOG(FRL1(ITR))
|
|
IF(D0.GT.XPNU*DLNU(IAT)) THEN
|
|
ITJNU(NLIC-1)=IAT+NATOM
|
|
FRLC(NLIC+1)=EXP(DLOG(FR0(ITR))+XPNU*DLNU(IAT))
|
|
ITKC(NLIC+1)=ITR
|
|
ITJNU(NLIC+1)=IAT
|
|
FRLC(NLIC+2)=EXP(DLOG(FR0(ITR))-XPNU*DLNU(IAT))
|
|
ITKC(NLIC+2)=ITR
|
|
ITJNU(NLIC+2)=IAT+NATOM
|
|
NLIC=NLIC+2
|
|
END IF
|
|
ELSE
|
|
FRLC(NLIC+1)=0.999999*FR0(ITC)
|
|
FRL0(ITR)=FRLC(NLIC+1)
|
|
ITKC(NLIC+1)=ITR
|
|
ITJNU(NLIC+1)=IAT
|
|
FRLC(NLIC+2)=FREQ(IFR1(ITR-1))
|
|
FRL1(ITR)=FRLC(NLIC+2)
|
|
ITKC(NLIC+2)=ITR
|
|
ITJNU(NLIC+2)=2*NATOM+1
|
|
NLIC=NLIC+2
|
|
END IF
|
|
ELSE
|
|
NLIC=NLIC+1
|
|
FRLC(NLIC)=FR0(ITR)
|
|
ITKC(NLIC)=ITR
|
|
IJTC(ITR)=NLIC
|
|
ITJNU(NLIC)=0
|
|
END IF
|
|
10 CONTINUE
|
|
C
|
|
IKC(1)=1
|
|
IF(NLIC.GT.1) CALL INDEXX(NLIC,FRLC,IKC)
|
|
DO IJ=1,MFREQ
|
|
FREQ(IJ)=0.
|
|
W(IJ)=0.
|
|
WCH(IJ)=0.
|
|
NLINES(IJ)=0
|
|
END DO
|
|
C
|
|
C Sort continuum limits
|
|
C
|
|
CALL INDEXX(NLEVEL,ENION,IENS)
|
|
DO IL=1,NLEVEL
|
|
ILS=IENS(NLEVEL-IL+1)
|
|
FRLEV(IL)=ENION(ILS)/H
|
|
ITRL(IL)=ITRA(ILS,NNEXT(IEL(ILS)))
|
|
END DO
|
|
IF(FRCMAX.LT.1.01*FRLEV(1) .AND. FRCMAX.GT.0.) THEN
|
|
ILS=IENS(NLEVEL)
|
|
ILN=NNEXT(IEL(ILS))
|
|
ITR0=ITRA(ILS,ILN)
|
|
WRITE(10,640) FRLEV(1),ILS,ILN,ITR0
|
|
640 FORMAT(1PE12.4,3I7)
|
|
CALL QUIT(' Edge at frequency larger than FRCMAX; ii,itr:',
|
|
* ils,itr0)
|
|
END IF
|
|
C
|
|
C Highest frequency tail
|
|
C
|
|
IF(FRCMAX.LE.0.) FRCMAX=FRLEV(1)*CFRMAX
|
|
IF(FRS1.GT.FRCMAX) THEN
|
|
FRCMAX=FRS1
|
|
NFTAIL=0
|
|
END IF
|
|
IF(NFTAIL.GT.0) THEN
|
|
NFTA1=NFTAIL/2+1
|
|
FREQ(1)=FRCMAX
|
|
NEND=0
|
|
IL=1
|
|
KJ=1
|
|
DO WHILE(FRLEV(IL).GT.FRS1)
|
|
NEND1=NEND+NFTA1
|
|
NEND=NEND+NFTAIL
|
|
ITR=ITRL(IL)
|
|
IFR0(ITR)=1
|
|
IFR1(ITR)=NEND
|
|
FREQ(NEND)=1.000001*FRLEV(IL)
|
|
FREQ(NEND+1)=0.999999*FRLEV(IL)
|
|
FREQ(NEND1)=FREQ(KJ)-(UN-DFTAIL)*(FREQ(KJ)-FREQ(NEND))
|
|
XEND=UN/FLOAT(NFTA1-1)
|
|
D121=XEND*(FREQ(KJ)-FREQ(NEND1))
|
|
DO IJ=KJ+1,NEND1-1
|
|
FREQ(IJ)=FREQ(IJ-1)-D121
|
|
END DO
|
|
D121=THIRD*(FREQ(KJ)-FREQ(KJ+1))
|
|
DO IJ=KJ+1,NEND1-1,2
|
|
W(IJ)=4.*D121
|
|
W(IJ-1)=W(IJ-1)+D121
|
|
W(IJ+1)=W(IJ+1)+D121
|
|
END DO
|
|
D121=XEND*(FREQ(NEND1)-FREQ(NEND))
|
|
DO IJ=NEND1+1,NEND-1
|
|
FREQ(IJ)=FREQ(IJ-1)-D121
|
|
END DO
|
|
D121=THIRD*(FREQ(NEND1)-FREQ(NEND1+1))
|
|
DO IJ=NEND1+1,NEND-1,2
|
|
W(IJ)=4.*D121
|
|
W(IJ-1)=W(IJ-1)+D121
|
|
W(IJ+1)=W(IJ+1)+D121
|
|
END DO
|
|
D121=HALF*(FREQ(NEND)-FREQ(NEND+1))
|
|
W(NEND)=W(NEND)+D121
|
|
W(NEND+1)=W(NEND+1)+D121
|
|
IL=IL+1
|
|
KJ=NEND+1
|
|
END DO
|
|
NEND1=NEND+NFTA1
|
|
NEND=NEND+NFTAIL
|
|
FREQ(NEND)=FRS1
|
|
FREQ(NEND1)=FREQ(KJ)-(UN-DFTAIL)*(FREQ(KJ)-FREQ(NEND))
|
|
XEND=UN/FLOAT(NFTA1-1)
|
|
D121=XEND*(FREQ(KJ)-FREQ(NEND1))
|
|
DO IJ=KJ+1,NEND1-1
|
|
FREQ(IJ)=FREQ(IJ-1)-D121
|
|
END DO
|
|
D121=THIRD*(FREQ(KJ)-FREQ(KJ+1))
|
|
DO IJ=KJ+1,NEND1-1,2
|
|
W(IJ)=4.*D121
|
|
W(IJ-1)=W(IJ-1)+D121
|
|
W(IJ+1)=W(IJ+1)+D121
|
|
END DO
|
|
D121=XEND*(FREQ(NEND1)-FREQ(NEND))
|
|
DO IJ=NEND1+1,NEND-1
|
|
FREQ(IJ)=FREQ(IJ-1)-D121
|
|
END DO
|
|
D121=THIRD*(FREQ(NEND1)-FREQ(NEND1+1))
|
|
DO IJ=NEND1+1,NEND-1,2
|
|
W(IJ)=4.*D121
|
|
W(IJ-1)=W(IJ-1)+D121
|
|
W(IJ+1)=W(IJ+1)+D121
|
|
END DO
|
|
ELSE
|
|
FREQ(1)=FRS1
|
|
NEND=1
|
|
END IF
|
|
NFREQC=NEND
|
|
DO IJ=1,NFREQC
|
|
IFREQB(IJ)=IJ
|
|
END DO
|
|
NFRS1=NFREQC
|
|
C
|
|
C Setup frequency points
|
|
C
|
|
DO IT=1,NTRANS
|
|
IFR0(IT)=0
|
|
IFR1(IT)=0
|
|
END DO
|
|
C
|
|
IL=NLIC
|
|
DO WHILE(FRLC(IKC(IL)).GT.FRS1)
|
|
IL=IL-1
|
|
END DO
|
|
NFREQ=NEND
|
|
XFRA=DLOG(FRS1)
|
|
DO WHILE(IL.GT.0)
|
|
ITR=ITKC(IKC(IL))
|
|
NFS=0
|
|
XFRB=DLOG(FRLC(IKC(IL)))
|
|
IF(XFRA.GT.XFRB) THEN
|
|
IKNU=ITJNU(IKC(IL))
|
|
IDN=1
|
|
DO WHILE(FLNU(ILNU(IDN)).GE.XFRA .AND. IDN.LT.NNU)
|
|
IDN=IDN+1
|
|
END DO
|
|
DXNU=DLNU(ILNU(IDN))
|
|
IF(IKNU.EQ.0) XFRB=DLOG(1.000001*FRLC(IKC(IL)))
|
|
NFS=INT((XFRA-XFRB)/DXNU)+1
|
|
XFS0=(XFRA-XFRB)/FLOAT(NFS)
|
|
DO IJ=NFREQ+1,NFREQ+NFS
|
|
XFR=DLOG(FREQ(IJ-1))-XFS0
|
|
FREQ(IJ)=EXP(XFR)
|
|
END DO
|
|
NFREQ=NFREQ+NFS
|
|
IF(DLOG(FR0(ITR)).EQ.XFRB) IJTC(ITR)=NFREQ
|
|
IF(IKNU.EQ.0) THEN
|
|
IFR0(ITR)=1
|
|
IFR1(ITR)=NFREQ
|
|
NFREQ=NFREQ+1
|
|
FREQ(NFREQ)=0.999999*FRLC(IKC(IL))
|
|
XFRB=DLOG(FREQ(NFREQ))
|
|
ELSE IF(IKNU.LE.2*NATOM) THEN
|
|
IF(IFR0(ITR).EQ.0) THEN
|
|
IFR0(ITR)=NFREQ
|
|
D0=DLOG(FR0(ITR))
|
|
IF(FLNU(IKNU).GT.D0) FLNU(IKNU)=D0
|
|
IF(IABS(INDEXP(ITR)).EQ.2) THEN
|
|
D0=DLOG(FR0(ITR-1))
|
|
IF(FLNU(IKNU).GT.D0) FLNU(IKNU)=D0
|
|
END IF
|
|
ELSE
|
|
IFR1(ITR)=NFREQ
|
|
IF(IKNU.LE.NATOM) THEN
|
|
IAT=IATM(ILOW(ITR))
|
|
D0=DLOG(FR0(ITR))-XPNU*DLNU(IAT)
|
|
D1=DLOG(FRL1(ITR))
|
|
IF(D1.GT.D0) D0=D1
|
|
IF(FLNU(IKNU).GT.D0) FLNU(IKNU)=D0
|
|
ELSE
|
|
D0=DLOG(FRL1(ITR))
|
|
IF(FLNU(IKNU).GT.D0) FLNU(IKNU)=D0
|
|
END IF
|
|
END IF
|
|
ELSE
|
|
IF(IFR0(ITR).EQ.0) THEN
|
|
IFR0(ITR)=NFREQ
|
|
ELSE
|
|
IFR1(ITR)=NFREQ
|
|
END IF
|
|
END IF
|
|
ELSE IF(XFRA.EQ.XFRB) THEN
|
|
IKNU=ITJNU(IKC(IL))
|
|
IF(IKNU.EQ.0) THEN
|
|
FREQ(NFREQ)=1.000001*FRLC(IKC(IL))
|
|
FREQ(NFREQ+1)=0.999999*FRLC(IKC(IL))
|
|
IFR0(ITR)=1
|
|
IFR1(ITR)=NFREQ
|
|
NFREQ=NFREQ+1
|
|
XFRB=DLOG(FREQ(NFREQ))
|
|
ELSE IF(IKNU.LE.2*NATOM) THEN
|
|
IF(IFR0(ITR).EQ.0) THEN
|
|
IFR0(ITR)=NFREQ
|
|
D0=DLOG(FR0(ITR))
|
|
IF(FLNU(IKNU).GT.D0) FLNU(IKNU)=D0
|
|
IF(IABS(INDEXP(ITR)).EQ.2) THEN
|
|
D0=DLOG(FR0(ITR-1))
|
|
IF(FLNU(IKNU).GT.D0) FLNU(IKNU)=D0
|
|
END IF
|
|
ELSE
|
|
IFR1(ITR)=NFREQ
|
|
IF(IKNU.LE.NATOM) THEN
|
|
IAT=IATM(ILOW(ITR))
|
|
D0=DLOG(FR0(ITR))-XPNU*DLNU(IAT)
|
|
D1=DLOG(FRL1(ITR))
|
|
IF(D1.GT.D0) D0=D1
|
|
IF(FLNU(IKNU).GT.D0) FLNU(IKNU)=D0
|
|
ELSE
|
|
D0=DLOG(FRL1(ITR))
|
|
IF(FLNU(IKNU).GT.D0) FLNU(IKNU)=D0
|
|
END IF
|
|
IF(DLOG(FR0(ITR)).EQ.XFRB) IJTC(ITR)=NFREQ
|
|
END IF
|
|
ELSE
|
|
IF(IFR0(ITR).EQ.0) THEN
|
|
IFR0(ITR)=NFREQ
|
|
ELSE
|
|
IFR1(ITR)=NFREQ
|
|
IF(DLOG(FR0(ITR)).EQ.XFRB) IJTC(ITR)=NFREQ
|
|
END IF
|
|
END IF
|
|
END IF
|
|
IL=IL-1
|
|
XFRA=XFRB
|
|
IF(XPNU.EQ.24. .AND. FREQ(NFREQ).LT.FRS2) THEN
|
|
XPNU=HALF*XPNU
|
|
DO IAT=1,NATOM
|
|
DLNU(IAT)=TWO*DLNU(IAT)
|
|
DLNU(IAT+NATOM)=TWO*DLNU(IAT+NATOM)
|
|
END DO
|
|
END IF
|
|
END DO
|
|
C
|
|
XFRB=DLOG(FRCMIN)
|
|
IF(XFRA.GT.XFRB) THEN
|
|
DXNU=DLNU(NNU-1)
|
|
NFS=INT((XFRA-XFRB)/DXNU)+1
|
|
XFS0=(XFRA-XFRB)/FLOAT(NFS)
|
|
DO IJ=NFREQ+1,NFREQ+NFS
|
|
XFR=DLOG(FREQ(IJ-1))-XFS0
|
|
FREQ(IJ)=EXP(XFR)
|
|
END DO
|
|
NFREQ=NFREQ+NFS
|
|
END IF
|
|
FREQ(NFREQ)=FRCMIN
|
|
DO 20 ITR=1,NTRANS
|
|
IF(LINEXP(ITR)) GO TO 20
|
|
DO IJ=IFR0(ITR),IFR1(ITR)
|
|
NLINES(IJ)=NLINES(IJ)+1
|
|
END DO
|
|
20 CONTINUE
|
|
C
|
|
C Choose continuum frequency points in the global set
|
|
C
|
|
FRLEV(NLEVEL+1)=FRCMIN
|
|
IL=1
|
|
DO WHILE(FRLEV(IL).GT.FRS1)
|
|
IL=IL+1
|
|
END DO
|
|
IB0=NFRS1
|
|
NUB=2*NATOM+1
|
|
XFRA=DLOG(FRS1)
|
|
DO WHILE(IL.LE.NLEVEL+1)
|
|
IF(FRLEV(IL).LT.FRCMIN) GO TO 490
|
|
IF(IL.GT.1 .AND. IL.LE.NLEVEL) THEN
|
|
IF(FRLEV(IL).GE.FRLEV(IL-1)) GO TO 490
|
|
END IF
|
|
IF(IL.LE.NLEVEL) ITR=ITRL(IL)
|
|
FRLV0=FRLEV(IL)
|
|
IB1=IB0
|
|
DO WHILE(FREQ(IB1).GT.FRLV0)
|
|
IB1=IB1+1
|
|
XFRB=DLOG(FREQ(IB1))
|
|
IF(IFREQB(NFREQC).LT.IB1) THEN
|
|
IF(NLINES(IB1).EQ.0 .AND. ISPODF.GT.1) THEN
|
|
NFREQC=NFREQC+1
|
|
IFREQB(NFREQC)=IB1
|
|
XFRA=XFRB
|
|
ELSE IF((XFRA-XFRB).GT.DLNU(NUB)) THEN
|
|
NFREQC=NFREQC+1
|
|
IFREQB(NFREQC)=IB1
|
|
XFRA=XFRB
|
|
END IF
|
|
END IF
|
|
END DO
|
|
IF(IL.LE.NLEVEL) THEN
|
|
IFR0(ITR)=1
|
|
IFR1(ITR)=IB1-1
|
|
IJTC(ITR)=IFR1(ITR)
|
|
END IF
|
|
IF(IFREQB(NFREQC).LT.(IB1-1)) THEN
|
|
NFREQC=NFREQC+1
|
|
IFREQB(NFREQC)=IB1-1
|
|
END IF
|
|
IF(IFREQB(NFREQC).LT.IB1) THEN
|
|
NFREQC=NFREQC+1
|
|
IFREQB(NFREQC)=IB1
|
|
END IF
|
|
XFRA=DLOG(FREQ(IB1))
|
|
IB0=IB1
|
|
490 IL=IL+1
|
|
IF(FRLEV(IL).LT.FRS2) NUB=2*NATOM+2
|
|
END DO
|
|
C
|
|
IF(IFREQB(NFREQC).LT.NFREQ) THEN
|
|
NFREQC=NFREQC+1
|
|
IFREQB(NFREQC)=NFREQ
|
|
END IF
|
|
C
|
|
NFREQL=0
|
|
XBL=DLOG(FRS1)
|
|
NFLX=0
|
|
DO 410 IT=1,NTRANS
|
|
IF(LINEXP(IT)) GO TO 410
|
|
IF(FR0(IT).LT.FRCMIN) GO TO 410
|
|
INDXPA=ABS(INDEXP(IT))
|
|
IF(INDXPA.GT.2 .AND. INDXPA.LE.4) GO TO 410
|
|
IL0=ILOW(IT)
|
|
ITC=ITRA(IL0,NNEXT(IEL(IL0)))
|
|
IF(ITC.EQ.0) ITC=ITRA(IL0,NNEXT(IEL(IL0))+1)
|
|
IF(IFR1(IT).LE.IFR1(ITC)) GO TO 411
|
|
IF(IFR0(IT).LE.IFR1(ITC) .AND. ITC.GT.0) IFR0(IT)=IFR1(ITC)+1
|
|
411 NF=IFR1(IT)-IFR0(IT)+1
|
|
KFR0(IT)=NFREQL+1
|
|
KFR1(IT)=NFREQL+NF
|
|
NFREQL=NFREQL+NF
|
|
IF(INDXPA.EQ.2) THEN
|
|
FR02H=HALF*(FREQ(IFR0(IT))+FREQ(IFR1(IT)))
|
|
IJTC(IT)=IFR1(IT)
|
|
DO WHILE(FR02H.GT.FREQ(IJTC(IT)) .AND. IJTC(IT).GT.1)
|
|
IJTC(IT)=IJTC(IT)-1
|
|
END DO
|
|
END IF
|
|
|
|
al=2.997926e18/fr0(it)
|
|
io=iel(il0)
|
|
write(42,642) it,typion(io),il0,iup(it),iatm(il0),
|
|
* il0-nfirst(io)+1,iup(it)-nfirst(io)+1,al,
|
|
* ifr0(it),ifr1(it),nf
|
|
642 format(i7,a6,2i7,3i5,f12.3,3i7)
|
|
IF(NF.GT.MFREQL) THEN
|
|
WRITE(10,*) IL0,IT,NF
|
|
CALL QUIT('Too many frequencies in a line - nf.gt.mfreql',
|
|
* nf,mfreql)
|
|
END IF
|
|
IF(NF.GT.NFLX) NFLX=NF
|
|
IF(KFR1(IT).GT.MFREQP)
|
|
* CALL QUIT('Too many cross-sections to store in PRFLIN',
|
|
* kfr1(it),mfreqp)
|
|
410 CONTINUE
|
|
C
|
|
DO IT=1,NTRANS
|
|
MODW=IABS(INDEXP(IT))
|
|
IF(MODW.EQ.5 .OR. MODW.EQ.15) THEN
|
|
IJTC(IT)=IFR1(IT)
|
|
FRLV0=FR0PC(IT)
|
|
IB1=NFRS1
|
|
DO WHILE(FREQ(IB1).GT.FRLV0)
|
|
IB1=IB1+1
|
|
END DO
|
|
IFR0(IT)=1
|
|
IFR1(IT)=IB1-1
|
|
END IF
|
|
END DO
|
|
C
|
|
C Weights
|
|
C
|
|
DO IJ=NFRS1+1,NFREQ
|
|
D121=HALF*(FREQ(IJ-1)-FREQ(IJ))
|
|
W(IJ-1)=W(IJ-1)+D121
|
|
W(IJ)=W(IJ)+D121
|
|
END DO
|
|
C
|
|
DO IJ=1,NFREQ
|
|
IJALI(IJ)=1
|
|
IJX(IJ)=1
|
|
JIK(IJ)=IJ
|
|
END DO
|
|
NPPX=NFREQ
|
|
C
|
|
write(10,*) nfreq,nfreqc,nfreql,nflx
|
|
IF(NFREQ.GT.MFREQ) THEN
|
|
WRITE(10,1000) NFREQ
|
|
1000 FORMAT(' Number of frequencies:',I10)
|
|
CALL QUIT('nfreq.gt.mfreq',nfreq,mfreq)
|
|
END IF
|
|
C
|
|
RETURN
|
|
END
|