        subroutine PHOPR
      include 'SIZE.INC'
      include 'GLOBAL.INC'
      include 'LOCAL.INC'
      include 'UNITS.INC'
      include 'LOCAL1.INC'
      include 'LOCAL2.INC'
      include 'LOCAL3.INC'
        common /PRODUC/ IFORM, ION, I1, I2, I3, K, N1
        integer IFORM, ION, I1, I2, I3, K, N1
        double precision DTEMP
        real KOXL, K1O2L, TEMP2, TKEL
        integer I, II, J, KK
5000  format (1X,'WARNING: The product chemistry specifications for'/1X,
     &   50A1/1X,'include an invalid entry at location',I5)
      if (NPROCG(N1).eq.4) go to 100
      if (NPROCG(N1).eq.5) go to 160
      if (NPROCG(N1).eq.6) go to 220
      go to 280
100   continue
      if (RFORMG(N1).gt.28) go to 120
      do 110 J = 1, KOUNT
         TKEL = TCELG(J,NDAT)+273.15
         TEMP2 = YIELDG(N1)
         if (EAYLDG(N1).ne.0.0) TEMP2 = 10.**(YIELDG(N1)-((1000.*EAYLDG(
     &      N1))/(4.58*TKEL)))
         DTEMP = 0.0D+00
         DTEMP = TEMP2*KDPL(ION,J)*(MWTG(I2)/MWTG(I1))*QUANTG(IFORM,ION,
     &      I1)*ALPHA(I3,J,K)
         YIELDL(I2,I1,J) = YIELDL(I2,I1,J)+DTEMP
110   continue
      go to 290
120   continue
      IFORM = RFORMG(N1)-28
      do 150 J = 1, KOUNT
         TKEL = TCELG(J,NDAT)+273.15
         II = -2
         do 140 ION = 1, 7
            if (SPFLGG(ION,I1).eq.0) go to 130
            TEMP2 = YIELDG(N1)
            if (EAYLDG(N1).ne.0.0) TEMP2 = 10.**(YIELDG(N1)-((1000.*
     &         EAYLDG(N1))/(4.58*TKEL)))
            KK = 3*ION+II+IFORM-1
            DTEMP = 0.0D+00
            DTEMP = TEMP2*KDPL(ION,J)*(MWTG(I2)/MWTG(I1))*QUANTG(IFORM,
     &         ION,I1)*ALPHA(KK,J,K)
            YIELDL(I2,I1,J) = YIELDL(I2,I1,J)+DTEMP
130         continue
            II = II+1
140      continue
150   continue
      go to 290
160   continue
      if (RFORMG(N1).gt.28) go to 180
      do 170 J = 1, KOUNT
         TKEL = TCELG(J,NDAT)+273.15
         K1O2L = K1O2G(IFORM,ION,I1)
         if (EK1O2G(IFORM,ION,I1).ne.0.0) K1O2L = 10.**(K1O2G(IFORM,ION,
     &      I1)-((1000.*EK1O2G(IFORM,ION,I1))/(4.58*TKEL)))
         TEMP2 = YIELDG(N1)
         if (EAYLDG(N1).ne.0.0) TEMP2 = 10.**(YIELDG(N1)-((1000.*EAYLDG(
     &      N1))/(4.58*TKEL)))
         DTEMP = 0.0D+00
         DTEMP = TEMP2*K1O2L*(MWTG(I2)/MWTG(I1))*S1O2L(J)*ALPHA(I3,J,K)
         YIELDL(I2,I1,J) = YIELDL(I2,I1,J)+DTEMP
170   continue
      go to 290
180   continue
      IFORM = RFORMG(N1)-28
      do 210 J = 1, KOUNT
         II = -2
         TKEL = TCELG(J,NDAT)+273.15
         do 200 ION = 1, 7
            if (SPFLGG(ION,I1).eq.0) go to 190
            K1O2L = K1O2G(IFORM,ION,I1)
            if (EK1O2G(IFORM,ION,I1).ne.0.0) K1O2L = 10.**(K1O2G(IFORM,
     &         ION,I1)-((1000.*EK1O2G(IFORM,ION,I1))/(4.58*TKEL)))
            TEMP2 = YIELDG(N1)
            if (EAYLDG(N1).ne.0.0) TEMP2 = 10.**(YIELDG(N1)-((1000.*
     &         EAYLDG(N1))/(4.58*TKEL)))
            KK = 3*ION+II+IFORM-1
            DTEMP = 0.0D+00
            DTEMP = TEMP2*K1O2L*(MWTG(I2)/MWTG(I1))*S1O2L(J)*ALPHA(KK,J,
     &         K)
            YIELDL(I2,I1,J) = YIELDL(I2,I1,J)+DTEMP
190         continue
            II = II+1
200      continue
210   continue
      go to 290
220   continue
      if (RFORMG(N1).gt.28) go to 240
      do 230 J = 1, KOUNT
         TKEL = TCELG(J,NDAT)+273.15
         KOXL = KOXG(IFORM,ION,I1)
         if (EOXG(IFORM,ION,I1).ne.0.0) KOXL = 10.**(KOXG(IFORM,ION,I1)-
     &      ((1000.*EOXG(IFORM,ION,I1))/(4.58*TKEL)))
         TEMP2 = YIELDG(N1)
         if (EAYLDG(N1).ne.0.0) TEMP2 = 10.**(YIELDG(N1)-((1000.*EAYLDG(
     &      N1))/(4.58*TKEL)))
         DTEMP = 0.0D+00
         DTEMP = TEMP2*KOXL*(MWTG(I2)/MWTG(I1))*OXRADL(J)*ALPHA(I3,J,K)
         YIELDL(I2,I1,J) = YIELDL(I2,I1,J)+DTEMP
230   continue
      go to 290
240   continue
      IFORM = RFORMG(N1)-28
      do 270 J = 1, KOUNT
         II = -2
         TKEL = TCELG(J,NDAT)+273.15
         do 260 ION = 1, 7
            if (SPFLGG(ION,I1).eq.0) go to 250
            KOXL = KOXG(IFORM,ION,I1)
            if (EOXG(IFORM,ION,I1).ne.0.0) KOXL = 10.**(KOXG(IFORM,ION,
     &         I1)-((1000.*EOXG(IFORM,ION,I1))/(4.58*TKEL)))
            TEMP2 = YIELDG(N1)
            if (EAYLDG(N1).ne.0.0) TEMP2 = 10.**(YIELDG(N1)-((1000.*
     &         EAYLDG(N1))/(4.58*TKEL)))
            KK = 3*ION+II+IFORM-1
            DTEMP = 0.0D+00
            DTEMP = TEMP2*KOXL*(MWTG(I2)/MWTG(I1))*OXRADL(J)*ALPHA(KK,J,
     &         K)
            YIELDL(I2,I1,J) = YIELDL(I2,I1,J)+DTEMP
250         continue
            II = II+1
260      continue
270   continue
      go to 290
280   continue
      write (TTYOUT(MACHNO),5000) (CHEMNA(I,CHPARG(N1)),I=1,50),N1
      write (TTYOUT(MACHNO),5010)
5010  format (1X,'This entry has caused a code malfunction in PHOPR.')
290   continue
      return
      end
