      character*80 getunx,message
      character*80 hypofile
      character*80 gfsdir
      character*80 recfile
c
      character*40 regionref
      character*4 catalogref
      integer eqyearref,eqmonthref,eqdayref,eqhourref,eqminuteref
c
      dimension ahhead(270)

      real*8 dsla,dslo,dtot
      character*80 string
      character*8 chn
      character*8 stn
      character*8 clss
      parameter(maxpts=100000)
      dimension data(maxpts)
      dimension response(20000)
c
      dimension gfshead(30)
c
      logical exists,verbose
c
      call chekcl('|     :r:1:Name of input .record file '//
     #            '|   -H:o:1:Name of input hypocenter file [CMTSOLUTION]'//
     #            '|   -D:o:1:Name of GFS directory [GFS]'//
     #            '|   -F:o:1:flip polarity [0]'//
     #            '|   -v:o:0,1:Verbosity level|')
c
      string=getunx('-F',1,nbyts)
      read(string(1:nbyts),*) ineg

      message=getunx('-v',1,nbyts)
      verbose=.false.
      if(nbyts.ge.0) verbose=.true.
c
      recfile=getunx('',1,lrecfile)
      hypofile=getunx('-H',1,lhypofile)
      gfsdir=getunx('-D',1,lgfsdir)
c
      if(verbose) then
        write(6,"('gfsdir  :',a)") gfsdir(1:lgfsdir)
        write(6,"('recfile :',a)") recfile(1:lrecfile)
        write(6,"('hypofile:',a)") hypofile(1:lrecfile)
      endif
c
      inquire(file=recfile,exist=exists)
      if(.not.exists) then
        write(6,"('input file does not exist:',a)") recfile(1:lnblnk(recfile))
      endif
c
      inquire(file=hypofile,exist=exists)
      if(.not.exists) then
        write(6,"('hypocenter file does not exist:',a)") hypofile(1:lnblnk(hypofile))
        call exit(1)
      endif
c
      open(1,file=hypofile)
      read(1,"(a4,1x,i4,1x,i2,1x,i2,1x,i2,1x,i2,1x,f5.2,1x,
     #      f8.4,1x,f9.4,1x,f5.1,1x,f3.1,1x,f3.1,1x,a))",iostat=ios) 
     #      catalogref,eqyearref,eqmonthref,eqdayref,eqhourref,
     #      eqminuteref,eqsecondref,eqlatituderef,eqlongituderef,eqdepthref,
     #        eqmbref,eqmsref,regionref
      julianref=julday(eqyearref,eqmonthref,eqdayref)
      close(1)
c
c---- open GFS directory
c
      igfstyp=3
      call gfs_open(1,gfsdir,igfstyp,nentry)
      write(6,"('gfs_open returns nentry=',i4)") nentry
c
c---- now read in the header and seismogram from the ----.record file
c
      call openfl(1,recfile,1,0,0,ierr,-1)
c
c---- process the blocks until header and data have been read
c
      ibyte=1
      iblock=0
      ios=0
      do while(iblock.ne.5.and.ios.eq.0) 
        call bffi(1,1,iblock,4,ierr,nread,ibyte)
        if(ierr.ne.2) then
          ios=1
        else
          call bffi(1,1,ilength,4,ierr,nread,0)
          if(ierr.ne.2) then
            ios=1
          else
            if(iblock.eq.1) then
              call rrec(1,ibyte,stn,chn,dsla,dslo,
     #          stele,stbur,stazi,stdip,spsec,nsamp,iyr,ijd,iho,imi,
     #          fsec,dtot,clss,ierror)
                call monday(iyr,ijd,imo,iday)
                ssla=sngl(dsla)
                sslo=sngl(dslo)
              if(verbose) write(6,"('Header information read: ',2a8)") stn,chn
c
            else if(iblock.eq.2) then
              irwords=(ilength-8)/4
              call bffi(1,1,response,irwords*4,ierr,nr,ibyte+8)
              if(verbose) write(6,"('Response information read: ',i7)") irwords
            else if(iblock.eq.3) then
            else if(iblock.eq.4) then
            else if(iblock.eq.5) then
              if(nsamp.gt.maxpts) then
                write(6,"('too many points in input file:',i7)") nsamp
                call exit(1)
              endif
              call bffi(1,1,data,nsamp*4,ierr,nr,ibyte+8)
              if(verbose) write(6,"('Seismogram read: ',i7)") nsamp
            else
              write(6,"('funny block')")
              call exit(1)
            endif
            ibyte=ibyte+ilength
          endif
        endif
      enddo
      call closfl(1,ierr)
      dt=1./spsec
c
c---- find the component
c
      call orientation(stdip,stazi,icomp)
c     if(iabs(icomp).gt.5.or.iabs(icomp).lt.1) call exit(1)
c
c---- write out a gfs entry
c
c
c---- write out the GFS header and data
c
      do i=1,30
        gfshead(i)=0.
      enddo
      call encodegfshead(igfstyp,gfshead,gfshead,
     #    eqlatituderef,eqlongituderef,eqdepthref,eqyearref,eqmonthref,
     #    eqdayref,eqhourref,eqminuteref,eqsecondref,regionref,
     #    stn,chn,icomp,ssla,sslo,stele,
     #    iyr,imo,iday,iho,imi,fsec,nsamp,dt)
        if (ineg.eq.1) then
          print*,'flipping polarity'
          do i= 1,nsamp
            data(i)=-data(i)
          enddo
        endif
      call gfs_rwentry(1,gfshead,data,0,'w')
      end
c
c
      subroutine encodegfshead(igfs,head,ihead,
     #      elat,elon,edep,iye,moe,idae,ihe,mie,see,region,
     #      istation,channel,iori,slat,slon,sele,iyr,imor,idr,ihr,imir,ser,ndata,dt)
      dimension head(30)
      dimension ihead(30)
      character*24 region
c      character*6 station
      character*4 channel
c
      complex poles(30)
      complex zeros(20)
      common /zxyzx/ npoles,nzeros,poles,zeros,pzfactor
c
c---- packing header type 3
c
      if(igfs.eq.3) then
        ihead(1)=ndata
        ihead(2)=istation
        if(iabs(iori).eq.1) then
          ihead(3)='VERT'
        else if(iabs(iori).eq.2) then
          ihead(3)='N-S '
        else if(iabs(iori).eq.3) then
          ihead(3)='E-W '
        else 
          ihead(3)='????'
        endif
        ihead(4)='----'
        ihead(5)=iyr
        ihead(6)=julday(iyr,imor,idr)
        ihead(7)=ihr
        ihead(8)=imir
        head(9)=ser
        head(10)=1.0/dt
        head(11)=90.0-elat
        head(12)=elon
        if (head(12).lt.0.0) head(12) = 360.0 + head(12)
        head(13)=edep
        ihead(14)=iye
        ihead(15)=julday(iye,moe,idae)
        ihead(16)=ihe
        ihead(17)=mie
         head(18)=see
         head(19)=90.0-slat
         head(20)=slon
        if (head(20).lt.0.0) head(20) = 360.0 + head(20)
        do i=1,10
          head(20+i)=0.
        enddo
c        write(6,"(i6,a4,a4,a4,i4,i4,i4,i4,f5.1,f6.2,f8.2,f8.2,f6.1,4i5,f5.1)") 
c     #  ihead(1),ihead(2),ihead(3),ihead(4),ihead(5),ihead(6),ihead(7),
c     #  ihead(8),head(9),head(10),head(11),head(12),head(13),ihead(14),
c     #  ihead(15),ihead(16),ihead(17),head(18),head(19),head(20)
c
c---- other header types
c
      else
        write(6,"('cannot encode GFS header type',i2)") igfs
        stop
      endif
      return
      end
