98 lines
2.5 KiB
Fortran
98 lines
2.5 KiB
Fortran
SUBROUTINE ODFFR(IL,IU)
|
|
C =======================
|
|
C
|
|
C Internal frequencies set for opacity distribution function
|
|
C for overlapping lines near the series limit
|
|
C
|
|
C The lines converge to the edge of the (continuum) transition IL - IU,
|
|
C IL - index of the lower level
|
|
C IU - index of the upper level (usually the ground state of the next ion)
|
|
C or a mean level in the line ODF formalism
|
|
C
|
|
C Output: FROS - set of internal frequencies
|
|
C in common ODFFRQ
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
PARAMETER (FRH=3.28805D15,CDOP=2.84511D-7,CDOM=14.)
|
|
PARAMETER (SIX=6.,SEPT=7.)
|
|
DIMENSION FFRO(MFRO)
|
|
C
|
|
CH=IZ(IEL(IL))*IZ(IEL(IL))
|
|
FRION=CH*FRH
|
|
FRE=ENION(IL)/H
|
|
NF=1
|
|
NQ1=NQUANT(IU)
|
|
XL2=UN/(NQUANT(IL)*NQUANT(IL))
|
|
XU1=UN/((NQUANT(IU)-1)*(NQUANT(IU)-1))
|
|
XU2=UN/(NQUANT(IU)*NQUANT(IU))
|
|
FRC=FRION*(XL2-XU2)
|
|
FFRO(NF)=HALF*(FRC+FRION*(XL2-XU1))
|
|
KT=ITRA(IL,IU)
|
|
KL=JNDODF(KT)
|
|
DOPO=CDOP*SQRT(TEFF)*FRC
|
|
DOPM=CDOM*DOPO
|
|
FR1=FFRO(1)
|
|
C
|
|
DO I=NQ1,NLMX
|
|
II=I*I
|
|
FR2=FRE-FRION/II
|
|
DF=FR2-FR1
|
|
IF(DF.GT.DOPM) THEN
|
|
DO J=1,7
|
|
NF=NF+1
|
|
FFRO(NF)=FR1+J*DOPO
|
|
END DO
|
|
DF=FR2-SEPT*DOPO-FFRO(NF)
|
|
NI=int(DF/SIX/DOPO)
|
|
DDF=DF/(NI+1)
|
|
DO J=1,NI
|
|
NF=NF+1
|
|
FFRO(NF)=FR1+SEPT*DOPO+J*DDF
|
|
END DO
|
|
DO J=7,0,-1
|
|
NF=NF+1
|
|
FFRO(NF)=FR2-J*DOPO
|
|
END DO
|
|
FR1=FR2
|
|
ELSE
|
|
NI=int(DF/DOPO)
|
|
DDF=DF/(NI+1)
|
|
DO J=1,NI
|
|
NF=NF+1
|
|
if(nf.gt.mfro-3) then
|
|
nf=nf-1
|
|
go to 10
|
|
end if
|
|
FFRO(NF)=FR1+J*DDF
|
|
END DO
|
|
NF=NF+1
|
|
FFRO(NF)=FR2
|
|
FR1=FR2
|
|
END IF
|
|
END DO
|
|
10 CONTINUE
|
|
NF=NF+1
|
|
FFRO(NF)=FRE*0.999999999
|
|
NFRODF(KL)=NF
|
|
if(nf.gt.mfro)
|
|
* CALL QUIT('too many points for hydrogen ODF - nf.gt.mfro',
|
|
* nf,mfro)
|
|
DO I=1,NF
|
|
FROS(I,KL)=FFRO(NF-I+1)
|
|
END DO
|
|
C
|
|
C Associated weights
|
|
C
|
|
WNUS(1,KL)=HALF*(FROS(1,KL)-FROS(2,KL))
|
|
WNUS(NF,KL)=HALF*(FROS(NF-1,KL)-FROS(NF,KL))
|
|
DO I=2,NF-1
|
|
WNUS(I,KL)=HALF*(FROS(I-1,KL)-FROS(I+1,KL))
|
|
END DO
|
|
C
|
|
RETURN
|
|
END
|