
ccc     select near event within 1 km    
ccc     write waveform data
ccc     res=ans=Po-theo   theodif=Po-ans,  theo=po+theodif  
	include 'common_format.inc'
	include 'common_arriv.inc'
	include 'common_stncod.inc'
	dimension sampwv(na200),jrec_startwv(na200),sec1awv(na200)
	character*80 file,file_wave,file_hypo,textdata,text,
     1 text_slave,pick_file,filea
	character*120 text_master
	character*7 stn,stntes(na200)
	character*20 text20
	character*3  cha,citr
	character*1 cret
	cret=char(10)
	neq_branch_min=4
cc	text='../autodata/ateq_device.dat'
cc        call read_auto_device(text)
ccc     define input data by reading ../autodata/wave_dir.dat
ccc     (1) Pick files for template EQ 
ccc     (2) pick files of re-locate events in the study area
	write(*,*) 'call read_ateq_dd2_input'
	file='../etc/wave_dir.dat'
	call read_wave_dir(file,n_itr,phi_from,phi_to,ram_from,ram_to,
     1 dep_from,dep_to,fmag1,fmag2,npmin,nsmin,dep1_temp)
	write(*,113) event_list,iy_from,im_from,id_from,
     1 iy_to,im_to,id_to,phi_from,phi_to,ram_from,ram_to,dep_from,
     2 dep_to,fmag1,fmag2,npmin,nsmin,dep1_temp
 113	format('File name of event list=',a50/
     1 'date=',i4,2i3,3x,i4,2i3,' Lat=',2f9.4,' Lon=',2f9.4,
     2 ' Depth=',2f6.1/' Parameters for the template EQ selection'/
     3 'Mag=',2f6.1,' P S readings=',2i3,' Shallowest depth=',f6.1) 
	file_template=event_list
ccc     read  velocity structure
cc	read(*,*) iok 

	call read_vel_model
	call read_jma_stn
	call hypo_remove_threshhold_val
	do 50 kkk=1,n_itr
	open(38,file='../arriv_dd/hypotd_asc.dat')
	open(39,file='../arriv_dd/hypotd_dir.dat',access='direct', 
     1 form='formatted',recl=120,status='unknown')
	irecw=1
        
	write(*,*) 'nstobs=',nstobs
	call  read_template_list(fmag1,fmag2,npmin,nsmin,dep1_temp)
cc	read(*,*) iok
	irecb=-99
	nneq=0
 88	continue
cc	   call read_new_event(iflag)
	call read_new_event_test(iflag)
cc	write(*,*) 'iflag=',iflag
	if(iflag.eq.99) go to 99
c         idd=iy*400+im*31+id
cc	 write(*,*) 'date=',iy,im,id
	 iyear=iy
	 if(iy.le.1900) iyear=iy+2000
	 if(iyear.gt.2060) iyear=iyear-100
c	      	call iyimid_idd(idd,iyear,im,id)
cc		write(*,*) idd,iyear,im,id
cc	 if(idd.lt.idd_from.or.idd.gt.idd_to) go to 88
	 q=(phi-phi_from)*(phi-phi_to)
	 if(q.gt.0.0) go to 88
	 q=(ram-ram_from)*(ram-ram_to)
	 if(q.gt.0.0) go to 88
	 if(dep.lt.dep_from.or.dep.gt.dep_to) go to 88
	 
	   write(text_master,1301) iy,im,id,ih,imin,sec,t,dt,
	1 phi,dphi,ram,dram,dep,ddep,fmag,nobsp,nobss,nobsall,
     1  c_temp,c_hypo_flag,irec_arv
 1301	   format(5i2,f6.2,f8.2,f6.2,f8.4,f7.4,f9.4,f7.4,
	1 2f7.2,f5.2,3i4,1x,2a1,i9,f6.2)
cc	  write(*,*) text_master
cc	  read(*,*) iok

c	   write(*,*) 'read new event ',iy,im,id,ih,imin,
c     1  t,phi,ram,dep,nobsp,nobss
c	   read(*,*)  iok
	   if(iflag.eq.99) go to 88
	   if(phi.lt.-90.0) go to 88
	   call clear_ps_data
	   do m=1,100
	      meqa(m)=0
	      enddo
         call select_near_event
	 nneq=nneq+1

cc	 if(nneq.le.1) go to 88   !OK
	 k11=neq_branch+1
	 meqa(k11)=nmax_event   !Relocated event is the last of template.
cc	 write(*,*) 'after select_near_event ',neq_branch
cc	 write(*,*) text_master
	 
	 
	 do k=1,neq_branch+1
	    m=meqa(k)
c	 write(*,*) k,meqa(k),keq_eva(m),wave_file_eva(m)
c	    write(*,*) m,phi_eva(m),ram_eva(m),dep_eva(m)
	 enddo
         keq=meqa(k11)


cc	 read(*,*) iok

cc	 write(*,*) 'call cal_hypo_dd_cross'
	 call  cal_hypo_dd_cross
ccc     Store arrival of master event ********:	 
	 read(text_master,1301) iy,im,id,ih,imin,sec,t,dt,
	1 phi,dphi,ram,dram,dep,ddep,fmag,nobsp,nobss,nobsall,
	2     c_temp,c_hypo_flag,irec_arv
	 call read_ok_arrival(keq) !Calculate nstn,deltak
	 call det_arriv_error
	 call rm_err_pick
	 call check_hypo_td
	 phij=phi
	 ramj=ram
	 depj=dep
	 tj=t
c       c	 read(*,*) iok
	 if(phieri.gt.-90.0) call ini_multi_eq

	    iyear=iy+2000
	    if(iyear.gt.2060) iyear=iy+1900
	    if(dphi.gt.9.9) dphi=9.9
	    if(dram.gt.9.9) dram=9.9
	    if(ddep.gt.99.9) ddep=99.9   
ccc     Store hypoTD format file 
        read(text_master,1301) iy,im,id,ih,imin,sec,t,dt,
	1 phiq,dphiq,ramq,dramq,depq,ddepq,fmag,nobsp,nobss,nobsall,
     1  c_temp,c_hypo_flag,irec_arv
cc	call dkwrt_hypo_dd(keq)	!pick file in picks_dd New event
cc
cc       dphi,dram,ddep are defined at check_hypo_td
	irecw=irecw+1
        write(39,1303,rec=irecw) cret,iy,im,id,ih,imin,sec,t,dt,
	1 phi,dphi,ram,dram,dep,ddep,fmag,nobsp,nobss,nobsall,
     1  c_temp,c_hypo_flag,irec_arv,sd_all_cross
        write(38,1302) iyear,im,id,ih,imin,t,
     1 phi,dphi,ram,dram,dep,ddep,fmag,nobsp,nobss,sd_all_cross
        write(*,1302)  iyear,im,id,ih,imin,t,
     1 phi,dphi,ram,dram,dep,ddep,fmag,nobsp,nobss,sd_all_cross

	write(39,134,rec=1) irecw
 1303   format(a1,1x,5i2,f6.2,f8.2,f6.2,f8.4,f7.4,f9.4,f7.4,
	1 2f7.2,f5.2,3i4,1x,2a1,i9,f6.2)
 1302   format(i4,4i2,f7.2,f8.4,f7.4,f10.4,f7.4,
	1 2f7.2,f5.2,2i4,f6.2)

  134   format(i10,a1)  
       go to 88
			
 99		  continue
		  close(38)   !Asc format
		  close(39)   !HypoTD format
		  write(*,*) 'after 99'
		  write(citr,'(i3.3)') (kkk-1)
	 text='mv ../arriv_dd/hypotd_asc.dat ../arriv_dd/hypotd_asc_'
     1 //citr//'.dat'
	 write(*,*) text
	 call system(text)   !Move Asc format file
	 
	 text='cp ../arriv_dd/hypotd_dir.dat '//event_list
	 call system(text)   !cp calculated hypo for the next iteration
	 write(*,*) text
	 text='cp ../arriv_dd/hypotd_dir.dat ../arriv_dd/hypotd_dir_'
     1 //citr//'.dat'
	 call system(text)   !Save hypoTD format file
 	 write(*,*) text

 50		  continue
		  stop
		  end


	subroutine read_new_event_test(iflag)
	include 'common_arriv.inc'
	character*1 cret
	character*119 text
	character*80 file,text2
cc	data irecb /2951/
        data irecb /1/
	iflag=99
cc	file='../arriv/hypo_month.dat'
        file=event_list
cc	write(*,*) 'event list=',file
 88	continue
	open(7,file=file,access='direct', form='formatted',recl=120,
     1  action='read',err=2)
	read(7,'(i10)',rec=1) irece
cc	iflag=0
	irecb=irecb+1
	if(irecb.gt.irece) then
	   irecb=1
	   go to 2
	   endif
         read(7,1303,rec=irecb) cret,iy,im,id,ih,imin,sec,t,dt,
	1 phi,dphi,ram,dram,dep,ddep,fmag,nobsp,nobss,nobsall,
     1  c_temp,c_hypo_flag,irec_arv
 1303	 format(a1,1x,5i2,f6.2,f8.2,f6.2,f8.4,f7.4,f9.4,f7.4,
	1 2f7.2,f5.2,3i4,1x,2a1,i9,f6.2)
c        write(*,1302) iy,im,id,ih,imin,sec,t,dt,
c	1 phi,dphi,ram,dram,dep,ddep,fmag,nobsp,nobss,nobsall,
c     1  c_temp,c_hypo_flag,irec_arv
 1302   format(1x,5i2,f6.2,f8.2,f6.2,f8.4,f7.4,f9.4,f7.4,
	1 2f7.2,f5.2,3i4,1x,2a1,i9,f6.2)
	 iyear=iy
	 if(iy.le.1900) iyear=iy+2000
	 if(iyear.gt.2060) iyear=iyear-100


	write(text2,112) iyear
 112	format('../arriv/arv_',i4.4,'.dat')
         wave_file_eva(nmax_event)=text2
	 keq_eva(nmax_event)=irec_arv
	 k=nmax_event
	phi_eva(k)=phi
	ram_eva(k)=ram
        dep_eva(k)=dep
	fmag_eva(k)=fmagj
	nobsp_eva(k)=nobsp
	nobss_eva(k)=nobss
	iflag=0
cc	read(*,*) iok
cc	write(*,*) irecb,irece,iy,im,id,ih,imin
 2	continue
cc	write(*,*) irecb,irece,iflag,iy,im,id,ih,imin
	close(7)
	return
	end
