ADAS Subroutine qpr78

       FUNCTION QPR78(Z1,N1,N2,E1,PHI)                                  
C
       IMPLICIT REAL*8(A-H,O-Z)                                        
C
C-----------------------------------------------------------------------
C
C  ****************** FORTRAN77 FUNCTION: QPR78 ************************
C
C-----------------------------------------------------------------------
C  PURPOSE: CALCULATES ELECTRON COLLISION CROSS-SECTIONS FOR
C           TRANSITIONS BETWEEN PRINCIPAL QUANTUM SHELLS IN
C           HYDROGEN AND HYDROGENIC IONS.                  
C
C  PERCIVAL AND RICHARDS-MNRAS(1978)183,329.                           
C
C  VALID FOR INCIDENT ELECTRON ENERGIES IN RANGE (Z1/N1)**2<E1<137**2   
C  AND FOR N1,N2>4.                                                    
C  ANOMALIES DEVELOP IN ORIGINAL SPECIFICATION OF PERCIVAL RICHARDS FOR 
C  S=N2-N1 LARGE OR IF N1 IS <5.  HENCE A MODIFIED PRESCRIPTION IS USED
C  IN THESE CASES CONSISTENT WITH BANKS ET AL (1973) ASTR. LETT 14,161
C                                                                    
C                                                                   
C  INPUT                                                           
C      Z1=TARGET ION CHARGE +1                                    
C      N1=INITIAL PRINCIPAL QUANTUM NUMBER                       
C      N2=FINAL PRINCIPAL QUANTUM NUMBER                        
C      E1=ENERGY OF INCIDENT ELECTRON IN RYDBERGS              
C                                                             
C  OUTPUT                                                    
C      QPR78=CROSS-SECTION IN PI*A0**2 UNITS                
C                                                          
C                                                         
C  ***********  H.P.SUMMERS, JET          12 NOV 1984        ***********
C  ****                              COR  28 FEB 1990               **** 
C-----------------------------------------------------------------------
C NOTES: THIS ROUTINE IS NOT YET PROPERLY ANNOTATED
C
C UNIX-IDL PORT:
C
C VERSION: 1.1                          DATE: 16-1-96
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C               - FIRST VERSION
C
C VERSION: 1.2                          DATE: 16-05-07
C MODIFIED: Allan Whiteford
C             - Updated comments as part of subroutine documentation
C               procedure.
C
C-----------------------------------------------------------------------
C
       ZZ1=Z1*Z1                                                        
       E=E1                                                            
       EN1=N1                                                         
       EN2=N2                                                        
       ABET=4.0D0*ZZ1*PHI/(EN1**4)                                  
       T1=1.0D0                                                    
       IF(N1-N2)3,1,2                                             
    1  QPR78=0.0D0                                               
       RETURN                                                   
    2  E2=E1-ZZ1*(1.0D0/(EN1*EN1)-1.0D0/(EN2*EN2))             
       T1=(EN2*EN2*E2)/(EN1*EN1*E1)                           
       EN1=N2                                                
       EN2=N1                                               
       E=E2                                                
    3  S=EN2-EN1                                          
       EN12=EN1*EN2                                      
       IF(N1.LT.5.OR.S.GT.10.0D0)GO TO 4                
       A=2.666667D0/S*(EN2/(S*EN1))**3*(0.184D0-0.04/S**0.66667D0)*(1.0 
     &D0-0.2D0*S/EN12)**(1.0D0+2.0D0*S)                                
       D=DEXP(-ZZ1/(EN12*E*E))                                        
       F=(1.0D0-0.3D0*S*D/EN12)**(1.0D0+2.0D0*S)   
       Y=1.0D0/(1.0D0-D*DLOG(18.0D0*S)/(4.0D0*S))   
       GO TO 5                                       
    4  A=ABET                                         
       D=DEXP(-Z1/(EN1*E))                             
C      D=DEXP(-ZZ1/(EN12*E*E))                          
       F=1.0D0-D                                         
       Y=1.0D0                                            
    5  XL=DLOG((1.0D0+0.53D0*E*E*EN12/ZZ1)/(1.0D0+0.4D0*E))
       G=0.5D0*(E*EN1*EN1/(Z1*EN2))**3                      
       T=DSQRT(2.0D0-(EN1/EN2)**2)                           
       XP=2.0D0*Z1/(E*EN1*EN1*(T+1.0D0))                      
       XM=2.0D0*Z1/(E*EN1*EN1*(T-1.0D0))                       
       CP=(XP*XP/(2.0D0*Y+1.5D0*XP))*DLOG(1.0D0+0.66667D0*XP)   
       CM=(XM*XM/(2.0D0*Y+1.5D0*XM))*DLOG(1.0D0+0.66667D0*XM)    
       H=CM-CP                                                    
       QPR78=T1*EN1**4*(A*D*XL+F*G*H)/(E*ZZ1)                      
       RETURN                                                       
       END                                                            
      INTEGER             N1,          N2
      REAL*8              E1,          PHI,         Z1