Search Site | Contact Details | FAQ

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                                                               
© Copyright 1995-2018 The ADAS Project
Comments and questions to: adas-at-adas.ac.uk