2013-05-17 15:16:29 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								subroutine sync9(ss,nzhsym,lag1,lag2,ia,ib,ccfred,red2,ipkbest)
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-01 20:37:05 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2013-07-08 13:17:22 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  include 'constants.f90'
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-01 20:37:05 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  real ss(184,NSMAX)
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-14 17:42:25 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real ss1(184)
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-10 20:40:46 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real ccfred(NSMAX)
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-16 16:02:00 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  real savg(NSMAX)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  real savg2(NSMAX)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  real smo(-5:25)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  real sq(NSMAX)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  real red2(NSMAX)
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-22 19:18:24 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  include 'jt9sync.f90'
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-01 20:37:05 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-16 19:44:41 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  ipk=0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  ipkbest=0
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-10 20:40:46 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  sbest=0.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  ccfred=0.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2013-04-22 15:43:02 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  do i=ia,ib                         !Loop over freq range
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-14 17:42:25 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     ss1=ss(1:184,i)
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-14 22:47:32 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     call pctile(ss1,nzhsym,40,xmed)
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-15 19:03:49 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-14 17:42:25 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     ss1=ss1/xmed - 1.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     do j=1,nzhsym
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-14 22:47:32 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(ss1(j).gt.3.0) ss1(j)=3.0
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-14 17:42:25 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-16 19:01:16 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     call pctile(ss1,nzhsym,45,sbase)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     ss1=ss1-sbase
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     sq0=dot_product(ss1(1:nzhsym),ss1(1:nzhsym))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     rms=sqrt(sq0/(nzhsym-1))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-10 20:40:46 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     smax=0.
							 | 
						
					
						
							
								
									
										
										
										
											2013-04-22 15:43:02 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     do lag=lag1,lag2                !DT = 2.5 to 5.0 s
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-15 19:03:49 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        sum1=0.
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-16 19:01:16 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        sq2=sq0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        nsum=nzhsym
							 | 
						
					
						
							
								
									
										
										
										
											2013-04-22 15:43:02 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        do j=1,16                    !Sum over 16 sync symbols
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-22 19:18:24 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           k=ii2(j) + lag
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-16 19:01:16 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           if(k.ge.1 .and. k.le.nzhsym) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              sum1=sum1 + ss1(k)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              sq2=sq2 - ss1(k)*ss1(k)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								              nsum=nsum-1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           endif
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-01 20:37:05 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        enddo
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-15 19:03:49 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        if(sum1.gt.smax) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           smax=sum1
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-14 17:42:25 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								           ipk=i 
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-01 20:37:05 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        endif
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-16 19:01:16 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        rms=sqrt(sq2/(nsum-1))
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-01 20:37:05 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     enddo
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-22 19:18:24 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     ccfred(i)=smax                        !Best at this freq, over all lags
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-10 20:40:46 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								     if(smax.gt.sbest) then
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        sbest=smax
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ipkbest=ipk
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     endif
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-01 20:37:05 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-30 15:02:27 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  call pctile(ccfred(ia),ib-ia+1,50,xmed)
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-31 19:21:46 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  if(xmed.le.0.0) xmed=1.0
							 | 
						
					
						
							
								
									
										
										
										
											2013-05-16 16:02:00 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  ccfred=2.0*ccfred/xmed 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  savg=0.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  do j=1,nzhsym
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     savg(ia:ib)=savg(ia:ib) + ss(j,ia:ib)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  savg(ia:ib)=savg(ia:ib)/nzhsym
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  smo(0:20)=1.0/21.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  smo(-5:-1)=-(1.0/21.0)*(21.0/10.0)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  smo(21:25)=smo(-5)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  do i=ia,ib
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     sm=0.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     do j=-5,25
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        if(i+j.ge.1 .and. i+j.lt.NSMAX) sm=sm + smo(j)*savg(i+j)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     savg2(i)=sm
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     sq(i)=sm*sm
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  call pctile(sq(ia:ib),ib-ia+1,20,sq0)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  rms=sqrt(sq0)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  savg2(ia:ib)=savg2(ia:ib)/(5.0*rms)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  red2=0.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  do i=ia+11,ib-10
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     ref=max(savg2(i-10),savg2(i+10))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     red2(i)=savg2(i)-ref
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(red2(i).lt.-99.0) red2(i)=-99.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(red2(i).gt.99.0) red2(i)=99.0
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-30 15:02:27 +00:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-10-01 20:37:05 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  return
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								end subroutine sync9
							 |