diff --git a/lib/fsk4hf/ft4sd.f90 b/lib/fsk4hf/ft4sd.f90 index e2c08e6ef..17f664d11 100644 --- a/lib/fsk4hf/ft4sd.f90 +++ b/lib/fsk4hf/ft4sd.f90 @@ -29,6 +29,7 @@ program ft4sd dt=1.0/fs !Sample interval (s) tt=NSPS*dt !Duration of "itone" symbols (s) txt=NZ*dt !Transmission length (s) + hmod=1.0 nargs=iargc() if(nargs.lt.1) then @@ -48,6 +49,11 @@ program ft4sd read(arg,*) fMHz iarg=iarg+2 endif + if(arg(1:2).eq.'-h') then + call getarg(iarg+1,arg) + read(arg,*) hmod + iarg=iarg+2 + endif ngood=0 do ifile=iarg,nargs @@ -75,16 +81,17 @@ program ft4sd fs=12000.0/32.0 npts=120*12000.0/32.0 - call getcandidate_ft4s(c2,npts,fs,fa,fb,ncand,candidates) !First approx for freq + call getcandidate_ft4s(c2,npts,hmod,fs,fa,fb,ncand,candidates) !First approx for freq + del=1.5*hmod*fs/300.0 ndecodes=0 do icand=1,ncand +! do icand=1,1 fc0=candidates(icand,1) xsnr=candidates(icand,2) !write(*,*) 'candidates ',icand,fc0,xsnr do isync=0,1 - del=1.5*fs/300.0 if(isync.eq.0) then fc1=fc0-del is0=375 @@ -104,7 +111,7 @@ program ft4sd do if=-ifhw,ifhw fc=fc1+df*if do istart=max(1,is0-ishw),is0+ishw,isst - call coherent_sync_ft4s(c2,istart,fc,1,sync) + call coherent_sync_ft4s(c2,istart,hmod,fc,1,sync) if(sync.gt.smax) then fc2=fc isbest=istart @@ -117,7 +124,7 @@ program ft4sd ! if(smax .lt. 100.0 ) cycle !isbest=375 -!fc2=-del +!fc2=0 do ijitter=0,2 if(ijitter.eq.0) ioffset=0 if(ijitter.eq.1) ioffset=45 @@ -125,10 +132,10 @@ program ft4sd is0=isbest+ioffset if(is0.lt.0) cycle cframe=c2(is0:is0+144*300-1) - call downsample_ft4s(cframe,fc2,cd) + call downsample_ft4s(cframe,fc2+del,hmod,cd) s2=sum(cd*conjg(cd))/(20*144) cd=cd/sqrt(s2) - call get_ft4s_bitmetrics(cd,bitmetrics,badsync) + call get_ft4s_bitmetrics(cd,hmod,bitmetrics,badsync) hbits=0 where(bitmetrics(:,1).ge.0) hbits=1 @@ -191,8 +198,8 @@ program ft4sd call unpack77(c77,0,msg,unpk77_success) if(unpk77_success .and. index(msg,'K9AN').gt.0) then ngood=ngood+1 - write(*,1100) ifile,icand,xsnr,isbest/375.0-1.0,1500.0+fc2+del,msg(1:14),itry,nhardbp,nhardosd,dmin,ijitter -1100 format(i5,2x,i5,2x,f6.1,2x,f6.2,2x,f8.2,2x,a14,i4,i4,i4,f7.2,i6) + write(*,1100) ifile-2,icand,xsnr,isbest/375.0-1.0,1500.0+fc2+del,msg(1:20),itry,nhardbp,nhardosd,dmin,ijitter +1100 format(i5,2x,i5,2x,f6.1,2x,f6.2,2x,f8.2,2x,a20,i4,i4,i4,f7.2,i6) goto 2002 else cycle @@ -210,7 +217,7 @@ program ft4sd 999 end program ft4sd -subroutine coherent_sync_ft4s(cd0,i0,f0,itwk,sync) +subroutine coherent_sync_ft4s(cd0,i0,hmod,f0,itwk,sync) ! Compute sync power for a complex, downsampled FT4s signal. @@ -248,12 +255,12 @@ subroutine coherent_sync_ft4s(cd0,i0,f0,itwk,sync) phie=0.0 phif=0.0 do i=0,3 - dphia=twopi*icos4a(i)/real(NSS) - dphib=twopi*icos4b(i)/real(NSS) - dphic=twopi*icos4c(i)/real(NSS) - dphid=twopi*icos4d(i)/real(NSS) - dphie=twopi*icos4e(i)/real(NSS) - dphif=twopi*icos4f(i)/real(NSS) + dphia=twopi*hmod*icos4a(i)/real(NSS) + dphib=twopi*hmod*icos4b(i)/real(NSS) + dphic=twopi*hmod*icos4c(i)/real(NSS) + dphid=twopi*hmod*icos4d(i)/real(NSS) + dphie=twopi*hmod*icos4e(i)/real(NSS) + dphif=twopi*hmod*icos4f(i)/real(NSS) do j=1,NSS csynca(k)=cmplx(cos(phia),sin(phia)) csyncb(k)=cmplx(cos(phib),sin(phib)) @@ -347,7 +354,7 @@ subroutine coherent_sync_ft4s(cd0,i0,f0,itwk,sync) return end subroutine coherent_sync_ft4s -subroutine downsample_ft4s(ci,f0,co) +subroutine downsample_ft4s(ci,f0,hmod,co) parameter(NI=144*300,NH=NI/2,NO=NI/15) ! downsample from 315 samples per symbol to 20 complex ci(0:NI-1),ct(0:NI-1) complex co(0:NO-1) @@ -359,7 +366,7 @@ subroutine downsample_ft4s(ci,f0,co) ct=cshift(ct,i0) co=0.0 co(0)=ct(0) - b=16.0 + b=16.0*hmod do i=1,NO/2 arg=(i*df/b)**2 filt=exp(-arg) @@ -371,7 +378,7 @@ subroutine downsample_ft4s(ci,f0,co) return end subroutine downsample_ft4s -subroutine getcandidate_ft4s(c,npts,fs,fa,fb,ncand,candidates) +subroutine getcandidate_ft4s(c,npts,hmod,fs,fa,fb,ncand,candidates) parameter(NFFT1=120*12000/32,NH1=NFFT1/2,NFFT2=120*12000/320,NH2=NFFT2/2) complex c(0:npts-1) !Complex waveform complex cc(0:NFFT1-1) @@ -392,7 +399,7 @@ subroutine getcandidate_ft4s(c,npts,fs,fa,fb,ncand,candidates) csfil=cmplx(0.0,0.0) do i=0,NFFT2-1 ! csfil(i)=exp(-((i-NH2)/32.0)**2) ! revisit this - csfil(i)=exp(-((i-NH2)/28.0)**2) ! revisit this + csfil(i)=exp(-((i-NH2)/(hmod*28.0))**2) ! revisit this enddo csfil=cshift(csfil,NH2) call four2a(csfil,NFFT2,1,-1,1) @@ -422,7 +429,7 @@ subroutine getcandidate_ft4s(c,npts,fs,fa,fb,ncand,candidates) (bigspec(i).gt.1.15).and.ncand.lt.100) then ncand=ncand+1 candidates(ncand,1)=df*(i-NH2) - candidates(ncand,2)=10*log10(bigspec(i)-1)-28.5 + candidates(ncand,2)=10*log10(bigspec(i)-1)-26.5 endif enddo return diff --git a/lib/fsk4hf/ft4slowsim.f90 b/lib/fsk4hf/ft4slowsim.f90 index f0726868a..a5f0d80f3 100644 --- a/lib/fsk4hf/ft4slowsim.f90 +++ b/lib/fsk4hf/ft4slowsim.f90 @@ -18,9 +18,9 @@ program ft4slowsim ! Get command-line argument(s) nargs=iargc() - if(nargs.ne.7) then - print*,'Usage: ft4slowsim "message" f0 DT fdop del nfiles snr' - print*,'Examples: ft4slowsim "K1JT K9AN EN50" 1500 0.0 0.1 1.0 10 -15' + if(nargs.ne.8) then + print*,'Usage: ft4slowsim "message" f0 DT h fdop del nfiles snr' + print*,'Examples: ft4slowsim "K1JT K9AN EN50" 1500 0.0 1.0 0.1 1.0 10 -15' go to 999 endif call getarg(1,msg37) !Message to be transmitted @@ -29,19 +29,20 @@ program ft4slowsim call getarg(3,arg) read(arg,*) xdt !Time offset from nominal (s) call getarg(4,arg) - read(arg,*) fspread !Watterson frequency spread (Hz) + read(arg,*) hmod !Modulation index, h call getarg(5,arg) - read(arg,*) delay !Watterson delay (ms) + read(arg,*) fspread !Watterson frequency spread (Hz) call getarg(6,arg) - read(arg,*) nfiles !Number of files + read(arg,*) delay !Watterson delay (ms) call getarg(7,arg) + read(arg,*) nfiles !Number of files + call getarg(8,arg) read(arg,*) snrdb !SNR_2500 nfiles=abs(nfiles) twopi=8.0*atan(1.0) fs=12000.0 !Sample rate (Hz) dt=1.0/fs !Sample interval (s) - hmod=1.0 !Modulation index (0.5 is MSK, 1.0 is FSK) tt=NSPS*dt !Duration of symbols (s) baud=1.0/tt !Keying rate (baud) txt=NZ2*dt !Transmission length (s) @@ -53,8 +54,8 @@ program ft4slowsim call genft4slow(msg37,0,msgsent37,msgbits,itone) write(*,*) write(*,'(a9,a37,3x,a7,i1,a1,i1)') 'Message: ',msgsent37,'i3.n3: ',i3,'.',n3 - write(*,1000) f0,xdt,txt,snrdb -1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1) + write(*,1000) f0,xdt,hmod,txt,snrdb +1000 format('f0:',f9.3,' DT:',f6.2,' hmod:',f6.3,' TxT:',f6.1,' SNR:',f6.1) write(*,*) if(i3.eq.1) then write(*,*) ' mycall hiscall hisgrid' @@ -72,7 +73,7 @@ program ft4slowsim fsample=12000.0 icmplx=1 - call gen_wspr4wave(itone,NN,NSPS,fsample,f0,c0,wave,icmplx,NMAX) + call gen_wspr4wave(itone,NN,NSPS,fsample,hmod,f0,c0,wave,icmplx,NMAX) k=nint((xdt+1.0)/dt)-NSPS c0=cshift(c0,-k) if(k.gt.0) c0(0:k-1)=0.0 diff --git a/lib/fsk4hf/gen_wspr4wave.f90 b/lib/fsk4hf/gen_wspr4wave.f90 index 4bcb7d17b..31b3f68ba 100644 --- a/lib/fsk4hf/gen_wspr4wave.f90 +++ b/lib/fsk4hf/gen_wspr4wave.f90 @@ -1,4 +1,4 @@ -subroutine gen_wspr4wave(itone,nsym,nsps,fsample,f0,cwave,wave,icmplx,nwave) +subroutine gen_wspr4wave(itone,nsym,nsps,fsample,hmod,f0,cwave,wave,icmplx,nwave) real wave(nwave) complex cwave(nwave) @@ -7,14 +7,13 @@ subroutine gen_wspr4wave(itone,nsym,nsps,fsample,f0,cwave,wave,icmplx,nwave) integer itone(nsym) logical first data first/.true./ - save pulse,first,twopi,dt,hmod,tsym + save pulse,first,twopi,dt,tsym if(first) then allocate( pulse(3*nsps*fsample) ) twopi=8.0*atan(1.0) dt=1.0/fsample tsym=nsps/fsample - hmod=1.0 ! Compute the smoothed frequency-deviation pulse do i=1,3*nsps tt=(i-1.5*nsps)/real(nsps) @@ -36,7 +35,7 @@ subroutine gen_wspr4wave(itone,nsym,nsps,fsample,f0,cwave,wave,icmplx,nwave) ! Calculate and insert the audio waveform phi=0.0 - dphi = dphi + twopi*(f0-1.5/tsym)*dt !Shift frequency up by f0 + dphi = dphi + twopi*(f0-1.5*hmod/tsym)*dt !Shift frequency up by f0 wave=0. if(icmplx.eq.1) cwave=0. k=0 diff --git a/lib/fsk4hf/get_ft4s_bitmetrics.f90 b/lib/fsk4hf/get_ft4s_bitmetrics.f90 index 9d6e3222f..a2af01f1e 100644 --- a/lib/fsk4hf/get_ft4s_bitmetrics.f90 +++ b/lib/fsk4hf/get_ft4s_bitmetrics.f90 @@ -1,10 +1,14 @@ -subroutine get_ft4s_bitmetrics(cd,bitmetrics,badsync) +subroutine get_ft4s_bitmetrics(cd,hmod,bitmetrics,badsync) include 'ft4s_params.f90' parameter (NSS=20) complex cd(0:NN*NSS-1) complex cs(0:3,NN) complex csymb(NSS) + complex c1(NSS,0:3) ! ideal waveforms, 20 samples per symbol, 4 tones + complex ccor(0:3,NN) ! correlations with each ideal waveform, for each symbol + complex cp(0:3) ! accumulated phase shift over symbol types 0:3 + complex csum,cterm integer icos4a(0:3),icos4b(0:3) integer icos4c(0:3),icos4d(0:3) integer icos4e(0:3),icos4f(0:3) @@ -16,7 +20,6 @@ subroutine get_ft4s_bitmetrics(cd,bitmetrics,badsync) real bitmetrics(2*NN,4) real s2(0:65535) real s4(0:3,NN) - data icos4a/0,1,3,2/ data icos4b/1,0,2,3/ data icos4c/2,3,1,0/ @@ -25,7 +28,7 @@ subroutine get_ft4s_bitmetrics(cd,bitmetrics,badsync) data icos4f/1,2,0,3/ data graymap/0,1,3,2/ data first/.true./ - save first,one + save first,one,c1,cp if(first) then one=.false. @@ -34,15 +37,27 @@ subroutine get_ft4s_bitmetrics(cd,bitmetrics,badsync) if(iand(i,2**j).ne.0) one(i,j)=.true. enddo enddo + twopi=8.0*atan(1.0) + dphi=twopi*hmod/NSS + do itone=0,3 + dp=(itone-1.5)*dphi + phi=0.0 + do j=1,NSS + c1(j,itone)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dp,twopi) + enddo + cp(itone)=cmplx(cos(phi),sin(phi)) + enddo first=.false. endif do k=1,NN i1=(k-1)*NSS csymb=cd(i1:i1+NSS-1) - call four2a(csymb,NSS,1,-1,1) - cs(0:3,k)=csymb(1:4) - s4(0:3,k)=abs(csymb(1:4)) + do itone=0,3 + cs(itone,k)=sum(csymb*conjg(c1(:,itone))) + enddo + s4(0:3,k)=abs(cs(0:3,k)) enddo ! Sync quality check @@ -54,7 +69,7 @@ subroutine get_ft4s_bitmetrics(cd,bitmetrics,badsync) is6=0 badsync=.false. ibmax=0 - + do k=1,4 ip=maxloc(s4(:,k)) if(icos4a(k-1).eq.(ip(1)-1)) is1=is1+1 @@ -77,50 +92,23 @@ subroutine get_ft4s_bitmetrics(cd,bitmetrics,badsync) ! return ! endif - do nseq=1,4 !Try coherent sequences of 1, 2, and 4 symbols + do nseq=4,1,-1 !Try coherent sequences of 1, 2, and 4 symbols if(nseq.eq.1) nsym=1 if(nseq.eq.2) nsym=2 if(nseq.eq.3) nsym=4 if(nseq.eq.4) nsym=8 - nt=2**(2*nsym) + nt=4**nsym do ks=1,NN-nsym+1,nsym !87+16=103 symbols. - amax=-1.0 + s2=0 do i=0,nt-1 -! i1=i/64 -! i2=iand(i,63)/16 -! i3=iand(i,15)/4 -! i4=iand(i,3) - i1=i/16384 - i2=iand(i,16383)/4096 - i3=iand(i,4095)/1024 - i4=iand(i,1023)/256 - i5=iand(i,255)/64 - i6=iand(i,63)/16 - i7=iand(i,15)/4 - i8=iand(i,3) - if(nsym.eq.1) then - s2(i)=abs(cs(graymap(i8),ks)) - elseif(nsym.eq.2) then - s2(i)=abs(cs(graymap(i7),ks)+cs(graymap(i8),ks+1)) - elseif(nsym.eq.4) then - s2(i)=abs(cs(graymap(i5),ks ) + & - cs(graymap(i6),ks+1) + & - cs(graymap(i7),ks+2) + & - cs(graymap(i8),ks+3) & - ) - elseif(nsym.eq.8) then - s2(i)=abs(cs(graymap(i1),ks ) + & - cs(graymap(i2),ks+1) + & - cs(graymap(i3),ks+2) + & - cs(graymap(i4),ks+3) + & - cs(graymap(i5),ks+4) + & - cs(graymap(i6),ks+5) + & - cs(graymap(i7),ks+6) + & - cs(graymap(i8),ks+7) & - ) - else - print*,"Error - nsym must be 1, 2, 4, or 8." - endif + csum=0 + cterm=1 + do j=0,nsym-1 + ntone=mod(i/4**(nsym-1-j),4) + csum=csum+cs(graymap(ntone),ks+j)*cterm + cterm=cterm*conjg(cp(graymap(ntone))) + enddo + s2(i)=abs(csum) enddo ipt=1+(ks-1)*2 if(nsym.eq.1) ibmax=1 diff --git a/lib/fsk4hf/wspr4sim.f90 b/lib/fsk4hf/wspr4sim.f90 index d1f011ffc..eaca79c5a 100644 --- a/lib/fsk4hf/wspr4sim.f90 +++ b/lib/fsk4hf/wspr4sim.f90 @@ -72,7 +72,7 @@ program wspr4sim fsample=12000.0 icmplx=1 - call gen_wspr4wave(itone,NN,NSPS,fsample,f0,c0,wave,icmplx,NMAX) + call gen_wspr4wave(itone,NN,NSPS,fsample,hmod,f0,c0,wave,icmplx,NMAX) k=nint((xdt+1.0)/dt)-NSPS c0=cshift(c0,-k) if(k.gt.0) c0(0:k-1)=0.0