        subroutine TRPROD(K)
      include 'SIZE.INC'
      include 'GLOBAL.INC'
      include 'LOCAL.INC'
      include 'UNITS.INC'
      include 'LOCAL1.INC'
      include 'LOCAL2.INC'
      include 'LOCAL3.INC'
        double precision DTEMP
        real KREDL, TEMP2, TKEL
        integer II, I4, III(NCHEM), J, K, KK, VRAIL
        integer IFORM, ION, I1, I2, I3, K3, N1
        common /PRODUC/ IFORM, ION, I1, I2, I3, K3, N1
5000  format (' WARNING: The product chemistry specifications for',/1X, 
     &   50A1)
5010  format (' include an invalid entry at location',I5,':')
      K3 = K
      do 100 I4 = 1, KCHEM
         III(I4) = VRAIL(CHEMNA(1,I4))
100   continue
      do 270 N1 = 1, NTRAN
         if (CHPARG(N1).ne.K) go to 270
         if (TPRODG(N1).gt.0.and.TPRODG(N1).le.KCHEM) go to 110
         write (TTYOUT(MACHNO),5000) (CHEMNA(I4,CHPARG(N1)),I4=1,III(N1)
     &      )
         write (TTYOUT(MACHNO),5010) N1
         write (TTYOUT(MACHNO),5020) TPRODG(N1)
         go to 270
5020  format (' The transformation product (TPROD) is chemical number', 
     &I5,','/' which is not part of the current simulation.')
110      continue
         if (NPROCG(N1).gt.0.and.NPROCG(N1).le.9) go to 120
         write (TTYOUT(MACHNO),5000) (CHEMNA(I4,CHPARG(N1)),I4=1,III(N1)
     &      )
         write (TTYOUT(MACHNO),5010) N1
         write (TTYOUT(MACHNO),5030) NPROCG(N1)
         go to 270
5030  format (' The process is numbered: ',I5,/' Valid process numbers a
     &re 1 -- 9 only.',/' Type HELP NPROC for more information.')
120      continue
         if (RFORMG(N1).gt.0.and.RFORMG(N1).le.32) go to 130
         write (TTYOUT(MACHNO),5000) (CHEMNA(I4,CHPARG(N1)),I4=1,III(N1)
     &      )
         write (TTYOUT(MACHNO),5010) N1
         write (TTYOUT(MACHNO),5040) RFORMG(N1)
5040  format (' The reactive chemical form is ',I5,/' Valid values of RF
     &ORM can be seen by typing "HELP RFORM."')
         go to 270
130      continue
         I1 = CHPARG(N1)
         I2 = TPRODG(N1)
         I3 = RFORMG(N1)
         if (I3.gt.28) go to 150
         ION = int((float(I3)+3.0)/4.0)
         if (SPFLGG(ION,K).ne.0) go to 140
         write (TTYOUT(MACHNO),5000) (CHEMNA(I4,CHPARG(N1)),I4=1,III(N1)
     &      )
         write (TTYOUT(MACHNO),5010) N1
         write (TTYOUT(MACHNO),5050)
         go to 270
5050  format (1X,'In that the reactive form (RFORMG) specifies'/1X,'a no
     &n-existent ionic species.'/1X,'This entry has been skipped.')
140      continue
         IFORM = 4-(4*ION-I3)
150      continue
         if (IFORM.ne.4.and.I3.ne.32) go to 160
         if (NPROCG(N1).eq.7.or.NPROCG(N1).eq.8) go to 160
         write (TTYOUT(MACHNO),5000) (CHEMNA(I4,CHPARG(N1)),I4=1,III(N1)
     &      )
         write (TTYOUT(MACHNO),5010) N1
         write (TTYOUT(MACHNO),5060)
5060  format (' in that a non-biological reaction is specified'/' from a
     & biosorbed chemical species.')
         go to 270
160      continue
         if (NPROCG(N1).gt.0.and.NPROCG(N1).le.3) go to 170
         if (NPROCG(N1).gt.3.and.NPROCG(N1).le.6) go to 180
         if (NPROCG(N1).eq.7.or.NPROCG(N1).eq.8) go to 190
         if (NPROCG(N1).eq.9) go to 200
         go to 260
170      continue
         call HYDPR
         go to 270
180      continue
         call PHOPR
         go to 270
190      continue
         call BIOPR
         go to 270
200      continue
         if (RFORMG(N1).gt.28) go to 220
         do 210 J = 1, KOUNT
            TKEL = TCELG(J,NDAT)+273.15
            KREDL = KREDG(IFORM,ION,I1)
            if (EREDG(IFORM,ION,I1).ne.0.0) KREDL = 10.**(KREDG(IFORM,
     &         ION,I1)-((1000.*EREDG(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*KREDL*(MWTG(I2)/MWTG(I1))*REDAGG(J,NDAT)*ALPHA
     &         (I3,J,K)
            YIELDL(I2,I1,J) = YIELDL(I2,I1,J)+DTEMP
210      continue
         go to 270
220      continue
         IFORM = RFORMG(N1)-28
         do 250 J = 1, KOUNT
            II = -2
            TKEL = TCELG(J,NDAT)+273.15
            do 240 ION = 1, 7
               if (SPFLGG(ION,I1).eq.0) go to 230
               KREDL = KREDG(IFORM,ION,I1)
               if (EREDG(IFORM,ION,I1).ne.0.0) KREDL = 10.**(KREDG(IFORM
     &            ,ION,I1)-((1000.*EREDG(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*KREDL*(MWTG(I2)/MWTG(I1))*REDAGG(J,NDAT)*
     &            ALPHA(KK,J,K)
               YIELDL(I2,I1,J) = YIELDL(I2,I1,J)+DTEMP
230            continue
               II = II+1
240         continue
250      continue
         go to 270
260      continue
         write (TTYOUT(MACHNO),5000) (CHEMNA(I4,CHPARG(N1)),I4=1,III(N1)
     &      )
         write (TTYOUT(MACHNO),5010) N1
         write (TTYOUT(MACHNO),5070)
5070  format (1X,'This entry has caused a code malfunction in TRPROD.')
         go to 270
270   continue
      return
      end
