      subroutine FIRORD
      include 'SIZE.INC'
      include 'GLOBAL.INC'
      include 'LOCAL.INC'
      include 'UNITS.INC'
      include 'LOCAL1.INC'
      include 'LOCAL2.INC'
      include 'LOCAL3.INC'
        real OUT(9), LNTWO
        real INTOUL(NPX), KO2L(NPX), LIGHTL(NPX), FACTOR
        integer I, IOUT, J, K, LAMKNT, III, IV, VRAIL, N1
        integer IEND
        logical MEAN, print
        character KOUT(2)*2, OUTLIN*64
        character NMON*4, TAG*3, BLANK*1
        data BLANK/' '/, LNTWO/0.69314718/
5000  format ('1','Exposure Analysis Modeling System -- EXAMS Version ',
     &   F4.2,', Mode',I2/' Ecosystem: ',50A1)
5010  format (' Chemical:  ',50A1)
5020  format (1X,63('-'))
5030  format (3X,'* Segment types: Littoral, Epilimnetic, Hypolimnetic,'
     &,' Benthic')
      print = .true.
      if (PRSWG.eq.0.and.NDAT.ne.12) print = .false.
      MEAN = .false.
      if (PRSWG.eq.0.or.MODEG.eq.3) MEAN = .true.
      if (.not.print) go to 120
      if (PRSWG.eq.1.and.MODEG.eq.3) go to 100
      if (MEAN) go to 110
100   continue
      TAG = '   '
      NMON = NAMONG(NDAT)
      write (KOUT(2),5040) NDAT
      if (KOUT(2)(1:1).eq.' ') KOUT(2)(1:1) = '0'
      go to 120
110   continue
      TAG = '***'
      NMON = NAMONG(13)
      KOUT(2) = '13'
120   continue
      JSAV1 = 0
      JSAV2 = 0
      ICALL = 0
      SINCAL = 0
      do 130 J = 1, KOUNT
         do 130 I = 1, KCHEM
            do 130 K = 1, KCHEM
               YIELDL(K,I,J) = 0.0D+00
130   continue
      do 140 J = 1, KOUNT
         LIGHTL(J) = 0.0
140   continue
      FACTOR = 1.3764E-17*(1.0-0.056*CLOUDG(NDAT))
      do 150 LAMKNT = 1, 35
         WLAML(LAMKNT) = WLAML(LAMKNT)*FACTOR
150   continue
      WLAML(36) = WLAML(36)*1.75*FACTOR
      do 160 LAMKNT = 37, 43
         WLAML(LAMKNT) = WLAML(LAMKNT)*2.5*FACTOR
160   continue
      WLAML(44) = WLAML(44)*3.75*FACTOR
      WLAML(45) = WLAML(45)*5.0*FACTOR
      WLAML(46) = WLAML(46)*5.0*FACTOR
      do 320 K = 1, KCHEM
         write (KOUT(1),5040) K
5040     format (I2)
         if (KOUT(1)(1:1).eq.' ') KOUT(1)(1:1) = '0'
         do 170 J = 1, KOUNT
            BIOLKL(J,K) = 0.0
            HYDRKL(J,K) = 0.0
            OXIDKL(J,K) = 0.0
            PHOTKL(J,K) = 0.0
            REDKL(J,K) = 0.0
            S1O2KL(J,K) = 0.0
            VOLKL(J,K) = 0.0
170      continue
         do 180 J = 1, KOUNT
            do 180 I = 1, 7
               KDPL(I,J) = 0.0
180      continue
         call DATACK (K)
         if (KCHEM.eq.1) PRODSW = .false.
         if (.not.print) go to 190
         III = VRAIL(ECONAM)
         write (RPTLUN(MACHNO),5000) VERSN,MODEG,(ECONAM(IV),IV=1,III)
         III = VRAIL(CHEMNA(1,K))
         write (RPTLUN(MACHNO),5010) (CHEMNA(IV,K),IV=1,III)
         write (RPTLUN(MACHNO),5020)
         write (RPTLUN(MACHNO),5050) KOUT(1),KOUT(2),NMON,TAG
5050  format (' Table 12.',A2,'.',A2,'.  ',A4,' kinetic profile of synth
     &etic chemical,'/' computed from chemical and environmental reactiv
     &ity data. ',A2)
         write (RPTLUN(MACHNO),5020)
         write (RPTLUN(MACHNO),5060)
5060  format ('  Seg T*',3X,' Local pseudo-first-order process half-live
     &s (hours)')
         write (RPTLUN(MACHNO),5070)
5070     format (3X,'#',2X,'y',4X,'Biolysis',2X,'Photol',3X,'Oxidat',3X,
     &      'Hydrol',3X,'Reduct',3X,'Volatil'/1X,63('-'))
190      continue
         if (PHOTSW) call SUNLYS (LIGHTL,K)
         if (K.eq.KCHEM.and.ICALL.eq.0) call SUNLYS (LIGHTL,K)
         if (HYDRSW) call HYDLYS (K)
         if (REDSW) call REDUCT (K)
         if (BIOSW) call BIOLYS (K)
         if (VOLSW.or.K.eq.KCHEM) call VOLAT (KO2L,K)
         call TRANSP (INTOUL,K)
         do 270 J = 1, KOUNT
            TOTKL(J,K) = 0.00D+00
            TOTKL(J,K) = (EXPOKL(J,K)+INTOUL(J))/WATVOL(J)+VOLKL(J,K)+
     &         PHOTKL(J,K)+BIOLKL(J,K)+OXIDKL(J,K)+HYDRKL(J,K)+S1O2KL(J,
     &         K)+REDKL(J,K)
            if (.not.MEAN) go to 210
            ACCUM2(1,J,K) = ACCUM2(1,J,K)+BIOLKL(J,K)
            ACCUM2(2,J,K) = ACCUM2(2,J,K)+PHOTKL(J,K)
            ACCUM2(3,J,K) = ACCUM2(3,J,K)+OXIDKL(J,K)+S1O2KL(J,K)
            ACCUM2(4,J,K) = ACCUM2(4,J,K)+HYDRKL(J,K)
            ACCUM2(5,J,K) = ACCUM2(5,J,K)+REDKL(J,K)
            ACCUM2(6,J,K) = ACCUM2(6,J,K)+VOLKL(J,K)
            if (.not.(MEAN.and.print)) go to 210
            if (NDAT.ne.12) go to 210
            do 200 I = 1, 6
               ACCUM2(I,J,K) = ACCUM2(I,J,K)/12.
200         continue
210         continue
            if (.not.print) go to 270
            if ((.not.MEAN).or.(PRSWG.eq.1.and.MODEG.eq.3)) go to 230
            do 220 I = 1, 6
               if (ACCUM2(I,J,K).eq.0.0) then
                  OUT(I) = 0.0
               else
                  OUT(I) = LNTWO/ACCUM2(I,J,K)
               endif
220         continue
            go to 250
230         continue
            OUT(1) = BIOLKL(J,K)
            OUT(2) = PHOTKL(J,K)
            OUT(3) = OXIDKL(J,K)+S1O2KL(J,K)
            OUT(4) = HYDRKL(J,K)
            OUT(5) = REDKL(J,K)
            OUT(6) = VOLKL(J,K)
            do 240 I = 1, 6
               if (OUT(I).ne.0.0) OUT(I) = LNTWO/OUT(I)
240         continue
250         continue
            write (OUTLIN,5080) J,TYPEG(J),(OUT(I),I=1,6)
5080        format (1X,I3,2X,A1,3X,1PG9.2,5G9.2)
            N1 = 1
            do 260 I = 11, 56, 9
               if (OUT(N1).eq.0.0) OUTLIN(I:I+8) = '         '
               N1 = N1+1
260         continue
            write (RPTLUN(MACHNO),5090) OUTLIN
5090        format (A64)
270      continue
         if (.not.print) go to 280
         write (RPTLUN(MACHNO),5020)
         write (RPTLUN(MACHNO),5030)
         if (TAG(1:1).eq.'*') write (RPTLUN(MACHNO),5100) BLANK,TAG
5100     format (1X,A1,A2,' Average of 12 monthly mean values.')
280      continue
         if (PRODSW) call TRPROD (K)
         if (.not.(PRSWG.eq.1.and.MODEG.eq.3.and.NDAT.eq.12)) go to 320
         TAG = '***'
         NMON = NAMONG(13)
         III = VRAIL(ECONAM)
         write (RPTLUN(MACHNO),5000) VERSN,MODEG,(ECONAM(IV),IV=1,III)
         III = VRAIL(CHEMNA(1,K))
         write (RPTLUN(MACHNO),5010) (CHEMNA(IV,K),IV=1,III)
         write (RPTLUN(MACHNO),5020)
         KOUT(2) = '13'
         write (RPTLUN(MACHNO),5050) KOUT(1),KOUT(2),NMON,TAG
         write (RPTLUN(MACHNO),5020)
         write (RPTLUN(MACHNO),5060)
         write (RPTLUN(MACHNO),5070)
         do 310 J = 1, KOUNT
            do 290 I = 1, 6
               if (ACCUM2(I,J,K).eq.0.0) then
                  OUT(I) = 0.0
               else
                  OUT(I) = LNTWO/ACCUM2(I,J,K)
               endif
290         continue
            write (OUTLIN,5080) J,TYPEG(J),(OUT(I),I=1,6)
            N1 = 1
            do 300 I = 11, 56, 9
               if (OUT(N1).eq.0.0) OUTLIN(I:I+8) = '         '
               N1 = N1+1
300         continue
            write (RPTLUN(MACHNO),5090) OUTLIN
310      continue
         write (RPTLUN(MACHNO),5020)
         write (RPTLUN(MACHNO),5030)
         write (RPTLUN(MACHNO),5100) BLANK,TAG
         TAG = '   '
         NMON = NAMONG(12)
         KOUT(2) = '12'
320   continue
      if (.not.print) go to 330
      III = VRAIL(ECONAM)
      write (RPTLUN(MACHNO),5000) VERSN,MODEG,(ECONAM(IV),IV=1,III)
      write (RPTLUN(MACHNO),5020)
      write (RPTLUN(MACHNO),5110) KOUT(2),NMON,TAG
5110  format (' Table 13.',A2,'. ',A4,' chemical reactivity profile of e
     &cosystem. ',A3/1X,63('-'))
      write (RPTLUN(MACHNO),5120)
5120  format (1X,'T*',1X,'S',3X,'pH',2X,'pOH',1X,'Temp',1X,'Piston',1X,'
     &Mean',2X,'Bact.',2X,'Oxidant',1X,'Singlet',1X,'Reduct.'/1X,'y',2X,
     &'e',11X,'Deg.',1X,'Veloc.',1X,'Light',1X,'Popn.',3X,'Conc.',2X,'Ox
     &ygen',2X,'(REDAG)'/1X,'p',2X,'g',12X,'C.',3X,'m/hr',4X,'%',3X,'cfu
     &/**',2X,'Molar',2(3X,'Molar')/1X,63('-'))
330   continue
      do 400 J = 1, KOUNT
         if (TYPEG(J).ne.'B') BNBACG(J,NDAT) = 0.0
         if (TYPEG(J).eq.'B') BACPLG(J,NDAT) = 0.0
         if (.not.MEAN) go to 350
         ACCUM3(1,J) = ACCUM3(1,J)+10.**(-PHG(J,NDAT))
         ACCUM3(2,J) = ACCUM3(2,J)+10.**(-POHG(J,NDAT))
         ACCUM3(3,J) = ACCUM3(3,J)+TCELG(J,NDAT)
         ACCUM3(4,J) = ACCUM3(4,J)+KO2L(J)
         ACCUM3(5,J) = ACCUM3(5,J)+LIGHTL(J)*100.
         if (TYPEG(J).ne.'B') then
            ACCUM3(6,J) = ACCUM3(6,J)+BACPLG(J,NDAT)
         else
            ACCUM3(6,J) = ACCUM3(6,J)+BNBACG(J,NDAT)
         endif
         ACCUM3(7,J) = ACCUM3(7,J)+OXRADL(J)
         ACCUM4(1,J) = ACCUM4(1,J)+S1O2L(J)
         ACCUM4(2,J) = ACCUM4(2,J)+REDAGG(J,NDAT)
         if (.not.(MEAN.and.print)) go to 350
         if (NDAT.ne.12) go to 350
         ACCUM3(1,J) = -alog10(ACCUM3(1,J)/12.)
         ACCUM3(2,J) = -alog10(ACCUM3(2,J)/12.)
         do 340 I = 3, 7
            ACCUM3(I,J) = ACCUM3(I,J)/12.
340      continue
         ACCUM4(1,J) = ACCUM4(1,J)/12.
         ACCUM4(2,J) = ACCUM4(2,J)/12.
         PHG(J,13) = ACCUM3(1,J)
         POHG(J,13) = ACCUM3(2,J)
         TCELG(J,13) = ACCUM3(3,J)
         if (TYPEG(J).ne.'B') then
            BACPLG(J,13) = ACCUM3(6,J)
         else
            BNBACG(J,13) = ACCUM3(6,J)
         endif
         REDAGG(J,13) = ACCUM4(2,J)
350      continue
         if (.not.print) go to 400
         if (PRSWG.eq.0) then
            do 360 I = 1, 7
               OUT(I) = ACCUM3(I,J)
360         continue
            IOUT = int(OUT(5))
            OUT(8) = ACCUM4(1,J)
            OUT(9) = ACCUM4(2,J)
         else
            OUT(1) = PHG(J,NDAT)
            OUT(2) = POHG(J,NDAT)
            OUT(3) = TCELG(J,NDAT)
            OUT(4) = KO2L(J)
            OUT(5) = LIGHTL(J)*100.
            IOUT = int(OUT(5))
            if (TYPEG(J).ne.'B') then
               OUT(6) = BACPLG(J,NDAT)
            else
               OUT(6) = BNBACG(J,NDAT)
            endif
            OUT(7) = OXRADL(J)
            OUT(8) = S1O2L(J)
            OUT(9) = REDAGG(J,NDAT)
         endif
         IEND = 9
         if (OUT(9).eq.0.0) IEND = 8
         if (TYPEG(J).eq.'B') go to 390
         if (J.eq.1) go to 370
         if (TYPEG(J-1).ne.'B') go to 380
370      continue
         write (RPTLUN(MACHNO),5130) TYPEG(J),J,(OUT(I),I=1,4),IOUT,(OUT
     &      (I),I=6,IEND)
         go to 400
380      continue
         write (RPTLUN(MACHNO),5140) TYPEG(J),J,(OUT(I),I=1,3),IOUT,(OUT
     &      (I),I=6,IEND)
         go to 400
390      continue
         if (OUT(9).gt.0.0) then
            write (RPTLUN(MACHNO),5150) TYPEG(J),J,(OUT(I),I=1,3),OUT(6)
     &         ,OUT(9)
         else
            write (RPTLUN(MACHNO),5150) TYPEG(J),J,(OUT(I),I=1,3),OUT(6)
         endif
400   continue
      if (.not.print) go to 460
5130  format (1X,A1,I3,3F5.1,1PG8.1,I4,4G8.1)
5140  format (1X,A1,I3,3F5.1,8X,I4,1PG8.1,3G8.1)
5150  format (1X,A1,I3,3F5.1,12X,1PG8.1,16X,G8.1)
      write (RPTLUN(MACHNO),5020)
      write (RPTLUN(MACHNO),5030)
      write (RPTLUN(MACHNO),5160)
5160  format (1X,' ** Active bacterial populations as cfu/mL in',' water
     & column, and'/4X,' as cfu/100 g',' (dry weight) of sediments in be
     &nthic segments.')
      BLANK = '*'
      if (TAG(1:1).eq.'*') write (RPTLUN(MACHNO),5100) BLANK,TAG
      BLANK = ' '
      if (.not.(PRSWG.eq.1.and.MODEG.eq.3.and.NDAT.eq.12)) go to 460
      TAG = '***'
      NMON = NAMONG(13)
      KOUT(2) = '13'
      III = VRAIL(ECONAM)
      write (RPTLUN(MACHNO),5000) VERSN,MODEG,(ECONAM(IV),IV=1,III)
      write (RPTLUN(MACHNO),5020)
      write (RPTLUN(MACHNO),5110) KOUT(2),NMON,TAG
      write (RPTLUN(MACHNO),5120)
      do 450 J = 1, KOUNT
         do 410 I = 1, 7
            OUT(I) = ACCUM3(I,J)
410      continue
         IOUT = int(OUT(5))
         OUT(8) = ACCUM4(1,J)
         OUT(9) = ACCUM4(2,J)
         IEND = 9
         if (OUT(9).eq.0.0) IEND = 8
         if (TYPEG(J).eq.'B') go to 440
         if (J.eq.1) go to 420
         if (TYPEG(J-1).ne.'B') go to 430
420      continue
         write (RPTLUN(MACHNO),5130) TYPEG(J),J,(OUT(I),I=1,4),IOUT,(OUT
     &      (I),I=6,IEND)
         go to 450
430      continue
         write (RPTLUN(MACHNO),5140) TYPEG(J),J,(OUT(I),I=1,3),IOUT,(OUT
     &      (I),I=6,IEND)
         go to 450
440      continue
         if (OUT(9).gt.0.0) then
            write (RPTLUN(MACHNO),5150) TYPEG(J),J,(OUT(I),I=1,3),OUT(6)
     &         ,OUT(9)
         else
            write (RPTLUN(MACHNO),5150) TYPEG(J),J,(OUT(I),I=1,3),OUT(6)
         endif
450   continue
      write (RPTLUN(MACHNO),5020)
      write (RPTLUN(MACHNO),5030)
      write (RPTLUN(MACHNO),5160)
      BLANK = '*'
      write (RPTLUN(MACHNO),5100) BLANK,TAG
      BLANK = ' '
460   continue
      return
      end
