ADAS Subroutine dipsum
C
REAL FUNCTION DIPSUM*8(JZ,L,E1,E2)
IMPLICIT REAL*8(A-H,O-Z)
C
C PURPOSE: Calculates a Burgess Dipole Sum.
C
C CALCULATES THE SUM GIVEN IN EQUATIONS (10) AND (11) OF A. BURGESS,
C J. PHYS. B7,?,1974. SET JZ TO ZERO FOR THE ZERO CHARGE (NEUTRAL
C ATOM) CASE. SET L TO THE LOWER LIMIT OF SUMMATION (MUST BE GREATER
C THAN ZERO). SET E1=(KAPPA1)**2 FOR NON ZERO CHARGE, =(K1)**2
C FOR ZERO CHARGE. SET E2=(KAPPA2)**2 FOR NON ZERO CHARGE,
C =(K2)**2 FOR ZERO CHARGE.
C-----------------------------------------------------------------------
C
C VERSION : 1.1
C DATE : ?
C MODIFIED : H P Summers
C - Initial version.
C
C VERSION : 1.2
C DATE : 16-05-2007
C MODIFIED : Allan Whiteford
C - Remove listing information from colums 72+.
C - Updated comments as part of subroutine documentation
C procedure.
C-----------------------------------------------------------------------
L1=L
L2=L-1
IF(JZ)1,2,1
1 F1=R8FDIP(E1,L1,E2,L2)
F2=R8FDIP(E1,L2,E2,L1)
EL=L
DIPSUM=(F1-F2)*(F1+F2)*(1.0+EL*EL*E1)/(EL*(E1-E2))
RETURN
2 F1=R8FDIP0(E1,L1,E2,L2,1.0D-12)
F2=R8FDIP0(E1,L2,E2,L1,1.0D-12)
EL=L
DIPSUM=(F1-F2)*(F1+F2)*EL*E1/(E1-E2)
RETURN
END