WSJT-X/lib/extract.F90
Joe Taylor d9bc8f5dff Optimizations of JT9 and JT65 decoders; change clock in timer routine.
Both decoders now have slightly better performance and faster
execution.  The rare "duplicate decodes" in JT9 were eliminated.
On Windows, at least, calls to f90 routine system_clock() do not
provide correct wall time increments.  Changed to using secnds()
instead.


git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@4571 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2014-10-30 19:29:16 +00:00

122 lines
3.5 KiB
Fortran

subroutine extract(s3,nadd,ncount,nhist,decoded,ltext,nbmkv)
!subroutine extract(s3,nadd,nbirdie,afac1,xlambda,ncount,nhist,decoded, &
! ltext,nbmkv,ntest)
! 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 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
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) !Test for birdies and QRM
if(nhist.ge.nbirdie) then
nfail=nfail+1
call pctile(s3,4032,npct,base)
s3(ipk,1:63)=base
if(nfail.gt.30) then
decoded=' '
ncount=-1
go to 900
endif
go to 1
endif
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
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
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
dat4=0
write(22,rec=1) nsec1,xlambda,maxe,200,mrsym,mrprob,mr2sym,mr2prob
write(22,rec=2) -1,-1,dat4
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.
#ifdef WIN32
iret=system('""'//trim(exe_dir)//'/kvasd" -q >dev_null"')
! iret=system('""'//trim(exe_dir)//'/kvasd" kvasd.dat >dev_null"')
#else
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
1000 format('Error in KV decoder, or no KV decoder present.',i12)
! nokv=.true.
go to 900
endif
read(22,rec=2,err=900) nsec2,ncount,dat4
j=nsec2 !Silence compiler warning
decoded=' '
ltext=.false.
if(ncount.ge.0) then
call unpackmsg(dat4,decoded) !Unpack the user message
if(index(decoded,'...... ').gt.0) then
ncount=-1
go to 900
endif
if(iand(dat4(10),8).ne.0) ltext=.true.
nbmkv=2
endif
900 return
end subroutine extract