SUBROUTINE CMPO2O
      implicit none
C     ****
C     ****     CALCULATES FS ARRAY WHICH GIVES SOURCES AND SINK FOR COMP
C     ****
      include "params.h"
      include "blnk.h"
      include "vscr.h"
      include "cons.h"
      include "index.h"
      include "buff.h"
      include "crates.h"
      real :: rmn4s,rmn2d,rmno,brn2d,cee
      COMMON/MASS/RMN4S,RMN2D,RMNO,BRN2D,CEE
!
! Local:
      integer :: nrjk,nqo2pk,nqopk,k,i,nps1k,nps2k,nmsk,nopk,npnok,
     |  npn4sk,npn2dk,no2pk,nn2pk,nnpk,nnopk,nek,ntk
C     ****
C     ****  CALCULATE FS ARRAY FOR COMP
C     ****
      NRJK = NRJ-1
      NQO2PK = NQO2P-1
      NQOPK = NQOP-1
      DO 1 K=1,KMAX
      NRJK = NRJK+1
      NQO2PK = NQO2PK+1
      NQOPK = NQOPK+1
      DO 1 I=1,LEN1
C     ****
C     ****     S15 = EXPS       (K+1/2)
C     ****
      S15(I,K) = EXPS(K)
      S12(I,K) = 0.5*(F(I,NRJK)+F(I,NRJK+1))
      S11(I,K) = 0.5*(F(I,NQO2PK)+F(I,NQO2PK+1))
      S9(I,K) = 0.5*(F(I,NQOPK)+F(I,NQOPK+1))
    1 CONTINUE
C     ****
C     ****     SOURCES
C     ****
      NPS1K = NJ+NPS
      NPS2K = NPS1K+KMAXP1
      NMSK = NJ+NMS
      NOPK = NJ+NOP
      NPNOK = NJ+NPNO
      NPN4SK = NJ+NPN4S
      NPN2DK = NJ+NPN2D
      NO2PK = NJ+NO2P
      NN2PK = NN2P
      NNPK = NNP
      NNOPK = NNOP
      NEK = NJ+NE
      NTK = NJ+NT
      DO 2 I=1,LEN2
C     ****
C     ****     S15 = N*MBAR  (K+1/2)
C     ****
      S15(I,1) = S15(I,1)*C(81)/(C(84)*F(I,NTK)*(F(I,NPS1K)/RMASS(1)+
     1           F(I,NPS2K)/RMASS(2)+(1.-F(I,NPS1K)-F(I,NPS2K))
     2           /RMASS(3)))
C     ****
C     ****     P(OX)=S1(I,1)+S2(I,1)*N(O2) IS THE PRODUCTION OF OX
C     ****
      S1(I,1) = S15(I,1)**2*(BETA3(I,1)*F(I,NPN4SK)/RMN4S*F(I,NPNOK)
     1          /RMNO+BETA6(I,1)*F(I,NPN2DK)/RMN2D*F(I,NPNOK)/RMNO)
     2          +0.5*(BETA8(I,1)+BETA8(I+LEN1,1))*F(I,NPNOK)/RMNO
     3           *S15(I,1)+S15(I,1)*(RK4(I,1)*F(I,NO2PK)*F(I,NPN4SK)
     4           /RMN4S+RK10(I,1)*F(I,NOPK)*F(I,NPN2DK)/RMN2D)
     4           +(RA1(I,1)*F(I,NNOPK)+2.*RA2(I,1)*F(I,NO2PK))
     5           *SQRT(F(I,NEK)*F(I,NEK+1))
      S2(I,1) = S15(I,1)*(BETA1(I,1)*F(I,NPN4SK)/RMN4S+BETA2(I,1)
     1     *F(I,NPN2DK)/RMN2D)+RK1(I,1)*F(I,NOPK)+RK7(I,1)*
     2     F(I,NNPK)+ 2.*S12(I,1)
C     ****
C     ****     L(OX)=S3(I,1)*N(OX)**2+S4(I,1)*N(OX)+S5
C     ****
      S3(I,1) = 2.*RKM12(I,1)*S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1)))
      S4(I,1) = RK3(I,1)*F(I,NN2PK)+RK8(I,1)*F(I,NNPK)
      S5(I,1) = S9(I,1)
C     ****
C     ****     P(O2)=S6(I,1)*N(OX)**2+S9(I,1)*N(OX)+S10(I,1)
C     ****
      S6(I,1) = RKM12(I,1)*S15(I,1)/(.5*(F(I,NMSK)+F(I,NMSK+1)))
      S9(I,1) =0.
      S10(I,1) = RK5(I,1)*F(I,NPNOK)/RMNO*F(I,NO2PK)*S15(I,1)
C     ****
C     ****     L(O2)=S13(I,1)*N(O2)+S14(I,1)
C     ****
      S13(I,1) = S15(I,1)*
     1          (BETA1(I,1)*F(I,NPN4SK)/RMN4S+BETA2(I,1)*F(I,NPN2DK)
     2     /RMN2D)+RK1(I,1)*F(I,NOPK)+(RK6(I,1)+RK7(I,1))*
     3     F(I,NNPK)+RK9(I,1)*F(I,NN2PK)+S12(I,1)
      S14(I,1) = S11(I,1)
C     ****
C     ****   MATRIX COEFFICIENTS FOR O-O2-N2 SOLUTION
C     ****
C     ****     NOW CALCULATE CONTRIBUTIONS TO FS ARRAY
C     ****
        FS(I,1,1,1) = -S13(I,1)
        FS(I,1,1,2) = S15(I,1)*S6(I,1)*F(I,NPS2K)/RMASS(2)*RMASS(1)
     1                /RMASS(2)
        FS(I,1,2,1) = S2(I,1)*RMASS(2)/RMASS(1)
        FS(I,1,2,2) = -S4(I,1)-S3(I,1)*F(I,NPS2K)/RMASS(2)*S15(I,1)
        FS(I,1,1,0) = (S10(I,1)-S14(I,1))*RMASS(1)/S15(I,1)
        FS(I,1,2,0) = (S1(I,1)-S5(I,1))*RMASS(2)/S15(I,1)
    2 CONTINUE
      RETURN
      END
C