subroutine wxs (ngfine,ngcoar,outfor)
c
c     *****************************************************************
c
c     this program write cross sections for a target to a temporary file
c
c     input: 
c        ngfine   i   number of groups in initial structure
c        ngcoar   i   number of groups in final structure.
c        outfor   a   output format for cross sections.
c
c     *****************************************************************
c
      character*8  outfor
      integer      ngcoar,ngfine
c
      include      'unit.h'
      include      'limit.h'
      include      'header.h'
      include      'racc.h'
      include      'target.h'
      integer      itemp,jtemp,ktemp,j1,j2,nre1,nrem,lis,iza,mt,ne,ne1,
     1             lrec
      integer      irec(maxrec),mrec(maxrec)
      real         mincrs 
      data         mincrs /1.0e-12/
c
c     increment number of isotopes
      niso = niso+1
c
c     FISPACT
      if (outfor .eq. 'FISPACT') then
         lrec = 0
         if (isomer .eq. ' ') then
            lis = 0
         else if (isomer .eq. 'm') then
            lis = 1
         else if (isomer .eq. 'n') then
            lis = 2
         else if (isomer .eq. 'o') then
            lis = 3
         else
            write (6,901) target
            lis = 0
         endif
         iza = 10000*iz+10*ia+lis
         do 20 itemp = 1,nrec
            if (reac(itemp) .eq. 'x') then
               lrec = lrec +1
               go to 20
            endif
            call fismt (reac(itemp),mt)
            do 10 jtemp = 1,ngcoar
               if (crossg(itemp,jtemp) .gt. mincrs) go to 11
10          continue
            lrec = lrec+1
            go to 20
11          ne1 = jtemp
            if (ne1 .gt. 1) then
               ne1 = ne1-1
               crossg(itemp,ne1) = 0.0
            endif
            ne =ngcoar-ne1+1
            write (iutemp,601) iza,mt,ne,      
     1                         target,reac(itemp),prod(itemp)
            write (iutemp,602) ngfine,ngcoar
            write (iutemp,603) (crossg(itemp,jtemp),jtemp=ngcoar,ne1,-1)
20       continue
         nrec = nrec - lrec
      endif
c
c     RACC
      if (outfor .eq. 'RACC') then
         lrec = 0
         do 101 itemp = 1,nrec
101      mrec(itemp) = 0
         if (isomer .eq. ' ') then
            lis = 0
         else if (isomer .eq. 'm') then
            lis = 1
         else if (isomer .eq. 'n') then
            lis = 2
         else if (isomer .eq. 'o') then
            lis = 3
         else
            write (6,901) target
            lis = 0
         endif
         jza(niso) = 10000*iz+10*ia+lis
         syr(niso) = sy
         nz(niso)  = iz
         nzmin     = min0(iz,nzmin)
         nzmax     = max0(iz,nzmax)
         do 130 itemp = 1,nrec
            if ((reac(itemp) .eq. 'x   ') .and. 
     1          (prod(itemp) .ne. 'ab'))   then
               lrec = lrec+1
               mrec(itemp) = 0
            else
               mrec(itemp) = itemp
               call raccmt(reac(itemp),nrtyp(niso,itemp),
     1                                 hrtyp(niso,itemp))
            do 110 jtemp = 1,ngcoar
               if (crossg(itemp,jtemp) .gt. mincrs) go to 120
110         continue
            mrec(itemp) = 0
            go to 130
120         irec(itemp) = jtemp
            endif
130      continue
         nrec = nrec - lrec
         nrc(niso) = nrec
         write (iutemp,611) syr(niso),jza(niso),nrc(niso)
         write (iutemp,612)
         do 140 itemp =1,nrec
            if (mrec(itemp) .eq. 0) go to 140
c           irec(itemp) = min0(irec(itemp),100)
            nre1 = ngcoar-irec(itemp)
            nrem = mod(ngcoar-irec(itemp)+1,6)
            j1 = ngcoar
            j2 = ngcoar -5
            do 131 ktemp = 1,nre1/6
               write (iutemp,613) (crossg(itemp,jtemp),
     1                          jtemp=j1,j2,-1),reac(itemp)
               j1 = j1-6
               j2 = j2-6
131         continue
            if (nrem .eq. 1) then 
               write (iutemp,614) (crossg(itemp,jtemp),
     1                    jtemp=j1,irec(itemp),-1),
     2                    irec(itemp)-1,reac(itemp)
            else if (nrem .eq. 2) then
               write (iutemp,615) (crossg(itemp,jtemp),
     1                    jtemp=j1,irec(itemp),-1),
     2                    irec(itemp)-1,reac(itemp)
            else if (nrem .eq. 3) then
               write (iutemp,616) (crossg(itemp,jtemp),
     1                    jtemp=j1,irec(itemp),-1),
     2                    irec(itemp)-1,reac(itemp)
            else if (nrem .eq. 4) then
               write (iutemp,617) (crossg(itemp,jtemp),
     1                    jtemp=j1,irec(itemp),-1),
     2                    irec(itemp)-1,reac(itemp)
            else if (nrem .eq. 5) then
               write (iutemp,618) (crossg(itemp,jtemp),
     1                    jtemp=j1,irec(itemp),-1),
     2                    irec(itemp)-1,reac(itemp)
            endif
140      continue
         write (iutemp,619)
      endif
c
c     REAC
      if (outfor .eq. 'REAC') then
         write (iutemp,621) target,nrec
         do 30 itemp = 1,nrec
            write (iutemp,622) reac(itemp),prod(itemp),
     1                         (crossg(itemp,jtemp),jtemp=1,ngcoar)
30       continue      
      endif
c
c     find largest number of reactions per isotope
      maxr = max0(nrec,maxr)
c
c     increment number of reactions
      sumrec = sumrec + nrec
c
c     return
      return
c
601   format (i8,i6,i6,5x,a6,'(n,',a4,')',a6)
602   format ('   FENDL/PA-1.1 library '/ '   Collapsed from ',i4,
     1        ' to',i4,' groups')
603   format (1p6e12.5)
611   format (a6,i8,i6)
612   format ('99*')
613   format (6(5x,1pe9.3),           1x,a4)
614   format (1(5x,1pe9.3),i4,'R0.0',55x,a4)
615   format (2(5x,1pe9.3),i4,'R0.0',43x,a4)
616   format (3(5x,1pe9.3),i4,'R0.0',31x,a4)
617   format (4(5x,1pe9.3),i4,'R0.0',19x,a4)
618   format (5(5x,1pe9.3),i4,'R0.0', 7x,a4)
619   format ('  T')
621   format (a6,4x,i5)
622   format (a4,a6, 1p7e10.3 / (1p8e10.3))
901   format (' WARNING could not determine isomer state for ',a)
      end