      SUBROUTINE RATES
C     ****
C     ****     COMPUTES NEEDED REACTION RATES IN COMMON BLOCK/RATES/
C     ****
      include "params.h"
      include "blnk.h"
      include "vscr.h"
      include "cons.h"
      include "index.h"
      include "buff.h"
      include "phys.h"
      include "crates.h"
      NTEK=NJ+NTE
      NTIK=NJ+NTI
      NTK=NJ+NT
      NNO2K=NNO2
      NNVO2K=NNVO2
      DO 1 I=1,LEN2
C     ****
C     ****     S15 = T1/300.    S14 = T2/300.    S13 = TR/300.
C     ****
      S15(I,1)=(0.667*F(I,NTIK)+0.333*F(I,NTK))/300.
      S14(I,1)=(0.6363*F(I,NTIK)+0.3637*F(I,NTK))/300.
      S13(I,1)=.5*(F(I,NTIK)+F(I,NTK))/300.
C     ****
C     ****     K1   (ASSUMES T1/300 IN S15)
C     ****
C     RK1(I,1)=(((9.65E-16*S15(I,1)-5.17E-14)*S15(I,1)+1.073E-12)*
C    1S15(I,1)-7.74E-12)*S15(I,1)+2.82E-11
C     ****
C     **** NEW RATE COEFFICIENT FOR O+ + O2 -> O + O2+
C     ****
C     RK1(I,1)=1.7E-11*(300./F(I,NTK))**0.77+8.54E-11*EXP(-3467./
C    1         F(I,NTK))
C     **** NEW RATE COEFFICIENT FOR O+ + O2 -> O + O2+ (HIERL)
C     ****
      RK1(I,1)=1.6E-11*S15(I,1)**(-0.52)+5.5E-11*EXP(-22.85/S15(I,1))
C     ****
C     ****     K2   (ASSUMES T2/300 IN S14)
C     ****
      RK2(I,1)=(8.6E-14*S14(I,1)-5.92E-13)*S14(I,1)+1.533E-12
C     ****
C     **** NEW RATE COEFFICIENT FOR O+ + N2 -> N + NO+
C     ****
C     ****
C     S5(I,1) = EXP(-3353./TVIB(I,1))
C     RK2(I,1) = (((((270.*S5(I,1)+220.)*S5(I,1)+85.)*S5(I,1)+38.)
C    1           *S5(I,1)+1.)*RK2(I,1)*S5(I,1)+RK2(I,1))
C    2           *(1.-S5(I,1))
C     ****
C     ****
C     ****
C     ****     K3   (ASSUMES TR/300 IN S13)
C     ****
      RK3(I,1)=merge(5.2E-11*S13(I,1)**0.2,1.4E-10*S13(I,1)**(-0.44),
     1300.*S13(I,1)-1500.>=0.)
C     ****
C     ****     K4 THRU K10
C     ****
      RK4(I,1)=1.0E-10
      RK5(I,1)=4.4E-10
      RK6(I,1)=4.0E-10
      RK7(I,1)=2.0E-10
      RK8(I,1)=1.0E-12
      RK9(I,1)=6.0E-11
      RK10(I,1)=1.3E-10
      RK16(I,1) = 4.8E-10
      RK17(I,1) = 1.0E-10
      RK18(I,1) = 4.0E-10
      RK19(I,1) = 4.0E-8*SQRT(300./F(I,NTEK))
      RK20(I,1) = 1.5E-7*SQRT(300./F(I,NTEK))
      RK21(I,1) = 0.047
      RK22(I,1) = 0.171
      RK23(I,1) = 8.E-10
      RK24(I,1) = 5.0E-12
      RK25(I,1) = 6.6E-8*SQRT(300./F(I,NTEK))
      RK26(I,1) = 7.E-10
      RK27(I,1) = 7.7E-5
      RKM12(I,1) = 9.59E-34*EXP(480./F(I,NTK))
C     ****
C     ****     RATES ALF1 THRU ALF3 (INVOLVE ELECTRON TEMPERATURE AND
C     ****     ASSUME NTEK HAS APPROPRIATE VALUE)
C     ****
      RA1(I,1)=4.2E-7*(300./F(I,NTEK))**0.85
      RA2(I,1)=merge(1.6E-7*(300./F(I,NTEK))**0.55,2.7E-7*(300./
     1F(I,NTEK))**0.7,F(I,NTEK)-1200.>=0.)
      RA3(I,1)=1.8E-7*(300./F(I,NTEK))**0.39
      BETA1(I,1) = 1.5E-11*EXP(-3600./F(I,NTK))
      BETA2(I,1)=5.0E-12
C     BETA3(I,1) = 1.6E-10*EXP(-460./F(I,NTK))
      BETA3(I,1) = 2.5E-10*SQRT(F(I,NTK)/300.)*EXP(-600./
     1             F(I,NTK))
C     ****
C     ****     SET BETA4
C     ****
      BETA4(I,1) = 6.9E-13
C     ****
C     ****     MIGHT BE OF FORM :
C     ****     BETA4 = FUNCTION(T)
C     ****     IN CODE THIS WOULD BE
C     ****     BETA4(I,1)=FUNCTION(F(I,NTK))
C     ****
      BETA5(I,1)=3.6E-10*SQRT(F(I,NTEK)/300.)
      BETA6(I,1)=7.0E-11
      BETA7(I,1)=1.06E-5
      BETA8(I,1)=4.5E-6*(1.+0.11*(C(61)-65.)/165.)*EXP(-1.E-8*
     1F(I,NNO2K)**0.38)
      BETA9(I,1)=2.91E11*(1.+0.2*(C(61)-65.)/100.)*2.E-18*EXP(-8.E-21*
     1F(I,NNO2K))
      BETA9N(I,1)=5.E9*(1.+0.2*(C(61)-65.)/100.)*2.E-18*EXP(-8.E-21*
     1F(I,NNVO2K))
      BETA17(I,1)=1.E-32*SQRT(300./F(I,NTEK))
    1 CONTINUE
      DO 2 I=1,LEN1
      BETA8(I,KMAXP1)=4.5E-6*(1.+0.11*(C(61)-65.)/165.)*EXP(-1.E-8*
     1F(I,NNO2K+KMAX)**0.38)
      BETA9(I,KMAXP1)=2.91E11*(1.+0.2*(C(61)-65.)/100.)*2.E-18*
     1EXP(-8.E-21*F(I,NNO2K+KMAX))
      BETA9N(I,KMAXP1)=5.E9*(1.+0.2*(C(61)-65.)/100.)*2.E-18*
     1EXP(-8.E-21*F(I,NNVO2K+KMAX))
    2 CONTINUE
c     call addfsech('RK2',rk2,zimxp,zkmxp,kmax,j)
c     call addfsech('RK1',rk1,zimxp,zkmxp,kmax,j)
      RETURN
      END
C
