137 lines
3.9 KiB
Fortran
137 lines
3.9 KiB
Fortran
SUBROUTINE ODFHYS(DOPO)
|
|
C =======================
|
|
C
|
|
C Initialization of line ODF's for hydrogen
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
PARAMETER (CCM=UN/2.997925D10,THIRD=UN/3.,FRH=3.28805D15)
|
|
DIMENSION FFRO(MFRO)
|
|
C
|
|
izzh=1
|
|
IF(ISPODF.GE.1) THEN
|
|
DO 200 ITR=1,NTRANS
|
|
JND=JNDODF(ITR)
|
|
MODE=IABS(INDEXP(ITR))
|
|
IF(JND.LE.0 .OR. MODE.NE.2) GO TO 200
|
|
LINEXP(ITR)=.FALSE.
|
|
LCOMP(ITR)=.FALSE.
|
|
INTMOD(ITR)=6
|
|
I=ILOW(ITR)
|
|
J=IUP(ITR)
|
|
NQLODF(I)=IABS(IPROF(ITR))
|
|
IF(NQLODF(I).EQ.0) NQLODF(I)=NQUANT(J)
|
|
OSC0(ITR)=0.
|
|
IS=NQUANT(I)
|
|
DO K=NQUANT(J),NLMX
|
|
CALL STARK0(IS,K,izzh,XKIJ(JND,K),WL0(JND,K),
|
|
* FIJ(JND,K))
|
|
OSC0(ITR)=OSC0(ITR)+FIJ(JND,K)
|
|
END DO
|
|
200 CONTINUE
|
|
RETURN
|
|
END IF
|
|
C
|
|
NLASTE=NFREQ
|
|
DO 100 ITR=1,NTRANS
|
|
JND=JNDODF(ITR)
|
|
MODE=IABS(INDEXP(ITR))
|
|
IF(JND.LE.0 .OR. MODE.NE.2) GO TO 100
|
|
LCOMP(ITR)=.FALSE.
|
|
INTMOD(ITR)=6
|
|
I=ILOW(ITR)
|
|
J=IUP(ITR)
|
|
NQLODF(I)=IABS(IPROF(ITR))
|
|
IF(NQLODF(I).EQ.0) NQLODF(I)=NQUANT(J)
|
|
XJ2A=HALF*(XI2(NQUANT(J))+XI2(NQUANT(J)-1))
|
|
C
|
|
C set up explicit frequencies & weights
|
|
C
|
|
NFRO=0
|
|
DO IFQ=1,4
|
|
NFRO=NFRO+KDO(IFQ,JND)
|
|
END DO
|
|
NFRO=NFRO-2
|
|
FRION=FRH*IZ(IEL(I))*IZ(IEL(I))
|
|
FRA=FRION*(XI2(NQUANT(I))-XJ2A)
|
|
DOPI=DOPO*FRA*CCM
|
|
FRB=0.99999999*FRION*XI2(NQUANT(I))
|
|
IFRQ0=IFR0(ITR)
|
|
IFRQ1=IFR1(ITR)
|
|
IFR0(ITR)=NLASTE+1
|
|
IFR1(ITR)=NLASTE+NFRO
|
|
I1ODF(I)=IFR0(ITR)
|
|
I2ODF(I)=IFR1(ITR)-1
|
|
FFRO(1)=0.99999999*FRA
|
|
FFRO(2)=FRA
|
|
IJ00=1
|
|
DO IK=1,3
|
|
DO IJ=2,KDO(IK,JND)
|
|
IJQ=IJ00+IJ
|
|
FFRO(IJQ)=FFRO(IJQ-1)+XDO(IK,JND)*DOPI
|
|
END DO
|
|
IJ00=IJ00+KDO(IK,JND)-1
|
|
END DO
|
|
do ij=1,ij00
|
|
if(ffro(ij).lt.frb) nfrb=ij
|
|
end do
|
|
if(nfrb.eq.ij00) then
|
|
IJ00=IJ00+1
|
|
FFRO(NFRO)=0.99999999*FRION*XI2(NQUANT(I))
|
|
do while (ffro(ij00).ge.ffro(nfro))
|
|
xdo(3,jnd)=0.75*xdo(3,jnd)
|
|
ij00=ij00-kdo(3,jnd)
|
|
do ij=2,kdo(3,jnd)
|
|
ijq=ij00+ij
|
|
ffro(ijq)=ffro(ijq-1)+xdo(3,jnd)*dopi
|
|
end do
|
|
ij00=ij00+kdo(3,jnd)
|
|
enddo
|
|
TIDO=(FFRO(NFRO)-FFRO(IJ00))/FLOAT(KDO(4,JND)-1)
|
|
DO IJ=1,KDO(4,JND)-2
|
|
IJQ=NFRO-IJ
|
|
FFRO(IJQ)=FFRO(NFRO)-FLOAT(IJ)*TIDO
|
|
END DO
|
|
else
|
|
TIDO=(FRB-FFRO(nfrb))*third
|
|
ffro(nfrb+1)=FFRO(nfrb)+tido
|
|
ffro(nfrb+2)=frb-tido
|
|
ffro(nfrb+3)=frb
|
|
nfro=nfrb+3
|
|
IFR1(ITR)=NLASTE+NFRO
|
|
I2ODF(I)=IFR1(ITR)-1
|
|
endif
|
|
DO IJ=1,NFRO
|
|
FREQ(NLASTE+IJ)=FFRO(NFRO-IJ+1)
|
|
END DO
|
|
W(NLASTE+NFRO)=HALF*(FREQ(NLASTE+NFRO-1)-FREQ(NLASTE+NFRO))
|
|
W(NLASTE+NFRO-1)=W(NLASTE+NFRO)
|
|
DO IJ=2,NFRO-2,2
|
|
TIDO=(FREQ(NLASTE+IJ)-FREQ(NLASTE+IJ+1))*THIRD
|
|
W(NLASTE+IJ-1)=W(NLASTE+IJ-1)+TIDO
|
|
W(NLASTE+IJ)=W(NLASTE+IJ)+4.*TIDO
|
|
W(NLASTE+IJ+1)=W(NLASTE+IJ+1)+TIDO
|
|
END DO
|
|
NLASTE=IFR1(ITR)
|
|
C
|
|
C set up internal frequencies & Stark parameters
|
|
C
|
|
CALL ODFFR(I,J)
|
|
OSC0(ITR)=0.
|
|
IS=NQUANT(I)
|
|
DO K=NQUANT(J),NLMX
|
|
CALL STARK0(IS,K,izzh,XKIJ(JND,K),WL0(JND,K),FIJ(JND,K))
|
|
OSC0(ITR)=OSC0(ITR)+FIJ(JND,K)
|
|
END DO
|
|
IF(INDEXP(ITR).NE.0) THEN
|
|
CALL IJALIS(ITR,IFRQ0,IFRQ1)
|
|
END IF
|
|
100 CONTINUE
|
|
C
|
|
NFREQ=NLASTE
|
|
RETURN
|
|
END
|