mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-19 10:32:02 -05:00
136 lines
3.1 KiB
Fortran
136 lines
3.1 KiB
Fortran
subroutine extract(s3,nadd,ncount,nhist,decoded,ltext)
|
|
|
|
use packjt
|
|
real s3(64,63)
|
|
character decoded*22
|
|
integer era(51),dat4(12),indx(64)
|
|
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
|
|
logical first,ltext
|
|
integer correct(63),itmp(63)
|
|
integer param(0:8)
|
|
integer h0(0:11),d0(0:11),ne(0:11)
|
|
real r0(0:11)
|
|
common/test001/s3a(64,63),mrs(63),mrs2(63) !### TEST ONLY ###
|
|
|
|
! 0 1 2 3 4 5 6 7 8 9 10 11
|
|
data h0/41,42,43,43,44,45,46,47,48,48,49,49/
|
|
data d0/71,72,73,74,76,77,78,80,81,82,83,83/
|
|
! 0 1 2 3 4 5 6 7 8 9 10 11
|
|
data r0/0.70,0.72,0.74,0.76,0.78,0.80,0.82,0.84,0.86,0.88,0.90,0.90/
|
|
|
|
data first/.true./,nsec1/0/
|
|
save
|
|
|
|
nfail=0
|
|
call pctile(s3,4032,50,base) ! ### or, use ave from demod64a
|
|
s3=s3/base
|
|
s3a=s3
|
|
1 call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
|
|
! if(ntest.lt.50 .or. nlow.gt.20) then
|
|
! ncount=-999 !Flag bad data
|
|
! go to 900
|
|
! endif
|
|
call chkhist(mrsym,nhist,ipk)
|
|
|
|
if(nhist.ge.20) then
|
|
nfail=nfail+1
|
|
call pctile(s3,4032,50,base) ! ### or, use ave from demod64a
|
|
s3(ipk,1:63)=base
|
|
if(nfail.gt.30) then
|
|
decoded=' '
|
|
ncount=-1
|
|
go to 900
|
|
endif
|
|
go to 1
|
|
endif
|
|
|
|
mrs=mrsym
|
|
mrs2=mr2sym
|
|
|
|
call graycode(mrsym,63,-1)
|
|
call interleave63(mrsym,-1)
|
|
call interleave63(mrprob,-1)
|
|
|
|
call graycode(mr2sym,63,-1)
|
|
call interleave63(mr2sym,-1)
|
|
call interleave63(mr2prob,-1)
|
|
|
|
ntrials=10000
|
|
naggressive=10
|
|
|
|
ntry=0
|
|
param=0
|
|
|
|
call timer('ftrsd ',0)
|
|
call ftrsd2(mrsym,mrprob,mr2sym,mr2prob,ntrials,correct,param,ntry)
|
|
call timer('ftrsd ',1)
|
|
ncandidates=param(0)
|
|
nhard=param(1)
|
|
nsoft=param(2)
|
|
nerased=param(3)
|
|
rtt=0.001*param(4)
|
|
ntotal=param(5)
|
|
qual=0.001*param(7)
|
|
nd0=81
|
|
r00=0.87
|
|
if(naggressive.eq.10) then
|
|
nd0=83
|
|
r00=0.90
|
|
endif
|
|
if(ntotal.le.nd0 .and. rtt.le.r00) nft=1
|
|
n=naggressive
|
|
if(nhard.gt.50) nft=0
|
|
if(nhard.gt.h0(n)) nft=0
|
|
if(ntotal.gt.d0(n)) nft=0
|
|
if(rtt.gt.r0(n)) nft=0
|
|
|
|
ncount=-1
|
|
decoded=' '
|
|
ltext=.false.
|
|
if(nft.gt.0) then
|
|
! Turn the corrected symbol array into channel symbols for subtraction;
|
|
! pass it back to jt65a via common block "chansyms65".
|
|
do i=1,12
|
|
dat4(i)=correct(13-i)
|
|
enddo
|
|
do i=1,63
|
|
itmp(i)=correct(64-i)
|
|
enddo
|
|
correct(1:63)=itmp(1:63)
|
|
call interleave63(correct,63,1)
|
|
call graycode65(correct,63,1)
|
|
call unpackmsg(dat4,decoded) !Unpack the user message
|
|
ncount=0
|
|
if(iand(dat4(10),8).ne.0) ltext=.true.
|
|
endif
|
|
900 continue
|
|
if(nft.eq.1 .and. nhard.lt.0) decoded=' '
|
|
! write(81,3001) naggressive,ncandidates,nhard,ntotal,rtt,qual,decoded
|
|
!3001 format(i2,i6,i3,i4,2f8.2,2x,a22)
|
|
|
|
return
|
|
end subroutine extract
|
|
|
|
subroutine getpp(workdat,p)
|
|
|
|
integer workdat(63)
|
|
integer a(63)
|
|
common/test001/s3a(64,63),mrs(63),mrs2(63)
|
|
|
|
a(1:63)=workdat(63:1:-1)
|
|
call interleave63(a,1)
|
|
call graycode(a,63,1,a)
|
|
|
|
psum=0.
|
|
do j=1,63
|
|
i=a(j)+1
|
|
x=s3a(i,j)
|
|
s3a(i,j)=0.
|
|
psum=psum + x
|
|
s3a(i,j)=x
|
|
enddo
|
|
p=psum/63.0
|
|
|
|
return
|
|
end subroutine getpp
|