From dfaa600a399ae3c19eff66dbaf92e3974c8e27b5 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Thu, 13 Nov 2014 18:22:12 +0000 Subject: [PATCH] Merge r4556,4557,4558,4571 from branches/wsjtx to branches/wsjtx-1.4. git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx-1.4@4595 ab8295b8-cf94-4d9e-aec4-7959e3be5d79 --- Palettes/{ZL2FZ.pal => ZL1FZ.pal} | 0 lib/decoder.f90 | 19 +++--- lib/demod64a.f90 | 21 ++----- lib/extract.F90 | 97 ++++++++++++++++--------------- lib/symspec2.f90 | 5 +- lib/timer.f90 | 17 ++++-- wsjtx.qrc | 2 +- 7 files changed, 81 insertions(+), 80 deletions(-) rename Palettes/{ZL2FZ.pal => ZL1FZ.pal} (100%) diff --git a/Palettes/ZL2FZ.pal b/Palettes/ZL1FZ.pal similarity index 100% rename from Palettes/ZL2FZ.pal rename to Palettes/ZL1FZ.pal diff --git a/lib/decoder.f90 b/lib/decoder.f90 index a9694b366..65ab9371c 100644 --- a/lib/decoder.f90 +++ b/lib/decoder.f90 @@ -21,7 +21,6 @@ subroutine decoder(ss,id2) common/tracer/limtrace,lu save - call system_clock(iclock0,iclock_rate,iclock_max) !### nfreqs0=0 nfreqs1=0 ndecodes0=0 @@ -84,13 +83,13 @@ subroutine decoder(ss,id2) dblim=db(864.0/nsps8) - 26.2 do nqd=1,0,-1 - limit=1000 - ccflim=4.0 + limit=5000 + ccflim=3.0 red2lim=1.6 schklim=2.2 if(ndepth.eq.2) then limit=10000 - ccflim=3.5 + ccflim=2.7 endif if(ndepth.ge.3 .or. nqd.eq.1) then limit=100000 @@ -135,17 +134,15 @@ subroutine decoder(ss,id2) freq,drift,schk,i1SoftSymbols) call timer('softsym ',1) -! write(71,3001) nqd,i,f,fpk,ccfred(i),red2(i),schk -!3001 format(2i6,2f8.1,3f6.1) -! call flush(71) - - if(schk.lt.schklim) cycle + sync=(syncpk+1)/4.0 + if(maxval(i1SoftSymbols).eq.0) cycle + if(nqd.eq.1 .and. ((sync.lt.0.5) .or. (schk.lt.2.0))) cycle + if(nqd.ne.1 .and. ((sync.lt.1.0) .or. (schk.lt.schklim))) cycle call timer('decode9 ',0) call decode9(i1SoftSymbols,limit,nlim,msg) call timer('decode9 ',1) - sync=(syncpk+1)/4.0 if(sync.lt.0.0 .or. snrdb.lt.dblim-2.0) sync=0.0 nsync=sync if(nsync.gt.10) nsync=10 @@ -183,7 +180,7 @@ subroutine decoder(ss,id2) call jt65a(dd,npts65,newdat,nutc,nf1,nf2,nfqso,ntol65,nagain,ndecoded) endif -!### JT65 is not yet producing info for nsynced, ndecoded. +! JT65 is not yet producing info for nsynced, ndecoded. 800 write(*,1010) nsynced,ndecoded 1010 format('',2i4) call flush(6) diff --git a/lib/demod64a.f90 b/lib/demod64a.f90 index 9d1a37942..452140a28 100644 --- a/lib/demod64a.f90 +++ b/lib/demod64a.f90 @@ -1,4 +1,4 @@ -subroutine demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) +subroutine demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) ! Demodulate the 64-bin spectra for each of 63 symbols in a frame. @@ -10,23 +10,16 @@ subroutine demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) ! mr2prob probability that mr2sym was the transmitted value implicit real*8 (a-h,o-z) - real*4 s3(64,63) + real*4 s3(64,63),afac1 real*8 fs(64) integer mrsym(63),mrprob(63),mr2sym(63),mr2prob(63) -! common/mrscom/ mrs(63),mrs2(63) if(nadd.eq.-999) return - afac=1.1 * float(nadd)**0.64 + afac=afac1 * float(nadd)**0.64 scale=255.999 ! Compute average spectral value - sum=0. - do j=1,63 - do i=1,64 - sum=sum+s3(i,j) - enddo - enddo - ave=sum/(64.*63.) + ave=sum(s3)/(64.*63.) i1=1 !Silence warning i2=1 @@ -57,17 +50,13 @@ subroutine demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) mr2sym(j)=i2-1 mrprob(j)=scale*p1 mr2prob(j)=scale*p2 -! mrs(j)=i1 -! mrs2(j)=i2 enddo - sum=0. nlow=0 do j=1,63 - sum=sum+mrprob(j) if(mrprob(j).le.5) nlow=nlow+1 enddo - ntest=sum/63 + ntest=sum(mrprob)/63.0 return end subroutine demod64a diff --git a/lib/extract.F90 b/lib/extract.F90 index 978bc6dca..736d8219d 100644 --- a/lib/extract.F90 +++ b/lib/extract.F90 @@ -1,31 +1,52 @@ subroutine extract(s3,nadd,ncount,nhist,decoded,ltext,nbmkv) +!subroutine extract(s3,nadd,nbirdie,afac1,xlambda,ncount,nhist,decoded, & +! ltext,nbmkv,ntest) - use prog_args + +! Input: +! s3 64-point spectra for each of 63 data symbols +! nadd number of spectra summed into s3 + +! Output: +! ncount number of symbols requiring correction +! nhist maximum number of identical symbol values +! decoded decoded message (if ncount >=0) +! ltext true if decoded message is free text +! nbmkv 0=no decode; 1=BM decode; 2=KV decode + + use prog_args !shm_key, exe_dir, data_dir real s3(64,63) character decoded*22 - integer era(51),dat4(12),indx(64) + integer dat4(12) integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63) logical nokv,ltext data nokv/.false./,nsec1/0/ save + nbirdie=7 + npct=40 + afac1=10.1 + xlambda=8.0 nbmkv=0 nfail=0 -1 continue - call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) - if(ntest.lt.50 .or. nlow.gt.20) then - ncount=-999 !Flag bad data + decoded=' ' + call pctile(s3,4032,npct,base) + s3=s3/base + +! Get most reliable and second-most-reliable symbol values, and their +! probabilities +1 call demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) + if(ntest.lt.100) then + ncount=-999 !Flag and reject bad data go to 900 endif - call chkhist(mrsym,nhist,ipk) - if(nhist.ge.20) then + call chkhist(mrsym,nhist,ipk) !Test for birdies and QRM + if(nhist.ge.nbirdie) then nfail=nfail+1 - call pctile(s3,4032,50,base) ! ### or, use ave from demod64a - do j=1,63 - s3(ipk,j)=base - enddo + call pctile(s3,4032,npct,base) + s3(ipk,1:63)=base if(nfail.gt.30) then decoded=' ' ncount=-1 @@ -34,42 +55,27 @@ subroutine extract(s3,nadd,ncount,nhist,decoded,ltext,nbmkv) go to 1 endif - call graycode65(mrsym,63,-1) - call interleave63(mrsym,-1) + call graycode65(mrsym,63,-1) !Remove gray code and interleaving + call interleave63(mrsym,-1) !from most reliable symbols call interleave63(mrprob,-1) ! Decode using Berlekamp-Massey algorithm - nemax=30 !Max BM erasures - call indexx(63,mrprob,indx) - do i=1,nemax - j=indx(i) - if(mrprob(j).gt.120) then - ne2=i-1 - go to 2 - endif - era(i)=j-1 - enddo - ne2=nemax -2 decoded=' ' - do nerase=0,ne2,2 - call rs_decode(mrsym,era,nerase,dat4,ncount) - if(ncount.ge.0) then - call unpackmsg(dat4,decoded) - if(iand(dat4(10),8).ne.0) ltext=.true. - nbmkv=1 - go to 900 - endif - enddo + call timer('rs_decod',0) + call rs_decode(mrsym,0,0,dat4,ncount) + call timer('rs_decod',1) + if(ncount.ge.0) then + call unpackmsg(dat4,decoded) + if(iand(dat4(10),8).ne.0) ltext=.true. + nbmkv=1 + go to 900 + endif ! Berlekamp-Massey algorithm failed, try Koetter-Vardy - if(nokv) go to 900 maxe=8 !Max KV errors in 12 most reliable symbols -! xlambda=12.0 - xlambda=7.99 - call graycode65(mr2sym,63,-1) - call interleave63(mr2sym,-1) + call graycode65(mr2sym,63,-1) !Remove gray code and interleaving + call interleave63(mr2sym,-1) !from second-most-reliable symbols call interleave63(mr2prob,-1) nsec1=nsec1+1 @@ -79,8 +85,8 @@ subroutine extract(s3,nadd,ncount,nhist,decoded,ltext,nbmkv) call flush(22) call timer('kvasd ',0) -! TODO G4WJS: Take out '-q' argument once kvasd 1.12 is available for Mac and in the repo -! where CMake fetches it from. +! TODO G4WJS: Take out '-q' argument once kvasd 1.12 is available for +! Mac and in the repo where CMake fetches it from. #ifdef WIN32 iret=system('""'//trim(exe_dir)//'/kvasd" -q >dev_null"') ! iret=system('""'//trim(exe_dir)//'/kvasd" kvasd.dat >dev_null"') @@ -88,6 +94,7 @@ subroutine extract(s3,nadd,ncount,nhist,decoded,ltext,nbmkv) iret=system('"'//trim(exe_dir)//'/kvasd" -q >/dev/null') ! iret=system('"'//trim(exe_dir)//'/kvasd" kvasd.dat >/dev/null') #endif + call timer('kvasd ',1) if(iret.ne.0) then if(.not.nokv) write(*,1000) iret @@ -97,7 +104,7 @@ subroutine extract(s3,nadd,ncount,nhist,decoded,ltext,nbmkv) endif read(22,rec=2,err=900) nsec2,ncount,dat4 - j=nsec2 !Silence compiler warning + j=nsec2 !Silence compiler warning decoded=' ' ltext=.false. if(ncount.ge.0) then @@ -110,7 +117,5 @@ subroutine extract(s3,nadd,ncount,nhist,decoded,ltext,nbmkv) nbmkv=2 endif -900 continue - - return +900 return end subroutine extract diff --git a/lib/symspec2.f90 b/lib/symspec2.f90 index 92dc5715a..f8dc7cda5 100644 --- a/lib/symspec2.f90 +++ b/lib/symspec2.f90 @@ -34,7 +34,10 @@ subroutine symspec2(c5,nz3,nsps8,nspsd,fsample,freq,drift,snrdb,schk, & enddo call chkss2(ss2,freq,drift,schk) - if(schk.lt.2.0) go to 900 + if(schk.lt.2.0) then + i1SoftSymbolsScrambled=0 + go to 900 + endif ss=0. sig=0. diff --git a/lib/timer.f90 b/lib/timer.f90 index 16374932e..b9019f379 100644 --- a/lib/timer.f90 +++ b/lib/timer.f90 @@ -36,8 +36,11 @@ subroutine timer(dname,k) if(on(n)) print*,'Error in timer: ',dname,' already on.' level=level+1 !Increment the level on(n)=.true. - call system_clock(icount,irate) - ut0(n)=float(icount)/irate +! call system_clock(icount,irate) +! ut0(n)=float(icount)/irate +! call cpu_time(ut0(n)) + ut0(n)=secnds(0.0) + ncall(n)=ncall(n)+1 if(ncall(n).gt.1.and.nlevel(n).ne.level) then nlevel(n)=-1 @@ -50,8 +53,11 @@ subroutine timer(dname,k) else if(k.eq.1) then !Get stop times and accumulate sums. (k=1) if(on(n)) then on(n)=.false. - call system_clock(icount,irate) - ut1=float(icount)/irate +! call system_clock(icount,irate) +! ut1=float(icount)/irate +! call cpu_time(ut1) + ut1=secnds(0.0) + ut(n)=ut(n)+ut1-ut0(n) endif level=level-1 @@ -84,6 +90,7 @@ subroutine timer(dname,k) do j=i,nmax if(nparent(j).eq.i) dut(i)=dut(i)-ut(j) enddo + if(dut(i).lt.0.0) dut(i)=0.0 utf=ut(i)/total dutf=dut(i)/total sum=sum+dut(i) @@ -94,7 +101,7 @@ subroutine timer(dname,k) if(i.ge.2) ename=name(nparent(i)) write(lu,1060) float(i),sname,ut(i),utf,dut(i),dutf, & ncall(i),nlevel(i),ename -1060 format(f4.0,a16,2(f10.2,f6.2),i7,i5,2x,a8) +1060 format(f4.0,a16,2(f10.3,f6.2),i7,i5,2x,a8) enddo write(lu,1070) sum,sumf diff --git a/wsjtx.qrc b/wsjtx.qrc index 600d44db3..2638d3c2b 100644 --- a/wsjtx.qrc +++ b/wsjtx.qrc @@ -32,7 +32,7 @@ Palettes/YL2KF.pal Palettes/Yellow1.pal Palettes/Yellow2.pal - Palettes/ZL2FZ.pal + Palettes/ZL1FZ.pal samples/130418_1742.wav samples/130610_2343.wav