ADAS Subroutine r8fdip2
C
REAL*8 FUNCTION R8FDIP2(E1,L1,E2,L2)
IMPLICIT REAL*8(A-H,O-Z)
C-----------------------------------------------------------------------
C
C ****************** FORTRAN77 FUNCTION: R8FDIP2 **********************
C
C PURPOSE: CALCULATES THE DIPOLE INTEGRAL I(KAPPA1,L1,KAPPA2,L2,1) FOR
C WHERE MIN(E1,E2)/EMAX(E1,E2) > 0.03
C
C NOTE: CREATED BY ALAN BURGESS FOR USE IN THE DIPOLE INTEGRAL
C I(KAPPA1,L1,KAPPA2,L2,1) EVALUATION AS DEFINED IN PHIL.
C TRANS. ROY. SOC. A226,255,1970, WHERE E1=KAPPA1**2 AND
C E2=KAPPA2**2. APPLIES TO POSITIVE ELECTRON ENERGIES, .
c THAT IS THE FREE-FREE CASE.
C
C CALLING PROGRAMS: R8FDIP
C
C INPUT: (R*8) E1 = KAPPA1**2 WHERE KAPPA1 IS SCALED INITIAL
C ELECTRON WAVE NUMBER
C INPUT: (I*4) L1 = ORBITAL ANGULAR OMENTUM OF INITIAL ELECTRON
C INPUT: (R*8) E2 = KAPPA2**2 WHERE KAPPA2 IS SCALED INITIAL
C ELECTRON WAVE NUMBER
C INPUT: (I*4) L2 = ORBITAL ANGULAR OMENTUM OF FINAL ELECTRON
C
C OUTPUT: (R*8) R8FDIP2 = I(KAPPA1,L1,KAPPA2,L2,1)
C
C ROUTINES:
C ROUTINE SOURCE BRIEF DESCRIPTION
C -------------------------------------------------------------
C ARGAM ADAS CALCULATES ARGGAMMA(L+1+I*A)
C
C UNIX-IDL PORT:
C
C VERSION: 1.1 DATE: 17-04-07
C MODIFIED: HUGH SUMMERS
C - FIRST FULLY COMMENTED RELEASE
C
C-----------------------------------------------------------------------
WMAX=200.0D0
ETA1=1.0D0/DSQRT(E1)
ETA2=1.0D0/DSQRT(E2)
W1=ETA2-ETA1
PI=3.141592653589793D0
A=DABS(W1)
B=PI*A
IF(B-0.01D0)1,1,2
1 C=3.0D0/(3.0D0-B*(3.0D0-B*(2.0D0-B)))
C=DSQRT(C)
GO TO 5
2 IF(B-14.0D0)4,3,3
3 C=DSQRT(B+B)
GO TO 5
4 B=B+B
C1=1.0D0-DEXP(-B)
C=DSQRT(B/C1)
5 C=0.5D0*C/DSQRT(ETA1*ETA2)
C2=ETA1+ETA2
C1=4.0D0*ETA1*ETA2/(C2*C2)
L=L1
IF(L2-L1)6,6,7
6 L=L2
T1=ETA1
ETA1=ETA2
ETA2=T1
W1=-W1
7 C=C*C1**(L+1)
U0=L+1
U1=ETA1
V0=U0
V1=-ETA2
W0=1.0D0
X0=W1/(C2*C2)
Y2=-ETA2-ETA2
Y0=-U0*W1+Y2
Y1=ETA2*W1
T1=X0/(1.0D0+W1*W1)
Z0=U0*T1
Z1=U1*T1
T=Z0-Z1*W1
Z1=Z0*W1+Z1
Z0=T
Q0=-1.0D0+Z0*Y0-Z1*Y1
Q1=Z0*Y1+Z1*Y0
X=W1*X0
8 U0=U0+1.0D0
V0=V0+1.0D0
W0=W0+1.0D0
IF(W0-WMAX)21,21,20
20 R8FDIP2=0.0D0
RETURN
21 CONTINUE
Y0=Y0+Y2
T=Z0*U0-Z1*U1
Z1=Z0*U1+Z1*U0
Z0=T
T=Z0*V0-Z1*V1
Z1=Z0*V1+Z1*V0
Z0=T
T=Z0*W0-Z1*W1
Z1=Z0*W1+Z1*W0
Z0=T
X0=X/(W0*(W0*W0+W1*W1))
Z0=Z0*X0
Z1=Z1*X0
T0=Z0*Y0-Z1*Y1
T1=Z0*Y1+Z1*Y0
Q0=Q0+T0
Q1=Q1+T1
T1=T0*T0+T1*T1
T0=Q0*Q0+Q1*Q1
IF(T0-1.0D24*T1)8,8,9
9 J1=0
J2=L+1
P=ARGAM(J1,W1)+ARGAM(L,ETA1)-ARGAM(J2,ETA2)
IW0=W0
IF(A-1.0D-40)11,11,10
10 P=P+W1*DLOG(C2/A)
11 P0=DCOS(P)
P1=DSIN(P)
T=P0*Q0-P1*Q1
Q1=P0*Q1+P1*Q0
Q0=T
R8FDIP2=C*Q1
RETURN
END
INTEGER L1, L2
REAL*8 E1, E2