
      SUBROUTINE CHEMOUT( ITIME , iprint )

      INCLUDE 'PARAMETERS.INC'

      CHARACTER*8 AMOL(MB)

      COMMON

     &      /SWITCHES/ ZLAT , DELTAT , DELT1 , DAYSTART ,
     &                 TIMESTART , TIMESTOP , OUTTIME ,
     &                 MODE , NTIME , NITER , IDIFF , istepdump

     &       /BLOCK3/  NOREAC(IB)

     &       /BLOCK18/ CONC(MB,NALT)

     &       /BLOCK10/ Z(NALT)

     &       /ONED5/   SRTOP , SSTOP

     &       /ONED8/   TIME

     &       /ONED18/  NFORM(MB) , NDEST(MB) ,
     &                 IFORM(IB,MB) , IDEST(IB,MB)

     &       /ONED19/  KFORM(IB,MB) , KDEST(IB,MB)

     &       /ONED21/  SRBOT , SSBOT

     &       /ONED15/  THOUR

     &       /ONED17/  NTRANS

     &       /ONED27/  MOL(6,IB) , KOEFF(6,IB)

     &       /ONED36/  DAY

     &       /ONED20/  RCONST(IB,NALT)

     &       /ONED40/  MTRANS(MB)

     &       /ONED41/  SZA

     &       /ONED42/  NMOL

     &       /ONED43/  AMOL

     &       /ONED53/  MPCE(MB)

     &       /ONED54/  NPCE

     &       /DEBUG/   RPROD(MB,NALT)

     &       /BLOCK7/  RATE(IB,NALT)

     &       /BLOCK27/ PI

     &       /BLOCK38/ NREACT

     &       /ONED62/  kprint(3)        ! altitudes at which we output rates

      DIMENSION RFREQ(MB,NALT)

C THIS ROUTINE GENERATES THE OUPUT FILE

C FIRST CALCULATE THE LOSS FREQUENCY - RFREQ.

      DO K = 1 , NALT
        DO M = 1 , NMOL         ! THIS WILL INCLUDE TRANSPORTED SPECIES AS WELL
                                ! AS THOSE IN PCE
          SUM = 0.0D0
          ND = NDEST(M)         ! NUMBER OF REACTIONS WHICH DESTROY MOLECULE M
          DO I = 1 , ND
            IDST = IDEST(I,M)   ! ITH REACTION NUMBER IN WHICH M IS DESTROYED
            NRCT = NOREAC(IDST) ! NUMBER OF REACTANTS IN REACTION # IDST
            FREQ = RCONST(IDST,K)
 
            DO J = 1 , NRCT
              IF( M .NE. MOL(J,IDST) ) THEN
                C0 = CONC(MOL(J,IDST),K)
                C1 = C0
                DO KK = 1 , KOEFF(J,IDST)-1 ! better WAY OF doing CONC**KOEFF
                  C1 = C1*C0
                ENDDO
                FREQ = FREQ*C1
              ENDIF
            ENDDO

            SUM = SUM + FREQ*KDEST(IDST,M)
          ENDDO
          RFREQ(M,K) = SUM
        ENDDO
      ENDDO

      WRITE(3) (SNGL(Z(K)) , K = 1 , NALT)
      WRITE(3) SNGL(THOUR) , SNGL(SZA*180.0d0/PI)
      WRITE(3) SNGL(SRTOP) , SNGL(SSTOP) ,
     &         SNGL(SRBOT) , SNGL(SSBOT)

      DO M = 1 , NMOL
        WRITE(3) (SNGL(CONC(M,K)) , K = 1 , NALT)
        WRITE(3) (SNGL(CONC(M,K)/CONC(NMOL,K)) , K= 1 , NALT)
        WRITE(3) (SNGL(RPROD(M,K)) , K = 1 , NALT)
        WRITE(3) (SNGL(RFREQ(M,K)) , K = 1 , NALT)
      ENDDO

cc      IF( MODE .EQ. 0 ) THEN	!KEEP THE FILE SMALL FOR DIURNAL RUNS
c       if(iprint .eq. istepdump) then
c       write (6,150) istepdump
c150    format (2x,'Writing SUMMARY, detailed rates at time step =',I5)
c       call summary
         DO I = 1 , NREACT
C           WRITE(3) (IFORM(I,M),M=1,NMOL)
C           WRITE(3) (IDEST(I,M),M=1,NMOL)
           WRITE(3) (SNGL(RCONST(I,K)) , K = 1 , NALT)
           WRITE(3) (SNGL(RATE(I,K)) , K = 1 , NALT)
         ENDDO
	
C	 WRITE(6,*) 'RATE 259 @ 100 km', RATE(259,101), Z(101)
C	 WRITE(6,*) 'RATE 260 @ 100 km', RATE(260,101), Z(101)
C	 WRITE(6,*) 'RATE 261 @ 100 km', RATE(261,101), Z(101)
C	 WRITE(6,*) 'RATE 262 @ 100 km', RATE(262,101), Z(101)

c       endif
cc      ENDIF

C Output all reaction rates for specified altitudes and times

cc      if( iprint .eq. 1 ) then
cc        write(13) (sngl(z(k)) , k = 1 , nalt)
cc        write(13) sngl(thour) , sngl(sza*180.0d0/pi)
cc        write(13) sngl(srtop) , sngl(sstop) ,
cc     &            sngl(srbot) , sngl(ssbot)

cc        do i = 1 , nreact
cc          write(13) (iform(i,m),m=1,nmol)
cc          write(13) (idest(i,m),m=1,nmol)
cc          write(13) (sngl(rconst(i,k)) , k = 1 , nalt)
cc          write(13) (sngl(rate(i,k)) , k = 1 , nalt)
cc        enddo
cc      endif

cc      write(33) (sngl(z(k)) , k = 1 , nalt)
cc      write(33) (kprint(i) , i = 1 , 3)
cc      write(33) sngl(time)
cc      write(33) sngl(thour) , sngl(sza*180.0d0/pi)
cc      write(33) sngl(srtop) , sngl(sstop) ,
cc     &          sngl(srbot) , sngl(ssbot)

cc      do i = 1 , nreact
cc        write(33) (iform(i,m),m=1,nmol)
cc        write(33) (idest(i,m),m=1,nmol)
cc        do ip = 1 , 3 
cc          write(33) sngl(rconst(i,kprint(ip)))
cc          write(33) sngl(rate(i,kprint(ip)))
cc        enddo
cc      enddo

C GENERATE RESTART FILE

      IF( ITIME .EQ. NTIME ) THEN
c      IF(MODE .EQ. 1 .OR. ITIME .EQ. NTIME ) THEN
c      IF(MODE .EQ. 1 .OR. MODE .EQ. 2 .OR. ITIME .EQ. NTIME ) THEN
       write (6,160) ITIME
160    format (2x,'Writing restart file for ITIME = ',I5)
        OPEN( UNIT = 100 )
        NBLOCKS = NMOL/10 + 1
        DO N = 1 , NBLOCKS
          WRITE(100,130)(AMOL((N-1)*10+M) , M = 1 , 10)
          DO K = 1 , NALT
            WRITE(100,140) ( SNGL(CONC( (N-1)*10+M ,K)) , M = 1 , 10)
          ENDDO
        ENDDO
        CLOSE( UNIT = 100 )
      ENDIF

      IF( MODE .EQ. 0 .AND. ITIME .EQ. NTIME ) then
       CALL SUMMARY  ! GENERATE SUMMARY FILE
       write (6,170) ITIME
170    format (2x,'Writing SUMMARY file for ITIME = ',I5)
      endif
c      IF( (MODE .EQ. 0 .OR. MODE .EQ. 2)
c     &   .AND. ITIME .EQ. NTIME ) CALL SUMMARY  ! GENERATE SUMMARY FILE

130   FORMAT( 19X , 10(A8,3X))
140   FORMAT( 19X , 10(1PE9.3 , 2X) )


      RETURN
      END

