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

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
+     limit=5000
-     ccflim=4.0
+     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
+           sync=(syncpk+1)/4.0
-!3001       format(2i6,2f8.1,3f6.1)
+           if(maxval(i1SoftSymbols).eq.0) cycle
-!           call flush(71)
+           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
-           if(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('<DecodeFinished>',2i4)
   call flush(6)

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.
+  ave=sum(s3)/(64.*63.)
-  do j=1,63
-     do i=1,64
-        sum=sum+s3(i,j)
-     enddo
-  enddo
-  ave=sum/(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

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
+  decoded='                      '
-  call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
+  call pctile(s3,4032,npct,base)
-  if(ntest.lt.50 .or. nlow.gt.20) then
+  s3=s3/base
-     ncount=-999                         !Flag bad data
+
+! 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
+     call pctile(s3,4032,npct,base)
-     do j=1,63
+     s3(ipk,1:63)=base
-        s3(ipk,j)=base
-     enddo
      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 graycode65(mrsym,63,-1)        !Remove gray code and interleaving
-  call interleave63(mrsym,-1)
+  call interleave63(mrsym,-1)         !from most reliable symbols
   call interleave63(mrprob,-1)
 
 ! Decode using Berlekamp-Massey algorithm
-  nemax=30                                         !Max BM erasures
+  call timer('rs_decod',0)
-  call indexx(63,mrprob,indx)
+  call rs_decode(mrsym,0,0,dat4,ncount)
-  do i=1,nemax
+  call timer('rs_decod',1)
-     j=indx(i)
+  if(ncount.ge.0) then
-     if(mrprob(j).gt.120) then
+     call unpackmsg(dat4,decoded)
-        ne2=i-1
+     if(iand(dat4(10),8).ne.0) ltext=.true.
-        go to 2
+     nbmkv=1
-     endif
+     go to 900
-     era(i)=j-1
+  endif
-  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
 
 ! 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
+  call graycode65(mr2sym,63,-1)      !Remove gray code and interleaving
-  xlambda=7.99
+  call interleave63(mr2sym,-1)       !from second-most-reliable symbols
-  call graycode65(mr2sym,63,-1)
-  call interleave63(mr2sym,-1)
   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
+! TODO G4WJS: Take out '-q' argument once kvasd 1.12 is available for 
-!      	      where CMake fetches it from.
+! 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
+900 return
-
-  return
 end subroutine extract

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.

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)
+!     call system_clock(icount,irate)
-     ut0(n)=float(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)
+!        call system_clock(icount,irate)
-        ut1=float(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

wsjtx.qrc

@@ -32,7 +32,7 @@
     <file>Palettes/YL2KF.pal</file>
     <file>Palettes/Yellow1.pal</file>
     <file>Palettes/Yellow2.pal</file>
-    <file>Palettes/ZL2FZ.pal</file>
+    <file>Palettes/ZL1FZ.pal</file>
     <file>samples/130418_1742.wav</file>
     <file>samples/130610_2343.wav</file>
 </qresource>