ADAS Subroutine rpengv

       SUBROUTINE RPENGV(IZ,WI,EI,WJ,EJ,N,LI,LJ,PHI,TV,TEV,DENS,TAU,EM,
     &IZC,QI,QJ,GA)
       IMPLICIT REAL*8(A-H,O-Z)
C-----------------------------------------------------------------------
C  PURPOSE: CALCULATES PENGELLY & SEATON (1964) COLLISION RATES BETWEEN
C           NEARLY DEGENERATE LEVELS.
C
C  A VARIATION OF IMPACT PARAMETER THEORY FOR DIPOLE TRANSITIONS IS USED.
C  ************** H.P.SUMMERS,JET   2 DEC 1984  ***********************
C  *** CORRECTIONS 13/5/85
C  INPUT
C      IZ=TARGET ION CHARGE
C      WI=STATISTICAL WEIGHT OF STATE I (FULL WEIGHTING INCLUDING SPIN)
C      EI=BINDING ENERGY OF STATE I (RYD)
C      WI=STATISTICAL WEIGHT OF STATE J
C      EJ=BINDING ENERGY OF STATE J (RYD)
C      PHI=FIJ/EIJ (=SIJ/WI) WITH FIJ=ABSORPTION OSCILLATOR STRENGTH
C                                 EIJ=TRANSITION ENERGY (RYDBERGS)
C                                 SIJ=LINE STRENGTH (AT. UNITS)
C      TV=TEMPERATURE(EV)   (COLLIDING PARTICLE DISTRIBUTION)
C      TEV=TEMPERATURE(EV)  (ELECTRON DISTRIBUTION)
C      DENS=ELECTRON DENSITY (CM-3)
C      TAU=MEAN RADIATIVE LIFETIME OF INITIAL AND FINAL LEVELS (SEC)
C      EM=REDUCED MASS FOR COLLIDING PARTICLE (ELECTRON MASSES)
C      IZC=CHARGE OF COLLIDING PARTICLE
C  OUTPUT
C      QI=EXCITATION RATE COEFFICIENT (CM**3 SEC-1)
C      QJ=DEEXCITATION RATE COEFFICIENT
C      GA=GAMMA RATE PARAMETER
C-----------------------------------------------------------------------
C VERSION  : 1.1
C DATE     : 18-03-1999
C MODIFIED : ???
C
C VERSION  : 1.2
C DATE     : 05-10-2000
C MODIFIED : ???
C             - Removed junk from columns > 72
C
C VERSION  : 1.3
C DATE     : 16-05-2007
C MODIFIED : Allan Whiteford
C             - Updated comments as part of subroutine documentation
C               procedure.
C
C-----------------------------------------------------------------------
       T=1.16054D4*TV
       TE=1.16054D4*TEV
       ATP=1.5789D5/T
       Z1=IZ+1
       ZC=IZC
       XN=N
       XLI=LI
       XLJ=LJ
       XL=0.5D0*(XLI+XLJ)
       DNL=6.0D0*(ZC*XN/Z1)**2*(XN*XN-XL*XL-XL-1.0D0)
       EIJ=DABS(EI-EJ)
       TAU1=1.0D10
       IF(EIJ.GT.0.0D0)TAU1=7.53D-17/EIJ
       IF(TAU1-TAU)3,3,2
    2  TAU1=TAU
       IND1=0
       GO TO 4
    3  IND1=1
C  IND1=0 INDICATES FINITE RADIATIVE LIFETIME CUT-OFF
C      =1 INDICATES BETHE CUT-OFF
    4  F1=1.68+DLOG10(TE/DENS)
       F=10.95+DLOG10(T*TAU1*TAU1/EM)
C**    WRITE(6,100)TAU,TAU1,IND1,F,F1
  100  FORMAT(1H0,'CHECK OUTPUT FROM RPENGV'/
     &1H ,'TAU =',1PD10.2,3X,'TAU1 =',1PD10.2,3X,'IND1 =',I3,3X,
     &'F =',1PD10.2,3X,'F1 =',1PD10.2)
       IF(F-F1)8,8,9
    8  IND2=0
       GO TO 10
    9  F=F1
       IND2=1
C  IND2=0 INDICATES LIFETIME OR BETHE CUTOFF USED IN RATE
C      =1 INDICATES DEBYE CUT-OFF USED IN RATE
   10  B=11.54+DLOG10(T/(DNL*EM))+F
C**    WRITE(6,101)EIJ,DNL,T,EM,B,F
  101  FORMAT(1H ,'EIJ =',1PD10.2,3X,'DNL =',1PD10.2,3X,'T =',1PD10.2,
     &3X,'EM =',1PD10.2,3X,'B =',1PD10.2,3X,'F =',1PD10.2)
       IF(B-1.0D0)14,14,15
   14  IF(B.GT.0.0D0.AND.IND2.EQ.1)GO TO 15
       IF(B.GT.0.0D0.AND.IND1.EQ.0)GO TO 15
       QI=0.0D0
       GO TO 16
   15  QI=7.94D-5*DSQRT(EM/T)*ZC*ZC*PHI*B
   16  QJ=WI*QI/WJ
       GA=4.604D7*WJ*QJ/DSQRT(ATP)
       RETURN
      END
      INTEGER             IZ,          IZC,         LI,          LJ
      INTEGER             N
      REAL*8              DENS,        EI,          EJ,          EM
      REAL*8              GA,          PHI,         QI,          QJ
      REAL*8              TAU,         TEV,         TV,          WI
      REAL*8              WJ