c
c  program to make proper waveform file names from header info
c  program can make a time change to all headers
c  program to make polarity changes to individual channels, only 
c          channels where station and component is gien in input
c          definition in wavfix.def, will be used
c
c  j. havskov, december 1995
c  Updates:
c  aug 2 96 by jh : 2 byte data were decleared as 4 bytes !!!
c--------------------------------------------------------------------
c  oct 98 by jh   : --------------    version 7.0 check ------------
c                   remove pc names, year 2000, 5 char agency
c  nov 5          : linux logic, system_c to systemc
c  feb 5          : include channel name change
c  june 11   lo   : use also Nordic file as input and wavfix.def
c  sep 9     jh   : make shure net code is not blank in output name
c  jan 10,2003 lo : apply individual channel time correction given in wavfix.tim
c  oct 20      jh : make it possible ot hardwire sample rate changes, look 
c                   for new_rate
c  feb 10 2004 lo : fix bug with net_code
c  may 12 2004 jh : possibel to change polarity by changing gain constat
c  mar 30 2006 lo : use converted station/component codes in output filenames
c  mar  5 2007 lo : add option to mark uncertain time, and command line options
c
      implicit none
c
c   general dimensions
c
      include 'seidim.inc'

c-- main header
      character*80 mainhead(max_trace)
c-- channel header
      character*1040 chahead	  
c-- input file name
      character*80 infile
c-- output file name 
      character*80 outfile
c -- for channel redefination
      character*5 stat_in
      character*4 comp_in
      logical change
      character*5 stat(max_trace)  ! staions in header
      character*4 comp(max_trace)  ! components in header
      logical chg_pol(max_trace)   ! true if channel pol changed
      real new_rate(max_trace)     ! new sample rate
      real cinter(max_trace),cstart(max_trace) ! start and interval each trace
      double precision ind_time_cor(max_trace) ! individual time correction
      character*80 text      ! general text string
      character*1 answer
      character*1 polarity_change    ! if yes, change polarity
      character*1 uncertain_time_change ! if yes mark time as uncertain
      logical exist          ! for file open
      logical same_file      ! if same name of in and output file
c-- merged file network code
      character*5 net_code,net_code_out
c-- counters, etc
      integer i,k,l,j
      integer nchan,nstat,nsamp     ! number of channels and samples
      integer*4 data4(max_sample) ! samples
      integer*2 data2(2*max_sample)   ! samples
c--- time and dates
      integer year,month,day,hour,min,year1,month1,day1,hour1,min1
      integer doy,doy1
      real sec, sec1
      double precision time_cor           ! time correction in seconds
      double precision msec               ! time correction in seconds
      integer khead           ! number of main headers
      character*1 replace_filename
c-- computer type
      logical sun,pc,linux
c
c   chan def block
c
      character*5 def_in_stat(200)  ! input station code in def file
      character*4 def_in_comp(200)  ! input component code in def file
      character*5 def_out_stat(200) ! output station code in def file
      character*4 def_out_comp(200) ! output component code in def file
      integer   def_chan_number(200)! channel number of current unit
      integer ndef_chan             ! number of channels defined
      common /def_chan/def_in_stat,def_in_comp,def_out_stat,
     *                 def_out_comp,def_chan_number,ndef_chan
c
c	  
C    Seisan library inserts and routines...
C    ======================================
C
       include 'libsei.inc'                ! Library definitions & data defns.
       external sei open,                  ! Open file routine.
     &          sei close,                 ! Close file routine.
     &          sei code,                  ! Error encoder.
     &          sei real num               ! Get real number
       integer  seiclen
C
       integer  
     &          read01,                    ! Input unit1.
     &          read02,                    ! Ditto 2.
     &          read03,
     &          code                       ! Local condition.
       logical  b_flag                     ! Flag end of file?.
       character*80 chr_file               ! File name
       real sei real num                   ! Real number
C
C    ============= end of list ==========
      real x(max_sample)
c-- for component rotation, not used in this routine
      real baz(max_trace)
      real        del_rot       ! delay rotated trace
      character*1 rot_comp(max_trace)  ! T or R
      logical rotate
      character*29 mainhead_text
c-- name of sfile
      character*40 nordic_file
c output file unit 
      integer write01
      character*1 choice
      character*80 line
      equivalence(data2,data4)
c question
      character*80 question
c 1 if filenr.lis
      integer in
c number of components defined in wavfix.tim
      integer ntime
      integer narg                            ! number of arguments
      character*80 arg(40)                    ! arguments


      common /signalx/x,rotate,baz,rot_comp,del_rot

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
    
      replace_filename='N'
      net_code=' '
      polarity_change='n'
      uncertain_time_change='n'
      ntime=0
      time_cor=0.
      in=0
      call computer_type(sun,pc,linux)

c
c read command line options
c

c
c   get arguments
c
      call get_arguments(narg,arg)
      if (narg.ge.1) then
        do i=1,narg
          if (arg(i)(1:15).eq.'-uncertain_time') then
            uncertain_time_change='y'
          elseif (arg(i)(1:9).eq.'-polarity') then
            polarity_change='y'
          elseif (arg(i)(1:7).eq.'-infile') then
            infile=arg(i+1)
          elseif (arg(i)(1:10).eq.'-overwrite') then
            replace_filename='A'
          elseif (arg(i)(1:16).eq.'-time_correction') then
            call sei get values(1,arg(i+1), code )
            time_cor=array$(1)
          elseif (arg(i)(1:5).eq.'-help') then
            write(6,'(a)') 'wavfix' 
            write(6,'(a)') 'usage: wavfix -infile <infile> ' 
     &        //'[-uncertain_time -polarity] '
     &        //'[-time_correction <x in seconds> ]'
            write(6,'(a)') '-uncertain_time   add uncertain time flag '
     &                   //'to all channel headers'
            write(6,'(a)') '-polarity         change polarity'    
            write(6,'(a)') '-time_correction  apply time correction '
     &        //'of x seconds'
            stop
          endif
        enddo
        if (seiclen(infile).le.0) then
          write(*,*) 'give input file' 
          stop
        endif
        goto 30
      endif
        

c
c   hardwire possible sample rate changes
c
      do i=1,max_trace
         new_rate(i)=-1.0
      enddo


c
c   get def file for station codes, give file name
c
      text='wavfix.def'

      call read_def_chan(text,mainhead_text,net_code)
      call read_def_time('wavfix.tim',ntime)

      write(6,*)' This program will change header times in all headers'
      write(6,*)' with the same amount. The waveform file name will be'
      write(6,*)' changed at the same time and adjusted to the standard'
      write(6,*)' name.'
      write(6,*)' If no time correction is given, only the waveform'
      write(6,*)' names are adjusted.'
      write(6,*)' Optionally polarty can be changed for channels',
     *          ' listed in wavfix.def'
      write(6,*)' In addition, channels names can be changed if a'
      write(6,*)' wavfix.def file is available'

      if (ntime.eq.0) then
        write(6,*)
     &    ' Time correction in seconds, u for uncertain time, '
     &    //' return for no correction'
        read(5,'(a)') text
        if (text(1:1).eq.'u'.or.text(1:1).eq.'U') then
          uncertain_time_change='y'
          time_cor=0.
        else
          time_cor=sei real num(text,code)
        endif
      else
        write(6,*) 
     &    ' Time correction applied from file wavfix.tim '
      endif
      write(6,*)' Polarity change(y/n=default)'
      polarity_change='n'
      read(5,'(a)') polarity_change
      if(polarity_change.eq.'y') then
          write(6,*)' Sure you want to change polarity (y/n) ?'
          read(5,'(a)') answer
          if(answer.ne.'y') polarity_change='n'
      endif
      write(6,*)

220   continue

      write(*,*) ' Input options: (1) filenr.lis or wavfeform file name'
      write(*,*) '                (2) Nordic file'
      read(5,'(a1)') choice
      if (choice.ne.'1'.and.choice.ne.'2')goto 220

      if (choice.eq.'2') then
        write(6,*) ' Name of Nordic file'
        read(5,'(a40)') nordic_file
        if (nordic_file.eq.'nordic.fix') then
           write(*,*) ' Please rename your input file.'
           stop
        endif
      endif

225   continue

      if (choice.eq.'1') then
        question=' Filename or number, filenr.lis for all'
        call filename(question,infile)

        if (infile(1:3).eq.'EOF') stop
      endif

c
c   open file with file names
c	  	  
      if (choice.eq.'1') then
        if(infile(1:10).eq.'filenr.lis') then
          call sei open( old$+stop$,       ! Open file & stop if erro.
     &                   ' ',              ! Prompt (n/a).
     &                   'filenr.lis',     ! Filename.
     &                   read01,           ! Unit opened on.
     &                   b_flag,           ! Flag.
     &                   code )            ! Returned condition.
        in=1
        endif
        if (code .ne. e_ok$) then      
          write(6,*)' No filenr.lis file, make a dirf first'
          stop
        endif

      elseif (choice.eq.'2') then
          call sei open( old$+stop$,       ! Open file & stop if erro.
     &                   ' ',              ! Prompt (n/a).
     &                   nordic_file,      ! Filename.
     &                   read01,           ! Unit opened on.
     &                   b_flag,           ! Flag.
     &                   code )            ! Returned condition.
        if (code .ne. e_ok$) then         
            write(6,*) 'file does not exist'
            stop
        endif
c
c open output file
c
        call sei open( unknown$+warn$,       ! Open file & stop if erro.
     &                   ' ',              ! Prompt (n/a).
     &                   'nordic.fix',     ! Filename.
     &                   write01,           ! Unit opened on.
     &                   b_flag,           ! Flag.
     &                   code )



      endif


11     continue
c 
c----------------------------------------------
c   enter here for new event to name or fix
c----------------------------------------------
c
 1    continue 

      if (in.eq.1) then
        read(read01,'(7x,a)', end=999) infile
c-- check if end of group of events to name	  
        if(infile(1:4).eq.'    ') goto 999

c
c  read from Nordic file
c
      elseif (choice.eq.'2') then
        read(read01,'(a80)',end=999) line

        if(line(80:80).eq.'6') then
          infile=' '
          read(line(2:79),'(a78)') infile

c
c  check if file exists
c
          inquire(file=infile,exist=exist)
          if (.not.exist) then
               write(write01,'(a80)') line
               write(*,*) 'file does not exist: ',infile
               if (in.eq.1.or.choice.eq.'2') goto 1
               if (choice.eq.'1') goto 225
          endif
        else
          write(write01,'(a80)') line
          if (in.eq.1.or.choice.eq.'2') goto 1
          if (choice.eq.'1') goto 225
        endif
      endif

c
c   now read header for one event
c	  
 30   continue
      mainhead_text = ' '
c      net_code=' '
      net_code_out=net_code
      do i=1,5
        if (net_code_out(i:i).eq.' ') net_code_out(i:i)='_'
      enddo
c      time_cor=0.
      do i=1,max_trace
        ind_time_cor(i)=0.
      enddo
          chr_f_access$='direct'
          f_recl$=2048
          chr_file = infile
          call sei open( old$+stop$,       ! Open file & stop if erro.
     &                   ' ',              ! Prompt (n/a).
     &                   chr_file,          ! Filename.
     &                   read02,           ! Unit opened on.
     &                   b_flag,           ! Flag.
     &                   code )            ! Returned condition.
      write(6,'(1x,a,a)') 'Input file name: ',infile(1:45)
       call seisinc                                                             
     *(read02,0,nchan,0,mainhead,chahead,0.0,0.0)
c
c   read header channel names, might be needed
c
      nstat=1
      do i=3,(nchan-1)/3+3
            read(mainhead(i),'(3(1x,2a4,a1,f7.2,1x,f8.2))')
     *      stat(nstat)(1:4),  comp(nstat),  stat(nstat)(5:5),  
     *      cstart(nstat),cinter(nstat),
     *      stat(nstat+1)(1:4),comp(nstat+1),stat(nstat+1)(5:5),
     *      cstart(nstat+1),cinter(nstat+1),	 
     *      stat(nstat+2)(1:4),comp(nstat+2),stat(nstat+2)(5:5),
     *      cstart(nstat+2),cinter(nstat+2)	 
            nstat=nstat+3		   		 
      enddo
 
c
c individual channel time correction
c
      if (ntime.ne.0) then
           read (mainhead(1)(34:59),'(i3,1x,i3,1x,4(i2,1x),f6.3)')
     *     year,doy,month,day,hour,min,sec
           year=year+1900       
           call timsec(year,month,day,hour,min,sec,msec)
           do i=1,nchan
             if (seiclen(stat(i)).gt.0) then
               call set_time_chan(
     &           stat(i),comp(i),msec+cstart(i),ind_time_cor(i))
               write(*,*) ' time correction for '//stat(i)//comp(i)//
     &          ': ',ind_time_cor(i)
             endif
           enddo
      endif

c
c if individual correction for 1st channel, set time_cor to this value
c
      if (ind_time_cor(1).ne.0.) then
         time_cor=ind_time_cor(1)
      endif
c
c   if a time correction, change header
c
      if(time_cor.ne.0.) then
         read (mainhead(1)(34:59),'(i3,1x,i3,1x,4(i2,1x),f6.3)')
     *   year,doy,month,day,hour,min,sec
         year=year+1900       
         call timadd(year,month,day,hour,min,sec,time_cor,
     *             year1,month1,day1,hour1,min1,sec1)  ! add correction
         call date_doy(doy1,day1,month1,year1)
         k=year1-1900
         write (mainhead(1)(34:59),'(i3,1x,i3,1x,4(i2,1x),f6.3)')
     *   k,doy1,month1,day1,hour1,min1,sec1
      endif       
c
c if no individual time correction set values for channel correction to time_cor
c
      if (ntime.eq.0) then
        do i=1,nchan
          ind_time_cor(i)=time_cor
        enddo
      endif

c                                                                               
c  make output file name 
c             
      if ((ntime.ne.0.or.time_cor.ne.0.).and.
c     &    (replace_filename.ne.'A'.and.replace_filename.ne.'E')) then
c lot 24/5/2005
     &    (replace_filename.ne.'A'.and.replace_filename.ne.'E')
     &    .and.outfile(21:25).ne.net_code_out) then
        write(*,*) ' keep input file name as output file name '//
     &     ', (y)es,(n)o, (a)lways or n(e)ver ? '
        replace_filename=' '
        read(5,'(a)') replace_filename
        if (replace_filename.eq.'y') replace_filename='Y'
        if (replace_filename.eq.'n') replace_filename='N'
        if (replace_filename.eq.'e') replace_filename='E'
        if (replace_filename.eq.'a') replace_filename='A'
      endif

      outfile=' '
      if (replace_filename.ne.'N'.and.replace_filename.ne.'E') then
        outfile=infile
      else
         
c-- year                          
         outfile(3:4)=mainhead(1)(35:36)
         outfile(1:2)='19'
         if(mainhead(1)(34:34).eq.'1') outfile(1:2)='20'
         outfile(5:5)='-'               
c-- month                                    
         outfile(6:7)=mainhead(1)(42:43)		
         outfile(8:8)='-'
c-- day                                      
         outfile(9:10)=mainhead(1)(45:46)		
         outfile(11:11)='-'
c-- hr                                       
         outfile(12:13)=mainhead(1)(48:49)		
c-- min                                    
         outfile(14:15)=mainhead(1)(51:52)		
         outfile(16:16)='-'
c-- sec                                    
         outfile(17:18)=mainhead(1)(54:55)		
         outfile(19:20)='S.'
c
c convert station and channel for first channel and use for filename
c lot 07/03/2006
c
         stat_in = stat(1)
         comp_in = comp(1)
         call set_def_chan(1,stat(1),comp(1))
c
c-- network or station code, if not defined used from input fike name, else 
c   first station                  
c         if(seiclen(net_code).le.0) then
          if(seiclen(net_code_out).le.0.or.net_code_out.eq.'_____') then
c            if(infile(19:20).eq.'S.') then
            if(infile(19:20).eq.'S.'.and.nchan.gt.1) then
c              net_code=infile(21:25)
              net_code_out=infile(21:25)
            else
c              net_code=stat(1)
              net_code_out=stat(1)
            endif
         endif
c         outfile(21:25)=net_code		
         outfile(21:25)=net_code_out
         outfile(26:26)='_'
c-- number of channels
         outfile(27:29)=mainhead(1)(31:33)
c-- check for blanks                                        
         do i=1,18				
            if(outfile(i:i).eq.' ') outfile(i:i)='0'                            
         enddo                                                                  
         do i=19,26
            if(outfile(i:i).eq.' ') outfile(i:i)='_'
         enddo
         do i=27,29
            if(outfile(i:i).eq.' ') outfile(i:i)='0'
         enddo
c-- add component code if only one channel
         if (nchan.eq.1) then
           outfile(31:34)=comp(1)
           do i=30,seiclen(outfile)
              if(outfile(i:i).eq.' ') outfile(i:i)='_'
           enddo
         endif
       endif
c
c restore station and component codes
c
       stat(1)= stat_in
       comp(1)= comp_in

         write(6,200) outfile(1:seiclen(outfile))                                             
 200     format(' Output file name ',a)                                
         write(6,*)

c 
c check if input name same as output name
c
      same_file=.false.
      write(*,*) infile
      write(*,*) outfile

c      if (outfile(1:29).eq.infile(1:29)) same_file=.true.
      if (outfile(1:seiclen(outfile)).eq.
     &     infile(1:seiclen(outfile))) same_file=.true.
c
c   check that outfile name is not the same as an input
c   file names in which case the event should not be renamed if
c   there is no internal changes
c
      call sei open( check$,                  ! Try to open & warn.
     &               ' ',                     ! No prompt.
     &             outfile,                   ! This file.
     &               read03,                  ! On unit.
     &               exist,                   ! File exists?.
     &               code )                   ! Condition.

c      if (exist) then                      
c         same_file=.true.
      if (exist.and..not.same_file) then
c         if(time_cor.ne.0.) then
            write(6,*)' Name already exists, overwrite (y/n)'
            read(5,'(a)') answer
            if(answer.ne.'y'.and.answer.ne.'Y') then
               call sei close(close$,read02,code)
               call write_out(write01,choice,line,outfile)
               if (in.eq.1.or.choice.eq.'2') goto 1
               if (choice.eq.'1') goto 225
            endif

c         else
c           write(6,*)' Name already exists, no rename,',
c     *      ' return to continue'
cc            read(5,'(a)') answer
c            call sei close(close$,read02,code)
c            call write_out(write01,choice,line,outfile)
c               if (in.eq.1.or.choice.eq.'2') goto 1
c               if (choice.eq.'1') goto 225
c         endif
            
c
c  if a time correction, or channel name change
c  the output file must have a different name
c  temporarely, to be able to read the old file with the same name
c
c         if(time_cor.ne.0.0) then
c           same_file=.true.
c         endif
      endif

c
c change station and component code
c
      change = .false.
      do k=1,nchan
        chg_pol(k)=.false.
        stat_in = stat(k)
        comp_in = comp(k)
c
c   polarity should be changed if input and def stat and comp is the same
c
        do i=1,ndef_chan
           if(stat_in.eq.def_in_stat(i).
     *     and.comp_in.eq.def_in_comp(i)) 
     *     chg_pol(k)=.true.
        enddo
c
        call set_def_chan(k,stat(k),comp(k))
        if (.not.change) then
          if (comp(k).ne.comp_in) change=.true.
          if (stat(k).ne.stat_in) change=.true.
        endif
c
c   check for time change
c
        if (ind_time_cor(k).ne.0.) change=.true.

      enddo
      if (uncertain_time_change.eq.'y') change=.true.
c
c   rename only
c
      if(time_cor.eq.0..and.(.not.change).and.
     *   polarity_change.ne.'y'.and.
     *   uncertain_time_change.ne.'y') then
         call sei close(close$,read02,code)
         k=seiclen(infile)+seiclen(outfile)   
         if(sun.or.linux) 
     *   call systemc('mv '//infile(1:seiclen(infile))//
     *   ' '//outfile(1:seiclen(outfile)),k+4)
         if(pc) call systemc('rename '//infile(1:seiclen(infile))//
     *   ' '//outfile(1:seiclen(outfile)),k+8)

      else
c
c   correct all headers and rewrite file
c
         if(same_file) then   ! make a temporary file
c            write(*,*) ' new file same as old, creating wavfix.tmp '
            open(2,file='wavfix.tmp', 
     *      status='unknown',form='unformatted')
         else
c if file exists and overwrite confirmed
            if (exist) then
              open(2,file=outfile,status='unknown',form='unformatted')
            else
              open(2,file=outfile,status='new',form='unformatted')
            endif
         endif

c
c   write in header
c
             l=2
             k=3	  
             do j=1,nchan
                write(mainhead(k)(l:l+24),'(2a4,a1,f7.2,1x,f8.2)')
     *          stat(j)(1:4),comp(j),stat(j)(5:5),
     *          cstart(j)+ind_time_cor(j)-time_cor,cinter(j)		   
                l=l+26
                if(l.gt.60) then
                   l=2
                   k=k+1
                endif
             enddo			
c
c   write main header
c
         khead=(nchan-1)/3+3
         if(khead.lt.12) khead=12    ! never less than 12 main headers
c
         do i=1,khead
            write(2) mainhead(i)
         enddo         
c
c   read each channel, fix time, channel names or polarity and rewrite
c
         do i=1,nchan            ! fix headers in all channels
c           write(6,*) i
            call seisinc                                                             
     *      (read02,i,nchan,2,mainhead,chahead,0.0,0.0)
            read (chahead(10:35),'(i3,1x,i3,1x,4(i2,1x),f6.3)')
     *      k,doy,month,day,hour,min,sec       
            year=k+1900
            call timadd(year,month,day,hour,min,sec,ind_time_cor(i),
     *             year1,month1,day1,hour1,min1,sec1)  ! add correction
            call date_doy(doy1,day1,month1,year1)
            k=year1-1900
            write (chahead(10:35),'(i3,1x,i3,1x,4(i2,1x),f6.3)')
     *      k,doy1,month1,day1,hour1,min1,sec1
c
c   possibly correct sample rate
c
            if(new_rate(i).gt.0.0)  
     *      write(chahead(37:43),'(f7.3)') new_rate(i)
c
            read(chahead(44:50),'(i8)') nsamp
c
c   put in possibly new channel names, could be the same if polarity fix
c
            chahead(1:5)=stat(i)
            chahead(6:9)=comp(i)
c
c  option for changing polarity by changing gain constant
c
            if(polarity_change.eq.'y'.and.chg_pol(i)) 
     *      then
                  chahead(76:76)='G'
                  chahead(148:159)='  -1.0      '
            endif
c
c option to mark uncertain time
c
            if (uncertain_time_change.eq.'y') then
                   if (chahead(29:29).eq.'E') then
                     chahead(29:29)=' '
                   else
                     chahead(29:29)='E'
                   endif
            endif
c
            write(2) chahead   ! write header
            if(chahead(77:77).eq.'4') then
               do k=1,nsamp
                  data4(k)=x(k)
               enddo
               write(2)(data4(k),k=1,nsamp)
            else
               do k=1,nsamp
                  data2(k)=x(k)
               enddo
               write(2)(data2(k),k=1,nsamp)
            endif
         enddo
         close(2)
         call sei close(delete$,read02,code)
c
c   rename temporary file if used
c
         if(same_file) then
            k=seiclen('wavfix.tmp')+seiclen(outfile)   
            if(sun.or.linux) call systemc('mv '//'wavfix.tmp'//
     *      ' '//outfile(1:seiclen(outfile)),k+4)
            if(pc) then
               call systemc('del '//outfile(1:seiclen(outfile)),
     *         seiclen(outfile)+4)
               call systemc('rename '//'wavfix.tmp'//
     *         ' '//outfile(1:seiclen(outfile)),k+8)
            endif
         endif
      endif       
c
c   get next file
c
      call write_out(write01,choice,line,outfile)
      if (in.eq.1.or.choice.eq.'2') goto 1
      if (choice.eq.'1') goto 225
c
 999  continue	  

      if (choice.eq.'2') then
         write(*,*) 'Nordic output file: nordic.fix'
         call sei close(close$,write01,code)
      endif
      stop
      end	  	  	 

      subroutine write_out(write01,choice,line,outfile)
c 
c write to nordic file
c
      implicit none
      integer write01,seiclen
      character*80 line,outfile
      character*1 choice

      if (choice.eq.'2') then
        line(1:40)='                                        '
        line(41:80)='                                       6'
        line(2:1+seiclen(outfile))=outfile(1:seiclen(outfile))
        write(write01,'(a80)') line
      endif

      return
      end

      
