c                                                                               
c    transform an ascii file to seisan data file. the input file only contains
c    one column of samples 
c                                                                               
c    j. havskov jan 96                    
c    may 11  00    lo : use read_resp_head
c    feb 02  03    jh : small clean up
c    sep 13           : add input of psn ascii
c    dec 17 2003   jh : fix channel header year, no century
c    aug 30, 2005  jh : fix filename and network code
c    oct 18  2005     : put in scale factor
c
c    latest update                                                              
c
      implicit none
      include 'seidim.inc'
      include 'libsei.inc'
c                                                                               
c-- seisnor data file channel header      
      character*1040    chahead         
c-- -------------------main --------      
      character*80     mainhead(max_trace)
      character*80     text        
c-- date and time
      integer year,month,day,hour,min
      real sec
c-- output file name                                  
      character*80	outfile		
      character*80  question
      character*80  infile
c      character*50      save_head	
c-- stations and components
      character*4 comp(max_trace)
      character*5 stat(max_trace)
c-- data vector, one buffer or one channel                              
      integer*4     data4(max_sample)
      real          x(max_sample)
      real          factor		! scale factor



c-- data interval each channel, start time
      real cinter(max_trace),cstart(max_trace)
c-- number of channels and samples/chan, total number of samples           
      integer nchan,nsamp
c-- sample rate                                              
      real		rate		
c-- help variables                                     
      integer		i,in
 
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
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
      write(6,'(1x,a)') infile
c
c  open file 
c
       open(1,file=infile,status='old')

c
c   check if a psn ascii file
c
       read(1,'(a)' )text
       if(text(1:5).eq.'! PSN') then
          read(1,'(12x,i4,4(1x,i2),1x,f6.3)') 
     *    year,month,day,hour,min,sec
          read(1,'(a)') text
          read(1,'(4x,i4)') i
          rate=i
          do i=1,7
            read(1,'(a)') text
          enddo
          read(1,'(16x,a5)') stat(1)
          if(stat(1).eq.' ') stat(1)='STAT '
          do i=1,4
             read(1,'(a)') text
          enddo
          write(6,'(a)') text
          comp(1)='S   '
          read(1,'(20x,a1)') comp(1)(4:4)
          do i=1,12
            read(1,'(a)') text
          enddo
       else
c
c   get parameters
c
          write(6,*) 'year,month,day,hour,min,sec'
          read(5,*) year,month,day,hour,min,sec
          write(6,*)'sample rate'
          read(5,*) rate
          write(6,*)'station, max 5 chars' 
          read(5,'(a5)') stat(1)
          write(6,*)'component, max 4 chars' 
          read(5,'(a4)') comp(1)
       endif
       factor=1.0
       write(6,*)' Enter scale factor, return for no scaling'
       read(5,'(a)') text
       if(text.ne.' ') then
         call sei get values (1,text,i) 
         factor=array$(1)
       endif
       
c
c   read data
c
       nsamp=1
 222   continue
       read(1,*,end=333,err=333) x(nsamp)
c      write(6,*) x(nsamp),factor
       data4(nsamp)=x(nsamp)*factor
       nsamp=nsamp+1
       goto 222
 333   continue
       nsamp=nsamp-1

       cinter(1)=(nsamp-1)/rate

c                                                                               
c  make file name and main header
c             
         nchan=1
         call mfhead(year,month,day,hour,min,sec,cinter(1),nchan,
     *   stat(1),stat,comp,cstart,cinter,outfile,mainhead)
c
c   different components could be at the same time, add
c   component id to file name
c
         outfile(30:30)='_'
         outfile(32:32)=comp(1)(4:4)
         outfile(31:31)=comp(1)(1:1)
         do i=30,32
            if(outfile(i:i).eq.' ') outfile(i:i)='_'
         enddo
         write(6,'(a,a)') ' Outfile name: ',outfile(1:32)
c
c  open file
c
         open(2,file=outfile,status='unknown',form='unformatted')
c                                                                               
c   write  main header                                       
c                                                                               
         write(6,'(a)') mainhead(1)(1:75)
         do i=1,12
            write(2) mainhead(i)                                         
         enddo
c                                                                               
c  write channel with channel header
c                                                                               
            do i=1,1040                                                         
               chahead(i:i)=' '                                                 
            enddo                                                               
c-- station code                          
            chahead(1:5)=stat(1)
c-- componnet
            chahead(6:9)=comp(1)	
c-- year, date and time                  
            chahead(10:35)=mainhead(1)(34:59)		
            write(chahead(37:43),'(f7.2)') rate                          
            write(chahead(45:50),'(i6)') nsamp                                  
c                                                                               
c   get response
c
             call read_resp_head(chahead)       
c
c   indicate 2 or 4 byte integer in header
c
             chahead(77:77)='4'
c                                                                               
c   write header                                                                
c                                                                               
            write(2)chahead                                                     
            write(6,'(1x,a70)') chahead(1:70)                                   
c  
c   write data
c
            write(2)(data4(i),i=1,nsamp)
            close(2)
c
c   back for next file
c
            if(in.eq.1) goto 1000                                                                    
 99   continue                                                                  
      stop                                                                      
      end                                                                       


