c program to convert SIL bc files to mseed, jh august 2006
c
c based on SILSEI program to convert SIL ASCII data to Seisan, lo June 01, 2001
c
c comments: component hardwired to B
c           network code hardvired to SI
c           not tested much


      implicit none
      include  'seidim.inc'                 ! Dimensions.
      include  'libsei.inc'                 ! Library defns.
      include 'waveform.inc'                ! for waveform handling
      include 'seisan.inc'                  ! seisan parameters
      include 'write_mseed.inc.f'           ! writing miniseed


      integer idata (max_sample)            ! integer data
      integer nchan,nsamp,i
      character*80      filehead(max_trace)
      character*1040    tracehead
      character*80 infile                   ! input filename
      character*80 outfile                 
      real srate                             ! sample rate
      integer year,month,day,hour,min        !time
      real sec
      character*5 station                    ! station name
      character*4 comp                       ! component SEISAN
      integer in                             ! 1 for filenr.lis
      integer ichan                          ! channel counter
      logical op_file,open_file              ! open seed file
      character*2 seed_location_code         ! seed location code
      integer seiclen
      character*80 question,line
      character*40 text
      integer mseed_block                    ! mseed block counter
      integer l



c
c print version
c
      include 'version.inc'
      out_version_date='July 23, 2001'
      if (version_new) out_version_date=version_date
      call print_ver

 10   continue
c
c input file names
c
      question=' Filename or number, filenr.lis for all'
      call filename(question,infile)
      if (infile(1:3).eq.'EOF') stop

      in=0
      if (infile(1:10).eq.'filenr.lis') then
        in=1
        open(60,file=infile,status='old',err=9999)
      endif

 20   continue

      if (in.eq.1) then 
         read(60,'(7x,a)') infile
         if(infile(1:4).eq.'    ') stop
      endif

      write(6,'(1x,a13,a)') ' input file: ',infile
      write(*,*) 
c
c   convert binary file to SIL ascii
c
      i=seiclen(infile)   ! length of file name
c
c   convert file to ascii using sil program bctool 
c
      call systemc
     *('bctool -b '//infile(1:i)//' -S',13+i)
c
c   start with first block
c
      mseed_block=1
c
c
c  always assume 3 channels now in 3 different files, same
c  file name except ending

      do ichan=1,3
         if(ichan.eq.1) open(1,file=infile(1:8)//'Z00'
     *   ,status='scratch')
         if(ichan.eq.2) open(1,file=infile(1:8)//'N00'
     *   ,status='scratch')
         if(ichan.eq.3) open(1,file=infile(1:8)//'E00'
     *   ,status='scratch')
c
c read header
c
         read(1,'(a)',end=333,err=333) line
c
c arn  2001
c
         station=line(1:4)
         call CASEFOLD(station)
         read(line(6:9),'(i4)') year
c
c              12345678901234567890
c /usr/sil/net/may/07/09:44:00.00E00     format example
c
         read(1,'(a)',end=333,err=333) line
         text=' '
         text= line(seiclen(line)-20:seiclen(line))
         if (text(1:3).eq.'jan') then 
           month=1
         elseif (text(1:3).eq.'feb') then
           month=2
         elseif (text(1:3).eq.'mar') then
           month=3
         elseif (text(1:3).eq.'apr') then
           month=4
         elseif (text(1:3).eq.'may') then
           month=5
         elseif (text(1:3).eq.'jun') then
           month=6
         elseif (text(1:3).eq.'jul') then
           month=7
         elseif (text(1:3).eq.'aug') then
           month=8
         elseif (text(1:3).eq.'sep') then
           month=9
         elseif (text(1:3).eq.'oct') then
           month=10
         elseif (text(1:3).eq.'nov') then
           month=11
         elseif (text(1:3).eq.'dec') then
           month=12
         endif
         read (text(5:6),'(i2)') day
         read (text(8:9),'(i2)') hour
         read (text(11:12),'(i2)') min
         read (text(14:18),'(f5.2)') sec
         comp='B   '
         comp(4:4)=text(19:19)
c 100
         read(1,'(a)',end=333,err=333) line
         read(line,'(f5.0)') srate

c T3795 D0395
c aut
c o/s=   600 drift=     0 pwm=  3484   4 Auto 9

         read(1,'(a)',end=333,err=333) line
         read(1,'(a)',end=333,err=333) line
         read(1,'(a)',end=333,err=333) line
c
c +data+
c
         read(1,'(a)',end=333,err=333) line
         if (line(1:6).ne.'+data+') then
            goto 333 
         endif
c
c  36000        exmaple of nsamp
c
         read(1,'(a)',end=333,err=333) line
         read(line,'(i10)') nsamp
c
c -117874       exmaple fo first sample
c
         do i=1,nsamp
            read(1,'(a)',end=333,err=333) line
            read(line,'(i14)') idata(i)
         enddo
c
c input done
c

         goto 334
    
 333     continue
         close(1)
         write(*,*) ' error reading SIL file '
         stop
 334     continue
         close(1)
c
c  open output file if first channel
c
         if(ichan.eq.1) then
            outfile=infile(1:8)//'_MSEED'
            op_file=open_file(96,outfile,12)   ! use block size 4096=2**12
            write(6,'(a,a)') ' Outfile name: ',outfile(1:60)
         endif
c
c MSEED  headers
c
         seed_location_code='  '   ! hardwird to blank
         mseed_year=year
         mseed_month=month
         mseed_day=day
         mseed_hour=hour
         mseed_minute=min
         mseed_second=sec
         mseed_station=station
         mseed_channel(1:2)=comp(1:2)
         mseed_channel(3:3)=comp(4:4)
         mseed_total_samples=nsamp
         mseed_sample_rate=srate
         mseed_location=seed_location_code
         mseed_network='SI'

         mseed_encoding=steim1               ! steim1
c        do l=1,nsamp
c           signal4b(l)=idata(l)
c        enddo
         call seed_write_chn(96,idata,mseed_block)
      enddo          ! end of channel loop
c
c   back for next file
c

      if(in.eq.1) goto 20                                                           
      goto 10 

9999  continue
      close(60)

      stop
      end


