117 lines
		
	
	
		
			2.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
		
		
			
		
	
	
			117 lines
		
	
	
		
			2.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
|   | subroutine avecho(id2,ndop,nfrit,nqual,f1,xlevel,sigdb,snr,dfreq,width)
 | ||
|  | 
 | ||
|  |   integer TXLENGTH
 | ||
|  |   parameter (TXLENGTH=27648)           !27*1024
 | ||
|  |   parameter (NFFT=32768,NH=NFFT/2)
 | ||
|  |   parameter (NZ=4096)
 | ||
|  |   integer*2 id2(34560)                 !Buffer for Rx data
 | ||
|  |   real sa(NZ)      !Avg spectrum relative to initial Doppler echo freq
 | ||
|  |   real sb(NZ)      !Avg spectrum with Dither and changing Doppler removed
 | ||
|  |   integer nsum       !Number of integrations
 | ||
|  |   real dop0          !Doppler shift for initial integration (Hz)
 | ||
|  |   real dop           !Doppler shift for current integration (Hz)
 | ||
|  |   real s(8192)
 | ||
|  |   real x(NFFT)
 | ||
|  |   integer ipkv(1)
 | ||
|  |   complex c(0:NH)
 | ||
|  |   equivalence (x,c),(ipk,ipkv)
 | ||
|  |   common/echocom/nclearave,nsum,blue(NZ),red(NZ)
 | ||
|  |   save dop0,sa,sb
 | ||
|  | 
 | ||
|  |   dop=ndop
 | ||
|  |   sq=0.
 | ||
|  |   do i=1,TXLENGTH
 | ||
|  |      x(i)=id2(i)
 | ||
|  |      sq=sq + x(i)*x(i)
 | ||
|  |   enddo
 | ||
|  |   xlevel=10.0*log10(sq/TXLENGTH)
 | ||
|  | 
 | ||
|  |   if(nclearave.ne.0) nsum=0
 | ||
|  |   if(nsum.eq.0) then
 | ||
|  |      dop0=dop                             !Remember the initial Doppler
 | ||
|  |      sa=0.                                !Clear the average arrays
 | ||
|  |      sb=0.
 | ||
|  |   endif
 | ||
|  | 
 | ||
|  |   x(TXLENGTH+1:)=0.
 | ||
|  |   x=x/TXLENGTH
 | ||
|  |   call four2a(x,NFFT,1,-1,0)
 | ||
|  |   df=12000.0/NFFT
 | ||
|  |   do i=1,8192                             !Get spectrum 0 - 3 kHz
 | ||
|  |      s(i)=real(c(i))**2 + aimag(c(i))**2
 | ||
|  |   enddo
 | ||
|  | 
 | ||
|  |   fnominal=1500.0           !Nominal audio frequency w/o doppler or dither
 | ||
|  |   ia=nint((fnominal+dop0-nfrit)/df)
 | ||
|  |   ib=nint((f1+dop-nfrit)/df)
 | ||
|  |   if(ia.lt.600 .or. ib.lt.600) go to 900
 | ||
|  |   if(ia.gt.7590 .or. ib.gt.7590) go to 900
 | ||
|  | 
 | ||
|  |   nsum=nsum+1
 | ||
|  | 
 | ||
|  |   do i=1,NZ
 | ||
|  |      sa(i)=sa(i) + s(ia+i-2048)    !Center at initial doppler freq
 | ||
|  |      sb(i)=sb(i) + s(ib+i-2048)    !Center at expected echo freq
 | ||
|  |   enddo
 | ||
|  | 
 | ||
|  |   call pctile(sb,200,50,r0)
 | ||
|  |   call pctile(sb(1800),200,50,r1)
 | ||
|  | 
 | ||
|  |   sum=0.
 | ||
|  |   sq=0.
 | ||
|  |   do i=1,NZ
 | ||
|  |      y=r0 + (r1-r0)*(i-100.0)/1800.0
 | ||
|  |      blue(i)=sa(i)/y
 | ||
|  |      red(i)=sb(i)/y
 | ||
|  |      if(i.le.500 .or. i.ge.3597) then
 | ||
|  |         sum=sum+red(i)
 | ||
|  |         sq=sq + (red(i)-1.0)**2
 | ||
|  |      endif
 | ||
|  |   enddo
 | ||
|  |   ave=sum/1000.0
 | ||
|  |   rms=sqrt(sq/1000.0)
 | ||
|  | 
 | ||
|  |   redmax=maxval(red)
 | ||
|  |   ipkv=maxloc(red)
 | ||
|  |   fac=10.0/max(redmax,10.0)
 | ||
|  |   dfreq=(ipk-2048)*df
 | ||
|  |   snr=(redmax-ave)/rms
 | ||
|  | 
 | ||
|  |   sigdb=-99.0
 | ||
|  |   if(ave.gt.0.0) sigdb=10.0*log10(redmax/ave - 1.0) - 35.7
 | ||
|  | 
 | ||
|  |   nqual=0
 | ||
|  |   if(nsum.ge.2 .and. nsum.lt.4)  nqual=(snr-4)/5
 | ||
|  |   if(nsum.ge.4 .and. nsum.lt.8)  nqual=(snr-3)/4
 | ||
|  |   if(nsum.ge.8 .and. nsum.lt.12) nqual=(snr-3)/3
 | ||
|  |   if(nsum.ge.12) nqual=(snr-2.5)/2.5
 | ||
|  |   if(nqual.lt.0)  nqual=0
 | ||
|  |   if(nqual.gt.10) nqual=10
 | ||
|  | 
 | ||
|  | ! Scale for plotting
 | ||
|  |   blue=fac*blue
 | ||
|  |   red=fac*red
 | ||
|  | 
 | ||
|  |   sum=0.
 | ||
|  |   do i=ipk,ipk+300
 | ||
|  |      if(i.gt.NZ) exit
 | ||
|  |      if(red(i).lt.1.0) exit
 | ||
|  |      sum=sum+(red(i)-1.0)
 | ||
|  |   enddo
 | ||
|  |   do i=ipk-1,ipk-300,-1
 | ||
|  |      if(i.lt.1) exit
 | ||
|  |      if(red(i).lt.1.0) exit
 | ||
|  |      sum=sum+(red(i)-1.0)
 | ||
|  |   enddo
 | ||
|  |   bins=sum/(red(ipk)-1.0)
 | ||
|  |   width=df*bins
 | ||
|  |   nsmo=max(0.0,0.25*bins)
 | ||
|  | 
 | ||
|  |   do i=1,nsmo
 | ||
|  |      call smo121(red,NZ)
 | ||
|  |      call smo121(blue,NZ)
 | ||
|  |   enddo
 | ||
|  | 
 | ||
|  | 900  return
 | ||
|  | end subroutine avecho
 |