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