c
c   Program to append seisan waveform files jh, sep 99
c
c   The program uses a filenr.lis input file. All files are read,
c   and  then written out as one new file.
c   The maximum number of channels handles is max_chan_out which
c   is set as a parameter. Only the first max_chan_out channels
c   are used or less if fewer channels in file.
c   A blank line followed by a new group of file will make a new 
c   output file.
c
c   It is assued that all channels have the same start and end times
c   in the same file
c   and that the sample rate is the same.
c
c   The sample rate for the appended file, if more than one input file, is 
c   calculated from the header times of the first and last files. 
c
c
c   changes:
c
c   may 2000 lo : new waveform structure
c
      implicit none
      include 'seidim.inc'                     ! dimensions
      include 'waveform.inc'
C
C    Seisan library details...
C    -------------------------
C
      INCLUDE   'libsei.inc'                   ! Definitions and data defns.
      external  sei open,                      ! Open file handler.
     &          sei close,                     ! Close file handler.
     &          sei code,                      ! Error handler.
     &          sei clen                       ! String length
      integer   sei clen                       ! Function.
c
      integer   code,                          ! Local error condition.
     &          read1                          ! Read unit 1.
      logical   b_flag                         ! Flag existance.?
C
C    -------- end ------------
c                                                                               
c                                                                               
c   local variables                                                             
c                                                          
      integer max_chan_out                ! max number of channels out
      parameter (max_chan_out=7)   
      character*80 mainhead(max_trace)    ! main header
      character*80 mainhead_out(max_trace)! output ----
      character*1040 chead                ! channel header                     
      character*1040 chead_out(max_chan_out)         ! output channel header
      integer isamp(max_chan_out)         ! output sample counter                                                                                
      character*5 net_code                ! code for resampled file
      integer ifile                       ! file counter
      integer nfile                       ! number of files in one sequence
      integer ichan                       ! channel counter
      integer numb_samp                   ! number of samples, one trace
      integer numb_samp_total             ! -------------------------, all
      integer unit_wave                   ! unit to read waveform file from
      integer write01                     ! unit for writing
                                          ! between two files
      real rate                           ! sample rate from header
      real rate_out                       ! sample rate calculated
      logical more_files                  ! there could be more files
c-- plotting string                                      
      character*80 files(200)             ! waveform file name
      character*80 out_file,outfile       ! resampled file name
c-- dc value                                                      
c      integer nchan                          ! number of channels in file
c      integer nchan_out                      ! number of channels out
      double precision   file_start_time     ! abs file start time
      double precision   file_end_time       ! abs file end time
      double precision   first_file_time     ! abs file time, first file
                                             ! decimated output
      real total_time
      integer year1,month1,day1,hour1,min1    ! time etc
      real sec1
c-- counters and help variables
      integer	i		
      integer data_out(max_chan_out,max_sample)  !output 
c
c  for seisin common block
c
c      real data(max_sample)
c      real baz(max_trace)
c      real        del_rot       ! delay rotated trace
c      character*1 rot_comp(max_trace)  ! T or R
c      logical rotate

c      common /signal/data,rotate,baz,rot_comp,del_rot !for seisinc
c


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

c
      write(6,*)
     *' Enter new network code, default is channel one station'
      read(5,'(a5)') net_code
c
c    open file containing list of files numbered                                
c    -------------------------------------------
c                                                                               
      call sei open( old$+warn$,           ! Open & warn of errors.
     &               ' ',                  ! No prompt.
     &               'filenr.lis',         ! Filename.
     &               read1,                ! Open on unit.
     &               b_filenr$,            ! Flag existance & usage?.
     &               code )                ! Condition.
      chr_err_msg$ = 
     &'**** FATAL: problem opening "filenr.lis"'
      call sei code( stop$, code, 0, b_flag ) ! Force an abort on error.
c
c   get  here for another set of files to convert
c
 500  continue
c
c   set some defaults
c
      ifile=1
      do i=1,max_chan_out
         isamp(i)=0                               ! reset output sample counter
      enddo
      numb_samp_total=0
c
c  file read loop
c
 1000 continue
c
c   get next file name
c
      read(read1,'(7x,a)',iostat=code) files(ifile)           ! Read a record.
      call sei code( fort$, code, read1, b_flag )             ! Process outcome.
      if( b_flag.and.ifile.eq.1 ) goto 1999                   ! On end of file.
c-- no more files                        
      if(files(ifile)(1:5).eq.'     '.or.b_flag) then !  new group or eof
         more_files=.true.                ! there could be more files
         nfile=ifile-1                    ! the last was blank
         if(nfile.eq.0) goto 1000         ! could be more blanks
         goto 1200
      endif
      ifile=ifile+1
      goto 1000                           ! read next file
c
c   read filenames of one group, now process
c
 1200 continue
c
c   open and read first file to get specifics
c
      write(6,*)'*********************************************'
      write(6,*) ' Number of files to append:', nfile
      write(6,*)
c      chr_f_access$ = 'direct'            ! Type of file.
c      f_recl$=2048                        ! Record length
c      call sei get file( open$+ignore$,   ! Open waveform file.
c     &                   unit_wave,       ! On unit.
c     &                   code,            ! Returned condition.
c     &                   'WAV',           ! Alternative search directory.
c     &                   files(1))        ! For this filename.
c 
c         if( code .ne. e_ok$ ) then       ! File does not exist
c            write(*,*)
c            write(*,*)
c     &'**** WARN: ',files(ifile)(:seiclen(files(ifile)))
c     &,' does not exist ****'
c            write(*,*)
c            call sei code(stop$,e_misf$,0,b_flag) ! & stop.
c         end if                                   !
c
c   read main header 
c

      wav_filename(1)=files(1)
c
c init wave variables
c
      call wav_init
c
c read header
c
      call read_wav_header(1)
      if(wav_error_message.ne.' ') then
         write(6,'(1x,a)') wav_error_message
         stop   
      endif
c
c generate main header
c
      call wav_sheads(1,net_code,outfile,mainhead,chead)

c      call seisinc                                                           
c     *(unit_wave,0,nchan,0,
c     *mainhead,chead,0.0,0.0)
c      call sei close( close$, unit_wave, code )       ! Close down file

c
c   check for error
c
c      if(nchan.lt.0) then
c         write(6,*)' Something wrong with first file in a sequence'
c         stop
c      endif

   
c
c   save header and file name
c
      do i=1,12
          mainhead_out(i)=mainhead(i)
      enddo
c
c   if more than max_chan_out channels, cut down to max_chan_out 
c
      if(wav_nchan.gt.max_chan_out) then
         write(6,*)' Input file has ',wav_nchan,' channels'
         write(6,*)' The output will only use ',max_chan_out
         wav_out_nchan=max_chan_out
      else
         wav_out_nchan=wav_nchan
      endif
      write(6,*)' Number of channels use:',wav_out_nchan
c
c-------------------------------------------
c   loop for channels
c-------------------------------------------
c                           
      do 1600 ichan=1,wav_out_nchan
c
c   loop for files
c
      do 1500 ifile=1,nfile
         write(6,'(1x,a)') files(ifile)
c        write(27,'(1x,a)') files(ifile)
c         chr_f_access$ = 'direct'            ! Type of file.
c         f_recl$=2048                        ! Record length
c         call sei get file( open$+ignore$,   ! Open waveform file.
c     &                      unit_wave,       ! On unit.
c     &                      code,            ! Returned condition.
c     &                      'WAV',           ! Alternative search directory.
c     &                      files(ifile))    ! For this filename.
c 
c         if( code .ne. e_ok$ ) then       ! File does not exist
c            write(*,*)
c            write(*,*)
c     &      '**** WARN: ',files(ifile)
c     &      (:seiclen(files(ifile))),' does not exist ****'
c            write(*,*)
c            call sei code(stop$,e_misf$,0,b_flag) ! & stop.
c         end if                                   !
c         call seisinc 
c     *   (unit_wave,ichan,nchan,2,
c     *   MAINHEAD,chead,0.0,0.0)

         wav_filename(1)=files(ifile)
c
c init wave variables
c
         call wav_init
c
c read header
c
         call read_wav_header(1)
         if(wav_error_message.ne.' ') then
            write(6,'(1x,a)') wav_error_message
            stop   
         endif
c
c generate headers 
c
         call wav_sheads(1,net_code,outfile,mainhead,chead)
         write(6,'(1x,a)')mainhead(1)(1:79)            
         write(27,'(1x,a)')mainhead(1)(1:79)            
         write(6,'(1x,a)') chead(1:79) 

c
c read channel
c
         call wav_read_channel(ichan)

c
c   check for error
c
c         if(nchan.lt.0) then
c            write(6,*)' Something wrong with input file'
c            stop
c         endif

c
c   if first file, save channel header
c
         if(ifile.eq.1) then
           chead_out(ichan)=chead
         endif           
c                                                    
c   get srate and number of samples                                               
c                                                                               
c        read(chead(37:50),'(f7.2,1x,i6)') rate,numb_samp
         rate=wav_rate(ichan)
         numb_samp=wav_nsamp(ichan) 
         if(ichan.eq.1) numb_samp_total=numb_samp_total+numb_samp
c
c   get times
c
         year1=wav_year(ichan)
         month1=wav_month(ichan)
         day1=wav_day(ichan)
         hour1=wav_hour(ichan)
         min1=wav_min(ichan)
         sec1=wav_sec(ichan)
         call timsec(year1,month1,day1,hour1,min1,sec1,file_start_time)
c
c   save start time and make output file name if first file
c
         if(ifile.eq.1) then
           first_file_time=file_start_time
           
           if (net_code.eq.'     ') then
             net_code = wav_stat(1)
           endif
           call wav_sheads(1,net_code,out_file,mainhead,chead)
           out_file(19:19)='A'
         endif

c
c  put in  output buffer
c
         do i=1,numb_samp
           isamp(ichan)=isamp(ichan)+1
           data_out(ichan,isamp(ichan))=signal1(i)
         enddo
c
c         call sei close( close$, unit_wave, code )       ! Close down file
         file_end_time=file_start_time+(numb_samp)/rate ! start of next file
c
c  end of file loop
c
 1500 continue
c
c   end of channel loop
c
 1600 continue
c
c-----------------------------------------------------------------------
c   enter here when all files read for one sequence
c-----------------------------------------------------------------------
c
c
 1700 continue
c
c   calculate observed sample rate if more than one file read, assume
c   file follow each other
c
c     if(nfile.gt.1) then
c        rate_out=
c    *   (file_start_time-first_file_time)/(numb_samp_total-numb_samp)
c        rate_out=1.0/rate_out
c        write(6,*) 'Sample rate from header times:', rate_out
c        rate=rate_out
c     endif
c
c  calculate new sample rate
c
c     rate=rate/float(skip)
c
c   finish making main header and write it out, assume max 30 channels
c
      total_time=float(isamp(1))/rate       ! assume all channels same isamp
      write(mainhead_out(1)(61:69),'(f9.2)') total_time
      write(mainhead_out(1)(31:33),'(i3)') wav_out_nchan
      do i=3,(wav_out_nchan-1)/3+3
         if(total_time.gt.99999.0) then
            write(mainhead_out(i)(19:26),'(f8.1)') total_time
            write(mainhead_out(i)(45:52),'(f8.1)') total_time
            write(mainhead_out(i)(71:78),'(f8.1)') total_time
         else
            write(mainhead_out(i)(19:26),'(f8.2)') total_time
            write(mainhead_out(i)(45:52),'(f8.2)') total_time
            write(mainhead_out(i)(71:78),'(f8.2)') total_time
         endif
      enddo
      write(6,'(a,1x,a)') ' Output file name is: ',out_file(1:40)
c
c   open file and write main header
c
      chr_f_form$ = 'unformatted'
      call sei open( unknown$,             ! Open file (default=stop on error)
     &                   ' ',              ! Prompt (n/a).
     &                   out_file,         ! Filename.
     &                   write01,          ! Unit opened on.
     &                   b_flag,           ! Flag.
     &                   code )            ! Returned condition.
      do i=1,12
         write(write01)mainhead_out(i)
         if(i.lt.4) write(6,'(a79)') mainhead_out(i)(1:79)		 
      enddo
c
c   write channels, 99999945 to round off
c
      do ichan=1,wav_out_nchan
         chead_out(ichan)(1:5)=wav_stat(ichan)
         chead_out(ichan)(6:9)=wav_comp(ichan)
         write(chead_out(ichan)(37:50),'(f7.3,i7)')rate,isamp(ichan)
         if(rate.lt.99.999945)
     *   write(chead_out(ichan)(37:50),'(f7.4,i7)')rate,isamp(ichan)
         if(rate.lt.9.9999945)
     *   write(chead_out(ichan)(37:50),'(f7.5,i7)')rate,isamp(ichan)
         if(rate.lt.0.99999945)
     *   write(chead_out(ichan)(37:50),'(f7.6,i7)')rate,isamp(ichan)
         chead_out(ichan)(77:77)='4'    ! always store as 4 byte
         write(write01) chead_out(ichan)
         write(6,'(1x,a)') chead_out(ichan)(1:79)
         write(write01) (data_out(ichan,i),i=1,isamp(ichan))
      enddo
      call sei close( close$, write01, code )       ! Close down file
c
c  check if more files to convert
c
      goto 500
c
c
 1999 continue
      stop
      end

