diff --git a/libm65/map65a.f90 b/libm65/map65a.f90 index 8cc0c2349..d7292f898 100644 --- a/libm65/map65a.f90 +++ b/libm65/map65a.f90 @@ -223,8 +223,9 @@ subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, & call timer('decode1a',1) if(nqd.eq.2) then call timer('qra64 ',0) - call qra64b(nutc,nqd,ikhz,mousedf,ntol,xpol,mycall, & - hiscall,hisgrid,mode64,nwrite_qra64) + call qra64b(nutc,nqd,fcenter,nfcal,ikhz, & + mousedf,ntol,xpol,mycall,hiscall,hisgrid, & + mode64,nwrite_qra64) call timer('qra64 ',1) cycle endif diff --git a/libm65/qra64b.f90 b/libm65/qra64b.f90 index adb15a132..cb0148043 100644 --- a/libm65/qra64b.f90 +++ b/libm65/qra64b.f90 @@ -1,11 +1,12 @@ -subroutine qra64b(nutc,nqd,ikhz,mousedf,ntol,xpol,mycall_12,hiscall_12, & - hisgrid_6,mode64,nwrite_qra64) +subroutine qra64b(nutc,nqd,fcenter,nfcal,ikhz,mousedf,ntol,xpol, & + mycall_12,hiscall_12,hisgrid_6,mode64,nwrite_qra64) parameter (NFFT1=5376000) !56*96000 parameter (NFFT2=336000) !56*6000 (downsampled by 1/16) complex ca(NFFT1),cb(NFFT1) !FFTs of raw x,y data complex cx(0:NFFT2-1),cy(0:NFFT2-1) logical xpol + real*8 fcenter character*12 mycall_12,hiscall_12 character*6 hisgrid_6 common/cacb/ca,cb @@ -13,7 +14,9 @@ subroutine qra64b(nutc,nqd,ikhz,mousedf,ntol,xpol,mycall_12,hiscall_12, & open(17,file='red.dat',status='unknown') df=96000.0/NFFT1 - k0=(ikhz-75.170)*1000.0/df + ikhz0=nint(1000.0*(fcenter-int(fcenter))) + k0=((ikhz-ikhz0+48.0+1.27)*1000.0+nfcal)/df + nh=nfft2/2 if(k0.lt.nh .or. k0.gt.NFFT1-nh) go to 900 @@ -25,16 +28,16 @@ subroutine qra64b(nutc,nqd,ikhz,mousedf,ntol,xpol,mycall_12,hiscall_12, & cy(nh+1:NFFT2-1)=cb(k0-nh+1:k0-1) cy=fac*cy -! write(60) cx,cy,nutc,nqd,ikhz,mousedf,ntol,xplo,mycall_12, & +! write(60) cx,cy,nutc,nqd,ikhz,mousedf,ntol,xpol,mycall_12, & ! hiscall_12,hisgrid_6 - if(nzap.gt.0) call qra64zap(cx,cy,nzap) + if(nzap.gt.0) call qra64zap(cx,cy,xpol,nzap) ! Transform back to time domain with sample rate 6000 Hz. call four2a(cx,NFFT2,1,-1,1) call four2a(cy,NFFT2,1,-1,1) - call qra64c(cx,cy,nutc,nqd,ikhz,mousedf,ntol,xplo,mycall_12, & + call qra64c(cx,cy,nutc,nqd,ikhz,mousedf,ntol,xpol,mycall_12, & hiscall_12,hisgrid_6,mode64,nwrite_qra64) close(17) diff --git a/libm65/qra64c.f90 b/libm65/qra64c.f90 index db1329cf9..b1dfd37d6 100644 --- a/libm65/qra64c.f90 +++ b/libm65/qra64c.f90 @@ -67,7 +67,9 @@ subroutine qra64c(cx,cy,nutc,nqd,ikhz,nfqso,ntol,xpol,mycall_12, & naptype=maxaptype npts2=NFFT2 - do ip=0,3 + ipz=0 + if(xpol) ipz=3 + do ip=0,ipz if(ip.eq.0) c00(0:NFFT2-1)=conjg(cx) if(ip.eq.1) c00(0:NFFT2-1)=0.707*conjg(cx+cy) if(ip.eq.2) c00(0:NFFT2-1)=conjg(cy) @@ -170,7 +172,6 @@ subroutine qra64c(cx,cy,nutc,nqd,ikhz,nfqso,ntol,xpol,mycall_12, & if(nSubmode.eq.4) nsnr=nint(10.0*log10(sy)-24.0) !E endif -!### ! If Tx station's grid is in decoded message, compute optimum TxPol i1=index(decoded,' ') i2=index(decoded(i1+1:),' ') + i1 @@ -193,13 +194,6 @@ subroutine qra64c(cx,cy,nutc,nqd,ikhz,nfqso,ntol,xpol,mycall_12, & endif endif endif -!### - -!### -! write(62,3010) ikHz,nfreq,npol,nutc,dtx,nsnr,cmode(1:1),decoded, & -! irc,sync,sync2 -!3010 format(i3,i5,i4,i6.4,f5.1,i5,1x,a1,1x,a22,i3,2f7.1) -!### if(irc.ge.0) then write(*,1010) ikHz,nfreq,npol,nutc,dtx,nsnr,cmode(1:1),decoded, & diff --git a/libm65/qra64zap.f90 b/libm65/qra64zap.f90 index 63b3fecd5..6129ea238 100644 --- a/libm65/qra64zap.f90 +++ b/libm65/qra64zap.f90 @@ -1,10 +1,11 @@ -subroutine qra64zap(cx,cy,nzap) +subroutine qra64zap(cx,cy,xpol,nzap) parameter (NFFT1=5376000) !56*96000 parameter (NFFT2=336000) !56*6000 (downsampled by 1/16) complex cx(0:NFFT2-1),cy(0:NFFT2-1) real s(-1312:1312) integer iloc(1) + logical xpol slimit=3.0 sbottom=1.5 @@ -19,8 +20,8 @@ subroutine qra64zap(cx,cy,nzap) if(j.gt.nblks/2) j=j-nblks do n=1,nadd k=k+1 - s(j)=s(j) + real(cx(k))**2 + aimag(cx(k))**2 + & - real(cy(k))**2 + aimag(cy(k))**2 + s(j)=s(j) + real(cx(k))**2 + aimag(cx(k))**2 + if(xpol) s(j)=s(j) + real(cy(k))**2 + aimag(cy(k))**2 enddo enddo call pctile(s,nblks,45,base) diff --git a/libm65/sync64.f90 b/libm65/sync64.f90 index 6bcee4dc7..23c945e21 100644 --- a/libm65/sync64.f90 +++ b/libm65/sync64.f90 @@ -115,6 +115,12 @@ subroutine sync64(c0,nf1,nf2,nfqso,ntol,mode64,emedelay,dtx,f0,jpk,sync, & dtx=jpk/6000.0 - 1.0 ipk=ip f0=ip*df3 - 3000.0 +! rewind 61 +! do i=iaa,ibb +! write(61,3301) i*df3-3000.0,s0(i),s1(i),s2(i),s3(i) +!3301 format(5f12.3) +! enddo +! flush(61) endif call timer('sync64_2',1) enddo