cDEBUG
c
c  convert chinees files to seisan format
c
c
c  j. havskov, march 99
c  b. moreno, sep 99
c    may 11  00    lo : use read_resp_head
c
c  updates:
c
c  sep 22  99 by bmt: tested on linux
c  sep 28  99 by bmt: tested on WINDOWS
c  oct 30  99 by bmt: small change
c  dec 07  99 by bmt: joint in one file

      implicit none
      include 'seidim.inc'
      include 'libsei.inc'
c-- input data vector     
      integer*4 data(max_sample)
c-- input file name       
      character*80 infile
      integer seiclen      ! function
      character*80 text
c
c-----------------------------------------------------------------------
c   start block of definitions for most conversion programs
c
c-- main header------------------------------------------
      character*80 mainhead(max_trace)
      character*29 mainhead_text   ! text to be put into main header
c-- channel header
      character*1040 chahead
c-- output file name 
      character*80 outfile        
c-- number of stations
      integer nchan      
c-- channel to calculate channel header for
      integer ichan,century,doy
c-- network code
      character*5 net_code        
c-- stations and components
      character*5 stat(max_trace)
      character*4 comp(max_trace)         
c-- channel 2 or 4 byte
      character*1 cbyte(max_trace)
c--channel header date and times          
      integer year(max_trace),month(max_trace),day(max_trace),
     *hour(max_trace),min(max_trace)
      real sec(max_trace)
c-- channel samples and sample rate
      integer nsamp(max_trace)
      real rate(max_trace)
      character*80  temp_netcode        
c
c--end block of definitions most conversion programs
c---------------------------------------------------------------------
c

c-- infile indicator; in=0: one file, in=1: many files
      integer in          
c-- question
      character*80 question,fname,indice          
c--Counters etc
          integer i,j,l,k,line,rest
      integer code   ! error code
c-- computer type
      logical pc,sun,linux        
c
       include 'bgisei.inc'   

      call print_ver(' SEISAN 7.1.0, May 18, 2000')
      call computer_type(sun,pc,linux)
c
c   get def file for station codes, give file name
      text='bgisei.def'
      call read_def_chan(text,mainhead_text,net_code)
      temp_netcode=net_code
c
       open(10,file='filenr.out',status='unknown',form='formatted')      
c   get file name
c
      in=0
      question=' File name, # or filenr.lis for all'
      call filename(question,infile)        
      if(infile.eq.'EOF') stop
      if(infile(1:10).eq.'filenr.lis'.or.infile(1:10).eq.
     *'FILENR.LIS') then
         open(8,file='filenr.lis',status='old',err=20)
         goto 21
 20      continue
         write(6,*)' No filenr.lis'
         stop
 21      continue
         in=1
      endif
c
c  file loop if many files
c
 1000 continue
      if(in.eq.1) then
         read(8,'(7x,a)') infile
         if(infile(1:4).eq.'    ') stop
      endif
          i=seiclen(infile)   ! length of file name
      write(6,'(1x,a)') infile(1:i)
c
c   convert file to ascii using bgiasc program 
c
cc      call systemc
cc     *('bgiasc1 '//infile(1:i)//'> bgiasc.out',22+i)
      call bgiasc(infile(1:i),i)
c     open file and read header info
c
       open(1,file='bgiasc.evt',status='old')
c
c   skiping the header
c
       read(1,'(a)') text
       read(text(31:33),'(i3)') nchan

c       do j=1,11
c        read(1,'(a)') text
c       end do
c get all stats, comps start times etc, remeber station are 5 chars !
c
      
       do i=1,nchan
       read(1,'(a)') text
       stat(i)=text(1:5)
       comp(i)=' '
       comp(i)(1:4)=text(6:9)
c   number of samples , rate and start time
c
c
       read(text(45:50),'(i6)') nsamp(i)
       read(text(37:43),'(f7.2)') rate(i)
       read(text(10:35),'(i1,i2,1x,i3,1x,i2,1x,i2,1x,i2,1x,i2,1x,f6.3)') 
     *    century,year(i),doy,month(i),day(i),
     *    hour(i),min(i),sec(i)
        year(i)=year(i)+1900+century*100
c   continueif not at the data section
c
c
 
c
c   put in definition from def file
c
      
       call set_def_chan(i,stat(i),comp(i))
      
    
c   read data
c
c
     
c      do j=1,12
c         read(1,'(a)') text
c      enddo

cc      read(1,*,end=222) (data(j),j=1,nsamp(i))
       
c   end of file on solaris is incoplete causing an end of file, so the
c   end=222 is added above and all samples are set to 0 before reading. 
c   in this wasy any missing samples will be zero
c
 222  continue
c
      end do

      close(1)
     
      open(1,file='bgiasc.evt',status='old')
c   make seisan headers
      ichan=1
      cbyte(1)='4'   ! 4 byte data
      net_code=temp_netcode
      call sheads(year,month,day,hour,min,sec,nchan,ichan,
     *                 net_code,mainhead_text,stat,comp,nsamp,
     *                 rate,cbyte,
     *                 outfile,mainhead,chahead)
      write(6,200) outfile(1:29)
      write(10,*) outfile(1:29)                                             
 200  format(/,' Output file name is: ',a29)   
                             
c   open output file
      open(2,file=outfile,status='unknown',form='unformatted')
 
c       do j=1,12
        read(1,'(a)') text
c       end do
  
      do j=1,12
         write(2)mainhead(j)
c         write(6,'(1x,a)')mainhead(j)(1:79)
      enddo

      do i=1,nchan
       read(1,'(a)') text
       stat(i)=text(1:5)
       comp(i)=' '
       comp(i)(1:4)=text(6:9)
c
       read(text(45:50),'(i6)') nsamp(i)
       read(text(37:43),'(f7.2)') rate(i)
       read(text(10:35),'(i1,i2,1x,i3,1x,i2,1x,i2,1x,i2,1x,i2,1x,f6.3)') 
     *    century,year(i),doy,month(i),day(i),
     *    hour(i),min(i),sec(i)
        year(i)=year(i)+1900+century*100

c      do j=1,12
c         read(1,'(a)') text
c      enddo

       call set_def_chan(i,stat(i),comp(i))
      ichan=i
      cbyte(i)='4'   ! 4 byte data
      call sheads(year,month,day,hour,min,sec,nchan,ichan,
     *                 net_code,mainhead_text,stat,comp,nsamp,
     *                 rate,cbyte,
     *                 outfile,mainhead,chahead)
c   read response curve into header
c

      call read_resp_head(chahead)                                            
c
      net_code=' '
      do j=1,nsamp(i)
         data(j)=0
      enddo
      if(i.lt.10) then
       write(indice,'(i1)') i
      else
       write(indice,'(i2)') i
      endif  
        fname = 'chan.'// indice
      open(3,file=fname,status='old')
      read(3,*,end=223) (data(j),j=1,nsamp(i))
 223  continue
      close(3)
c
        
c   write data
      write(6,'(1x,a)')chahead(1:79)
      write(2) chahead
c
      write(2)(data(j),j=1,nsamp(i))
      write(6,*)
      end do
        close(1)
      close(2)
c
c  back for next file if many
c
      if(in.eq.1) goto 1000                                                               
      close(10)
      write(*,*) 'finished'
      stop
      end                                                         
                                                                  

