c   coded by A. Kubo, July, 1994
c   modified by Y. Hiramatsu, Aug. 1994
c   corrected by R. Kobayashi, Aug. 1999
c
        parameter (NMAX=500000,msec=0,slat=-69.0088,slon=39.5921)
c        parameter (NMAX=100000,msec=0,slat=-69.0088,slon=39.5921)
        parameter(delt=0.1)
        parameter (selv=20)
        dimension waven(NMAX),wavez(NMAX),wavee(NMAX),
     *  cmpaz(3), cmpinc(3)
	character kstnm*8,c*20,kevnm*16
	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        write(6,*) "start"
        kstnm="SYOWA"
c       read(5,*)iyy,imon,iday,ih,im,is
c        write(6,*) "rd_syowa"
        call rd_syowa(npts,iyy,imon,iday,ih,im,is,
     *   wavee,waven,wavez)
        write(6,*) "npts " ,npts
        Write(6,*) "ih,im,is " ,ih,im,is
c        write(6,*) " finished reading"
          do 201 jj=1,npts
c            write(8,*) wavez(jj),waven(jj),wavee(jj)
            wavez(jj)=-wavez(jj)
            waven(jj)=-waven(jj)
            wavee(jj)=-wavee(jj)
 201        continue
       write(c,'(5I2.2)') iyy,imon,iday,ih,im
        call julday(iyy+1900,imon,iday,jday)
	open(10,file='hypo.dat')
	read(10,*) iey,iem,ieday,ieh,iemin,esec
        write(6,*) iey,iem,ieday,ieh,iemin,esec
	read(10,*) elat,elon,edep,kevnm
        write(6,*) elat,elon,edep,kevnm
	call julday(iey,iem,ieday,jeday)
	mosec=0
	iesec=int(esec)
	mesec=int(esec*1000.)-iesec*1000
	eot=esec+iemin*60.+ieh*3600.
	bt=float(is)+im*60.+ih*3600.
	bt=bt-eot+(jday-jeday)*3600.*24.
	write(6,*) 'bt =',bt
           do 200 jc = 1, 3
              ofname(jc) = ' '
              ofname(jc) = c(1:10)//'.'//kstnm(1:3)//tail(jc)
              write(6,*) "filename",jc,ofname(jc)
              write(6,*) "new header",jc
           call newhdr
           call setnhv('npts',npts,nerr)
           call setfhv('b',bt,nerr)
           call setfhv('user1',bt,nerr)
           call setlhv('leven',.true.,nerr)
           call setfhv('delta',delt,nerr)
           call setihv('ievtyp','iquake',nerr)
           call setihv('iztype','io',nerr)
           call setnhv('nzyear',iyy,nerr)
           call setnhv('nzjday',jday,nerr)
           call setnhv('nzhour',ih,nerr)
           call setnhv('nzmin',im,nerr)
           call setnhv('nzsec',is,nerr)
           call setnhv('nzmsec',mosec,nerr)
           call setkhv('kstnm',kstnm,nerr)
           call setfhv('cmpaz',cmpaz(jc),nerr)
           call setfhv('cmpinc',cmpinc(jc),nerr)
           call setfhv('stla',slat,nerr)
           call setfhv('stlo',slon,nerr)
           call setfhv('stel',selv,nerr)
	   call setfhv('evla',elat,nerr)
	   call setfhv('evlo',elon,nerr)
	   call setfhv('evdp',edep,nerr)
           call setkhv('kevnm',kevnm,nerr)
           if (jc.eq.1) call wsac0(ofname(1),xdum,wavez,nerr)
           if (jc.eq.2) call wsac0(ofname(2),xdum,waven,nerr)
           if (jc.eq.3) call wsac0(ofname(3),xdum,wavee,nerr)
              write(6,*) "wsac",jc
     
           write(0,'(A,A30,A,I4)') ' File :', ofname(jc),
     +      ' N of error ...',nerr
 200       continue
 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