program fred
      implicit none
      integer nm,n,nat,nmn,natn,i,j,ix,ia,jm,IU,IR
      real xi,yi,zi,xj,yj,zj,d,wmin,wmax
      real ,allocatable::r(:),u(:,:),m(:,:),s(:,:),e(:)
      integer ,allocatable::z(:),inda(:),indm(:)
      write(6,*) 'reduces F.INP'
      wmin=1600.
      wmax=1647.
      open(9,file='F.INP')
      read(9,*)nm,n,nat
      allocate(r(n),s(n,nm),e(nm),u(nm,3),m(nm,3),inda(n),indm(n),
     1z(nat))
      do 1 i=1,nat
1     read(9,*)z(i),(r(ix+3*(i-1)),ix=1,3)
      read(9,*)
      do 2 i=1,nat
      do 2 j=1,nm
2     read(9,*)(s(ix+3*(i-1),j),ix=1,2),(s(ix+3*(i-1),j),ix=1,3)
      read(9,*)
      read(9,*)e
      do 3 j=1,nm
3     read(9,end=99,err=99)(u(j,ix),ix=1,3),(m(j,ix),ix=1,3)
99    close(9)
      write(6,*)nat,' atoms, ',nm,' modes'
      
      natn=0
c     identify CO
      do 4 i=1,nat
      if(z(i).eq.8)then
       xi=r(1+3*(i-1))
       yi=r(2+3*(i-1))
       zi=r(3+3*(i-1))
       do 41 j=1,nat
       xj=r(1+3*(j-1))
       yj=r(2+3*(j-1))
       zj=r(3+3*(j-1))
       d=(xi-xj)**2+(yi-yj)**2+(zi-zj)**2
       if(z(j).eq.6.and.d.lt.1.69)then
        natn=natn+1
        inda(natn)=i
        natn=natn+1
        inda(natn)=j
       endif
41     continue
      endif
4     continue
      write(6,*)natn,' CO atoms'
      nmn=0
      do 5 i=1,nm
      if(e(i).ge.wmin.and.e(i).le.wmax)then
       nmn=nmn+1
       indm(nmn)=i
      endif
5     continue
      write(6,*)nmn,' modes within limnits'
     

      OPEN(34,FILE='FSMALL.INP')
      WRITE(34,10)nmn,3*natn,natn
10    FORMAT(3I7)
      DO 6 ia=1,natn
      i=inda(ia)
6     WRITE(34,11)Z(i),(r(ix+3*(i-1)),ix=1,3)
11    FORMAT(I7,3F12.6)
      WRITE(34,14)
14    FORMAT(' Atom Mode    X-disp.    Y-disp.      Z-disp.')
      DO 7 ia=1,natn
      i=inda(ia)
      DO 7 jm=1,nmn
      j=indm(jm)
      IU=3*(I-1)
7     WRITE(34,15)ia,jm,S(IU+1,J),S(IU+2,J),S(IU+3,J)
15    FORMAT(2I7,3F11.6)
      WRITE(34,11)nmn
      do 8 jm=1,nmn
      I=indm(jm)
      WRITE(34,13)e(I)
13    format(F11.3,$)
8     if(mod(jm,6).eq.0.or.jm.eq.nmn)write(34,*)
      do 9 jm=1,nmn
      I=indm(jm)
9     WRITE(34,522)(u(I,IR),IR=1,3),(m(I,IR),IR=1,3)
522   FORMAT(12G13.5)
      CLOSE(34)
      END