c   T. Miyatake 
c
        parameter (NMAX=144000)
        real*4  wave(NMAX,3), cmpaz(3), cmpinc(3), ff(NMAX) 
        integer jsignl(NMAX)
	character kstnm*8, header*80, c*20,lcode*3,code*3
	character ofname(3)*80, tail(3)*6
        data tail/'.z.vbb', '.n.vbb', '.e.vbb'/
        data cmpaz / 0.0,  0.0, 90.0 /
        data cmpinc/ 0.0, 90.0, 90.0 / 
c
c       call cleanstr(kstnm)
c       call cleanstr(ofname)
c
        xlon = 128.09667
        ylat =  26.59333
        zelv = 100.0
        delt = 1.0 / 20.0 
        npts = 0
        zero = 0.0
        f00  =  0.0
        f90  = 90.0
        read(5,*) code
        read(5,*) iyr1, idate1, isec1, iyr2, idate2, isec2
        kstnm = ' '//code
        do 10 k=1,3
          lcode(k:k) = char(ichar(code(k:k)+32))
 10     continue
        if (code(1:3) .eq. 'TSK') then
          xlon = 140.1097
          ylat =  36.2108
          zelv = 350.0
        else if (code(1:3) .eq. 'SHK') then
          xlon = 132.6775
          ylat =  34.5322
          zelv = 285.0
        else if (code(1:3) .eq. 'OGS') then
          xlon = 142.2000
          ylat =  27.0500
          zelv =  20.0
        else if (code(1:3) .eq. 'OKI') then
          xlon = 128.09667
          ylat =  26.59333
          zelv = 100.0
        else if (code(1:3) .eq. 'HCH') then
          xlon = 139.8000
          ylat =  33.1167
          zelv = 100.0
        else if (code(1:3) .eq. 'KKJ') then
          xlon = 140.1760
          ylat =  41.7790
          zelv =  70.0
        else
          write(0,*) 'Input station name error in asciitosac'
          stop
        end if
c
        nrec = 0
        num0 = 0
        idelay = 0
 1001   read(5,'(A30)',end=1002) header
c       write(6,*) ' header:', header
        read(header,'(7I2)') iyr, imon, iday, ihour, im, isec, mm
        read(header,'(24X,I4)') num 
        write(6,*) '   num of data ', num
c       write(6,'(2X,7I5)') iyr, imon, iday, ihour, im, isec, mm
        if(nrec.eq.0) then
          jyr    = iyr + 1900
          call julday(jyr,imon,iday,jday)
          imon1  = imon
          ihour1 = ihour
          imin1  = im
          isec1  = isec
          imm    = mm
        endif
c-----------------------------
        do 2 jc = 1, 3
           read(5,*) ( jsignl(i), i = 1, num )
c          write(6,'(15I5)') ( jsignl(i), i = 1, num )
           if(nrec.eq.0.and.isec.ne.0) then
              idelay = isec * 20
              do 1 i = idelay+1, num 
                 if(jc.eq.1) npts = npts + 1 
 1               wave(i-idelay,jc) = jsignl(i)
            else
              do 3 i = 1, num 
                 if(jc.eq.1) npts = npts + 1 
 3               wave(i+num0-idelay,jc) = jsignl(i)
           endif
 2      continue
        num0 = num0 + num
c-----------------------------
        if(nrec.eq.0) then
           mm1 = mm
           write(c,'(5I2.2)') iyr,imon,iday,ihour,im
           do 200 jc = 1, 3
              ofname(jc) = ' '
              ofname(jc) = c(1:10)//'.'//lcode(1:3)//tail(jc)
 200       continue
        endif
        nrec = nrec + 1
c
        goto 1001
c
 1002   continue
c
c       do 987 j = 1, 200
c 987      write(6,'(3F10.4)') (wave(j,i),i=1,3)
        do 300 i = 1,  3
           call newhdr
           call setnhv('npts',npts,nerr)
           call setfhv('b',zero,nerr)
           call setlhv('leven',.true.,nerr)
           call setfhv('delta',delt,nerr)
           call setihv('ievtyp','iquake',nerr)
           call setnhv('nzyear',jyr,nerr)
           call setnhv('nzjday',jday,nerr)
           call setnhv('nzhour',ihour1,nerr)
           call setnhv('nzmin',imin1,nerr)
           call setnhv('nzsec',isec1,nerr)
           call setnhv('nzmsec',mm1,nerr)
           call setkhv('kstnm',kstnm,nerr)
           call setfhv('cmpaz',cmpaz(i),nerr)
           call setfhv('cmpinc',cmpinc(i),nerr)
           call setfhv('stla',ylat,nerr)
           call setfhv('stlo',xlon,nerr)
           call setfhv('stel',zelv,nerr)
           do 100 j = 1, npts
 100          ff(j) = wave(j,i)
           call wsac0(ofname(i),xdum,ff,nerr)
           write(0,'(A,A30,A,I4)') ' File :', ofname(i),
     +      ' N of error ...',nerr
 300    continue
c       
 999    stop
        end
        subroutine julday(iy,im,id,jd)
c
c    Julian day  
c
        jd=id   
        if(im.eq.1) return
        do m=1,im-1
          if(m.eq.1 .or. m.eq.3 .or. m.eq.5 .or. m.eq.7 .or.
     *       m.eq.8 .or. m.eq.10 .or. m.eq.12) then
              jm=31
          else    
              jm=30
          end if  
          if(m.eq.2) jm=28
          if(m.eq.2 .and. mod(iy,4).eq.0) jm=29
c
          jd=jd+jm
        enddo    
        return
        end