From b8ff0941e8e9b7442a68088357b6dee1d4fd2706 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Wed, 15 Apr 2020 15:45:07 -0500 Subject: [PATCH] Add wspr4d and support routines. Not yet working. --- CMakeLists.txt | 5 + lib/fsk4hf/genwspr4.f90 | 6 +- lib/fsk4hf/get_wspr4_bitmetrics.f90 | 118 ++++++++ lib/fsk4hf/wspr4d.f90 | 433 ++++++++++++++++++++++++++++ lib/fsk4hf/wspr4sim.f90 | 5 +- 5 files changed, 560 insertions(+), 7 deletions(-) create mode 100644 lib/fsk4hf/get_wspr4_bitmetrics.f90 create mode 100644 lib/fsk4hf/wspr4d.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 701ceed96..28af87276 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -613,6 +613,8 @@ set (wsjt_FSRCS lib/fsk4hf/wspr4sim.f90 lib/fsk4hf/genwspr4.f90 lib/fsk4hf/gen_wspr4wave.f90 + lib/fsk4hf/wspr4d.f90 + lib/fsk4hf/get_wspr4_bitmetrics.f90 ) # temporary workaround for a gfortran v7.3 ICE on Fedora 27 64-bit @@ -1362,6 +1364,9 @@ target_link_libraries (ldpcsim174_74 wsjt_fort wsjt_cxx) add_executable (wspr4sim lib/fsk4hf/wspr4sim.f90 wsjtx.rc) target_link_libraries (wspr4sim wsjt_fort wsjt_cxx) +add_executable (wspr4d lib/fsk4hf/wspr4d.f90 wsjtx.rc) +target_link_libraries (wspr4d wsjt_fort wsjt_cxx) + endif(WSJT_BUILD_UTILS) # build the main application diff --git a/lib/fsk4hf/genwspr4.f90 b/lib/fsk4hf/genwspr4.f90 index d3747f41a..0848ffccd 100644 --- a/lib/fsk4hf/genwspr4.f90 +++ b/lib/fsk4hf/genwspr4.f90 @@ -26,7 +26,7 @@ subroutine genwspr4(msg0,ichk,msgsent,msgbits,i4tone) integer*1 codeword(2*ND) integer*1 msgbits(74),rvec(77) integer icos4a(4),icos4b(4),icos4c(4),icos4d(4) - integer*4 ncrc24 + integer ncrc24 logical unpk77_success data icos4a/0,1,3,2/ data icos4b/1,0,2,3/ @@ -59,7 +59,6 @@ subroutine genwspr4(msg0,ichk,msgsent,msgbits,i4tone) read(c24,'(24i1)') msgbits(51:74) if(ichk.eq.1) go to 999 - read(c77,'(74i1)',err=1) msgbits if(unpk77_success) go to 2 1 msgbits=0 itone=0 @@ -68,8 +67,7 @@ subroutine genwspr4(msg0,ichk,msgsent,msgbits,i4tone) entry get_wspr4_tones_from_74bits(msgbits,i4tone) -2 msgbits=mod(msgbits+rvec(1:74),2) - call encode174_74(msgbits,codeword) +2 call encode174_74(msgbits,codeword) ! Grayscale mapping: ! bits tone diff --git a/lib/fsk4hf/get_wspr4_bitmetrics.f90 b/lib/fsk4hf/get_wspr4_bitmetrics.f90 new file mode 100644 index 000000000..d0d82af10 --- /dev/null +++ b/lib/fsk4hf/get_wspr4_bitmetrics.f90 @@ -0,0 +1,118 @@ +subroutine get_wspr4_bitmetrics(cd,bitmetrics,badsync) + + include 'wspr4_params.f90' + parameter (NSS=16) + complex cd(0:NN*NSS-1) + complex cs(0:3,NN) + complex csymb(NSS) + integer icos4a(0:3),icos4b(0:3),icos4c(0:3),icos4d(0:3) + integer graymap(0:3) + integer ip(1) + logical one(0:255,0:7) ! 256 4-symbol sequences, 8 bits + logical first + logical badsync + real bitmetrics(2*NN,3) + real s2(0:255) + real s4(0:3,NN) + + data icos4a/0,1,3,2/ + data icos4b/1,0,2,3/ + data icos4c/2,3,1,0/ + data icos4d/3,2,0,1/ + data graymap/0,1,3,2/ + data first/.true./ + save first,one + + if(first) then + one=.false. + do i=0,255 + do j=0,7 + if(iand(i,2**j).ne.0) one(i,j)=.true. + enddo + 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)) + enddo + +! Sync quality check + is1=0 + is2=0 + is3=0 + is4=0 + badsync=.false. + ibmax=0 + + do k=1,4 + ip=maxloc(s4(:,k)) + if(icos4a(k-1).eq.(ip(1)-1)) is1=is1+1 + ip=maxloc(s4(:,k+33)) + if(icos4b(k-1).eq.(ip(1)-1)) is2=is2+1 + ip=maxloc(s4(:,k+66)) + if(icos4c(k-1).eq.(ip(1)-1)) is3=is3+1 + ip=maxloc(s4(:,k+99)) + if(icos4d(k-1).eq.(ip(1)-1)) is4=is4+1 + enddo + nsync=is1+is2+is3+is4 !Number of correct hard sync symbols, 0-16 + + badsync=.false. +! if(nsync .lt. 8) then +! badsync=.true. +! return +! endif + + do nseq=1,3 !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 + nt=2**(2*nsym) + do ks=1,NN-nsym+1,nsym !87+16=103 symbols. + amax=-1.0 + do i=0,nt-1 + i1=i/64 + i2=iand(i,63)/16 + i3=iand(i,15)/4 + i4=iand(i,3) + if(nsym.eq.1) then + s2(i)=abs(cs(graymap(i4),ks)) + elseif(nsym.eq.2) then + s2(i)=abs(cs(graymap(i3),ks)+cs(graymap(i4),ks+1)) + elseif(nsym.eq.4) then + s2(i)=abs(cs(graymap(i1),ks ) + & + cs(graymap(i2),ks+1) + & + cs(graymap(i3),ks+2) + & + cs(graymap(i4),ks+3) & + ) + else + print*,"Error - nsym must be 1, 2, or 4." + endif + enddo + ipt=1+(ks-1)*2 + if(nsym.eq.1) ibmax=1 + if(nsym.eq.2) ibmax=3 + if(nsym.eq.4) ibmax=7 + do ib=0,ibmax + bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - & + maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,nseq)=bm + enddo + enddo + enddo + + bitmetrics(205:206,2)=bitmetrics(205:206,1) + bitmetrics(201:204,3)=bitmetrics(201:204,2) + bitmetrics(205:206,3)=bitmetrics(205:206,1) + + call normalizebmet(bitmetrics(:,1),2*NN) + call normalizebmet(bitmetrics(:,2),2*NN) + call normalizebmet(bitmetrics(:,3),2*NN) + return + +end subroutine get_wspr4_bitmetrics diff --git a/lib/fsk4hf/wspr4d.f90 b/lib/fsk4hf/wspr4d.f90 new file mode 100644 index 000000000..55af06296 --- /dev/null +++ b/lib/fsk4hf/wspr4d.f90 @@ -0,0 +1,433 @@ +program wspr4d + +! Decode WSPR4 data read from *.c2 or *.wav files. + + use packjt77 + include 'wspr4_params.f90' + parameter (NSPS2=NSPS/32) + character arg*8,cbits*50,infile*80,fname*16,datetime*11 + character ch1*1,ch4*4,cseq*31 + character*22 decodes(100) + character*37 msg + character*120 data_dir + character*32 uwbits + character*77 c77 + complex c2(0:NMAX/32-1) !Complex waveform + complex cframe(0:105*NSPS2-1) !Complex waveform + complex cd(0:105*16-1) !Complex waveform + complex c1(0:9,0:3),c0(0:9,0:3) + complex ccor(0:3,103) + complex cp(0:3,0:1) + complex csum,cterm + complex ctwk(NSPS2*4) + real*8 fMHz + real rxdata(2*ND),llr(174),llra(174),llrb(174),llrc(174) + real sbits(174),sbits1(174),sbits3(174) + real ps(0:8191),psbest(0:8191) + real candidates(100,2) + real bitmetrics(206,3) + integer iuniqueword0 + integer ihdr(11) + integer*2 iwave(NMAX) !Generated full-length waveform + integer*1 decoded(74),apmask(174),cw(174) + integer*1 hbits(206),hbits1(206),hbits3(206) + integer*1 message(50) + integer*1 rvec(77) + logical badsync,unpk77_success + data rvec/0,1,0,0,1,0,1,0,0,1,0,1,1,1,1,0,1,0,0,0,1,0,0,1,1,0,1,1,0, & + 1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1, & + 0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/ + + fs=12000.0/NDOWN !Sample rate + dt=1.0/fs !Sample interval (s) + tt=NSPS*dt !Duration of "itone" symbols (s) + baud=1.0/tt !Keying rate for "itone" symbols (baud) + txt=NZ*dt !Transmission length (s) + h=0.50 !h=0.8 seems to be optimum for AWGN sensitivity (not for fading) + twopi=8.0*atan(1.0) + pi=4.0*atan(1.0) + + nargs=iargc() + if(nargs.lt.1) then + print*,'Usage: wspr4d [-a ] [-f fMHz] [-c ncoh] [-h h] file1 [file2 ...]' + go to 999 + endif + iarg=1 + data_dir="." + call getarg(iarg,arg) + if(arg(1:2).eq.'-a') then + call getarg(iarg+1,data_dir) + iarg=iarg+2 + endif + call getarg(iarg,arg) + if(arg(1:2).eq.'-f') then + call getarg(iarg+1,arg) + read(arg,*) fMHz + iarg=iarg+2 + endif + ncoh=1 + if(arg(1:2).eq.'-h') then + call getarg(iarg+1,arg) + read(arg,*) h + iarg=iarg+2 + endif + + open(13,file=trim(data_dir)//'/ALL_WSPR.TXT',status='unknown', & + position='append') + + xs1=0.0 + xs2=0.0 + fr1=0.0 + fr2=0.0 + nav=0 + ngood=0 +fcsum=0.0 +fcsum2=0.0 +xsum=0.0 +xsum2=0.0 + do ifile=iarg,nargs + call getarg(ifile,infile) + open(10,file=infile,status='old',access='stream') + j1=index(infile,'.c2') + j2=index(infile,'.wav') + if(j1.gt.0) then + read(10,end=999) fname,ntrmin,fMHz,c2 + read(fname(8:11),*) nutc + write(datetime,'(i11)') nutc + else if(j2.gt.0) then + read(10,end=999) ihdr,iwave + read(infile(j2-4:j2-1),*) nutc + datetime=infile(j2-11:j2-1) + call wspr4_downsample(iwave,c2) + else + print*,'Wrong file format?' + go to 999 + endif + close(10) + + fa=-100.0 + fb=100.0 + fs=12000.0/32.0 + npts=120*12000.0/32.0 + nsync=16 + + call getcandidate4(c2,npts,fs,fa,fb,ncand,candidates) !First approx for freq + + ndecodes=0 + do icand=1,1 + fc0=candidates(icand,1) + xsnr=candidates(icand,2) + xmax=-1e32 + smax=0.0 + fc1=fc0-1.50*(fs/416.0) + do if=-20,20 + df=if*0.02 + fc=fc1+df + do is=300,450,5 + call coherent_sync(c2,is,fc,1,sync) + if(sync.gt.smax) then + fc2=fc + isbest=is + smax=sync + endif + enddo + enddo +write(*,*) -1.50*(fs/416),fc1,fc2,isbest +fcsum=fcsum+fc2 +fcsum2=fcsum2+fc2*fc2 +xsum=xsum+isbest +xsum2=xsum2+isbest*isbest +istart=isbest +fcest=fc2 +!genie sync +! istart=375 +! fcest=0.0-1.50*(fs/416) + h=1.0 + cframe=c2(istart:istart+105*416-1) + call downsample4(cframe,fcest,h,cd) + s2=sum(cd*conjg(cd))/(16*105) + cd=cd/sqrt(s2) + call get_wspr4_bitmetrics(cd,bitmetrics,badsync) +! if(badsync) cycle + + hbits=0 + where(bitmetrics(:,1).ge.0) hbits=1 + ns1=count(hbits( 1: 8).eq.(/0,0,0,1,1,0,1,1/)) + ns2=count(hbits( 67: 74).eq.(/0,1,0,0,1,1,1,0/)) + ns3=count(hbits(133:140).eq.(/1,1,1,0,0,1,0,0/)) + ns4=count(hbits(199:206).eq.(/1,0,1,1,0,0,0,1/)) + nsync_qual=ns1+ns2+ns3+ns4 +! if(nsync_qual.lt. 20) cycle + + scalefac=2.83 + llra( 1: 58)=bitmetrics( 9: 66, 1) + llra( 59:116)=bitmetrics( 75:132, 1) + llra(117:174)=bitmetrics(141:198, 1) + llra=scalefac*llra + llrb( 1: 58)=bitmetrics( 9: 66, 2) + llrb( 59:116)=bitmetrics( 75:132, 2) + llrb(117:174)=bitmetrics(141:198, 2) + llrb=scalefac*llrb + llrc( 1: 58)=bitmetrics( 9: 66, 3) + llrc( 59:116)=bitmetrics( 75:132, 3) + llrc(117:174)=bitmetrics(141:198, 3) + llrc=scalefac*llrc + apmask=0 + max_iterations=40 + + do itry=3,1,-1 + if(itry.eq.1) llr=llra + if(itry.eq.2) llr=llrb + if(itry.eq.3) llr=llrc + nhardbp=0 + nhardosd=0 + call bpdecode174_74(llr,apmask,max_iterations,message,cw,nhardbp,niterations) + Keff=64 + if(nhardbp.lt.0) call osd174_74(llr,Keff,apmask,5,message,cw,nhardosd,dmin) +!write(*,*) ifile,nhardosd,dmin + if(nhardbp.ge.0 .or. nhardosd.ge.0) then + write(c77,'(50i1)') message + c77(51:77)='000000000000000000000110000' + call unpack77(c77,0,msg,unpk77_success) + if(unpk77_success .and. index(msg,'K9AN').gt.0) then + write(*,1100) ifile,fc0,xsnr,msg(1:14),itry,nhardbp,nhardosd,dmin +1100 format(i5,2x,f8.2,2x,f8.2,2x,a14,i4,i4,i4,f7.2) + exit + else + cycle + endif + endif + enddo + enddo !candidate list + enddo !files +nfiles=nargs-iarg+1 +fcav=fcsum/nfiles +fcvar=fcsum2/nfiles-fcav**2 +fcstd=sqrt(fcvar) +xav=xsum/nfiles +xvar=xsum2/nfiles-xav**2 +xstd=sqrt(xvar) +write(*,*) 'averages, nfiles: ',nfiles +write(*,*) ' avg freq std avg offset std' +write(*,'(f9.4,2x,f8.4,2x,f8.1,2x,f8.1,2x)') fcav,fcstd,xav,xstd + write(*,1120) +1120 format("") + +999 end program wspr4d + +subroutine coherent_sync(cd0,i0,f0,itwk,sync) + +! Compute sync power for a complex, downsampled FT4 signal. + + include 'wspr4_params.f90' + parameter(NP=NMAX/NDOWN,NSS=NSPS/NDOWN) + complex cd0(0:NP-1) + complex csynca(4*NSS),csyncb(4*NSS),csyncc(4*NSS),csyncd(4*NSS) + complex csync2(4*NSS) + complex ctwk(4*NSS) + complex z1,z2,z3,z4 + logical first + integer icos4a(0:3),icos4b(0:3),icos4c(0:3),icos4d(0:3) + data icos4a/0,1,3,2/ + data icos4b/1,0,2,3/ + data icos4c/2,3,1,0/ + data icos4d/3,2,0,1/ + data first/.true./ + save first,twopi,csynca,csyncb,csyncc,csyncd,fac + + p(z1)=(real(z1*fac)**2 + aimag(z1*fac)**2)**0.5 !Statement function for power + + if( first ) then + twopi=8.0*atan(1.0) + k=1 + phia=0.0 + phib=0.0 + phic=0.0 + phid=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) + do j=1,NSS + csynca(k)=cmplx(cos(phia),sin(phia)) + csyncb(k)=cmplx(cos(phib),sin(phib)) + csyncc(k)=cmplx(cos(phic),sin(phic)) + csyncd(k)=cmplx(cos(phid),sin(phid)) + phia=mod(phia+dphia,twopi) + phib=mod(phib+dphib,twopi) + phic=mod(phic+dphic,twopi) + phid=mod(phid+dphid,twopi) + k=k+1 + enddo + enddo + first=.false. + fac=1.0/(4.0*NSS) + endif + + i1=i0 !four Costas arrays + i2=i0+33*NSS + i3=i0+66*NSS + i4=i0+99*NSS + + z1=0. + z2=0. + z3=0. + z4=0. + + if(itwk.eq.1) then + dt=1/(12000.0/32.0) + dphi=twopi*f0*dt + phi=0.0 + do i=1,4*NSS + ctwk(i)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + enddo + endif + + if(itwk.eq.1) csync2=ctwk*csynca !Tweak the frequency + z1=0. + if(i1.ge.0 .and. i1+4*NSS-1.le.NP-1) then + z1=sum(cd0(i1:i1+4*NSS-1)*conjg(csync2)) + elseif( i1.lt.0 ) then + npts=(i1+4*NSS-1)/2 + if(npts.le.32) then + z1=0. + else + z1=sum(cd0(0:i1+4*NSS-1)*conjg(csync2(4*NSS-npts:))) + endif + endif + + if(itwk.eq.1) csync2=ctwk*csyncb !Tweak the frequency + if(i2.ge.0 .and. i2+4*NSS-1.le.NP-1) z2=sum(cd0(i2:i2+4*NSS-1)*conjg(csync2)) + + if(itwk.eq.1) csync2=ctwk*csyncc !Tweak the frequency + if(i3.ge.0 .and. i3+4*NSS-1.le.NP-1) z3=sum(cd0(i3:i3+4*NSS-1)*conjg(csync2)) + + if(itwk.eq.1) csync2=ctwk*csyncd !Tweak the frequency + z4=0. + if(i4.ge.0 .and. i4+4*NSS-1.le.NP-1) then + z4=sum(cd0(i4:i4+4*NSS-1)*conjg(csync2)) + elseif( i4+4*NSS-1.gt.NP-1 ) then + npts=(NP-1-i4+1) + if(npts.le.32) then + z4=0. + else + z4=sum(cd0(i4:i4+2*npts-1)*conjg(csync2(1:npts))) + endif + endif + + sync = p(z1) + p(z2) + p(z3) + p(z4) + + return +end subroutine coherent_sync + +subroutine downsample4(ci,f0,h,co) + parameter(NI=105*416,NH=NI/2,NO=NI/26) ! downsample from 416 samples per symbol to 16 + complex ci(0:NI-1),ct(0:NI-1) + complex co(0:NO-1) + fs=12000.0/32.0 + df=fs/NI + ct=ci + call four2a(ct,NI,1,-1,1) !c2c FFT to freq domain + i0=nint(f0/df) + ct=cshift(ct,i0) + co=0.0 + co(0)=ct(0) + b=max(1.0,h)*8.0 + do i=1,NO/2 + arg=(i*df/b)**2 + filt=exp(-arg) + co(i)=ct(i)*filt + co(NO-i)=ct(NI-i)*filt + enddo + co=co/NO + call four2a(co,NO,1,1,1) !c2c FFT back to time domain + return +end subroutine downsample4 + +subroutine getcandidate4(c,npts,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) + complex csfil(0:NFFT2-1) + complex cwork(0:NFFT2-1) + real bigspec(0:NFFT2-1) + complex c2(0:NFFT1-1) !Short spectra + real s(-NH1+1:NH1) !Coarse spectrum + real ss(-NH1+1:NH1) !Smoothed coarse spectrum + real candidates(100,2) + integer indx(NFFT2-1) + logical first + data first/.true./ + save first,w,df,csfil + + if(first) then + df=10*fs/NFFT1 + csfil=cmplx(0.0,0.0) + do i=0,NFFT2-1 + csfil(i)=exp(-((i-NH2)/32.0)**2) ! revisit this + enddo + csfil=cshift(csfil,NH2) + call four2a(csfil,NFFT2,1,-1,1) + first=.false. + endif + + cc=cmplx(0.0,0.0) + cc(0:npts-1)=c; + call four2a(cc,NFFT1,1,-1,1) + cc=abs(cc)**2 + call four2a(cc,NFFT1,1,-1,1) + cwork(0:NH2)=cc(0:NH2)*conjg(csfil(0:NH2)) + cwork(NH2+1:NFFT2-1)=cc(NFFT1-NH2+1:NFFT1-1)*conjg(csfil(NH2+1:NFFT2-1)) + + call four2a(cwork,NFFT2,1,+1,1) + bigspec=cshift(real(cwork),-NH2) + il=NH2+fa/df + ih=NH2+fb/df + nnl=ih-il+1 + call indexx(bigspec(il:il+nnl-1),nnl,indx) + xn=bigspec(il-1+indx(nint(0.3*nnl))) + bigspec=bigspec/xn + ncand=0 + do i=il,ih + if((bigspec(i).gt.bigspec(i-1)).and. & + (bigspec(i).gt.bigspec(i+1)).and. & + (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)-26.0 + endif + enddo + return +end subroutine getcandidate4 + +subroutine wspr4_downsample(iwave,c) + +! Input: i*2 data in iwave() at sample rate 12000 Hz +! Output: Complex data in c(), sampled at 375 Hz + + include 'wspr4_params.f90' + parameter (NFFT2=NMAX/32) + integer*2 iwave(NMAX) + complex c(0:NMAX/32-1) + complex c1(0:NFFT2-1) + complex cx(0:NMAX/2) + real x(NMAX) + equivalence (x,cx) + + df=12000.0/NMAX + x=iwave + call four2a(x,NMAX,1,-1,0) !r2c FFT to freq domain + i0=nint(1500.0/df) + c1(0)=cx(i0) + do i=1,NFFT2/2 + c1(i)=cx(i0+i) + c1(NFFT2-i)=cx(i0-i) + enddo + c1=c1/NFFT2 + call four2a(c1,NFFT2,1,1,1) !c2c FFT back to time domain + c=c1(0:NMAX/32-1) + return +end subroutine wspr4_downsample + diff --git a/lib/fsk4hf/wspr4sim.f90 b/lib/fsk4hf/wspr4sim.f90 index ecb359b2f..2806f9116 100644 --- a/lib/fsk4hf/wspr4sim.f90 +++ b/lib/fsk4hf/wspr4sim.f90 @@ -61,7 +61,7 @@ program wspr4sim write(*,'(28i1,1x,i1,1x,28i1,1x,i1,1x,i1,1x,15i1,1x,3i1)') msgbits(1:77) else write(*,'(a14)') 'Message bits: ' - write(*,'(77i1)') msgbits + write(*,'(50i1,1x,24i1)') msgbits endif write(*,*) write(*,'(a17)') 'Channel symbols: ' @@ -73,8 +73,7 @@ program wspr4sim fsample=12000.0 icmplx=1 call gen_wspr4wave(itone,NN,NSPS,fsample,f0,c0,wave,icmplx,NMAX) - - k=nint((xdt+0.5)/dt)-NSPS + k=nint((xdt+1.0)/dt)-NSPS c0=cshift(c0,-k) if(k.gt.0) c0(0:k-1)=0.0 if(k.lt.0) c0(NMAX+k:NMAX-1)=0.0