WSJT-X/lib/ftrsd/extract2.f90
Joe Taylor 02891bd411 Morphing sfrsd toward ftrsd...
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6241 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2015-12-07 13:44:00 +00:00

146 lines
3.2 KiB
Fortran

subroutine extract2(s3,nadd,ntrials,param,msg)
real s3(64,63)
real tmp(4032)
integer np1(0:7,0:7),np2(0:7,0:7),np0(0:7,0:7)
integer ns(0:7,0:7)
integer perr(0:7,0:7),pmr2(0:7,0:7)
character msg*22
integer dat4(12)
integer mrsym(0:62),mr2sym(0:62),mrprob(0:62),mr2prob(0:62)
integer correct(0:62)
integer param(0:7)
integer indx(0:62)
logical first
real*8 tt
common/extcom/ntdecode
data ndone/0/,ngood/0/,nbad/0/,first/.true./
save
if(first) then
np1=0
np2=0
np0=0
ns=0
first=.false.
endif
nfail=0
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,tmp,4032,50,base) ! ### or, use ave from demod64a ?
do j=1,63
s3(ipk,j)=base
enddo
go to 1
endif
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)
nverbose=0
call ftrsd2(mrsym,mrprob,mr2sym,mr2prob,ntrials,nverbose,correct, &
param,indx,tt,ntry)
ncandidates=param(0)
nhard=param(1)
nsoft=param(2)
nera=param(3)
ngmd=param(4)
ndone=ndone+1
do i=1,12
dat4(i)=correct(12-i)
enddo
msg=' '
! if(nhard.ge.0) then
if(nhard.ge.0 .and. nhard.le.42 .and. nsoft.le.32 .and. &
(nhard+nsoft).le.73) then
call unpackmsg(dat4,msg) !Unpack the user message
if(msg.eq.'VK7MO K1JT FN20 ') then
ngood=ngood+1
do k=0,62
j=indx(k)
i=(62-j)
p1=mrprob(i)/255.0 + 1.e-10
p2=mr2prob(i)/255.0
ii=k/8
jj=7.9999*p2/p1
ns(ii,jj)=ns(ii,jj)+1
if(correct(j).eq.mrsym(i)) then
np1(ii,jj)=np1(ii,jj)+1
else
np0(ii,jj)=np0(ii,jj)+1
endif
if(correct(j).eq.mr2sym(i)) np2(ii,jj)=np2(ii,jj)+1
enddo
else
nbad=nbad+1
endif
endif
fgood=float(ngood)/ndone
fbad=float(nbad)/ndone
nboth=nhard+nsoft
if(nhard.lt.0) then
nsoft=99
nera=99
nboth=99
endif
write(*,1010) ndone,fgood,fbad,ncandidates,nhard,nsoft,nera,nboth, &
ntry,tt,msg
write(32,1010) ndone,fgood,fbad,ncandidates,nhard,nsoft,nera,nboth, &
ntry,tt,msg
1010 format(i4,2f7.3,i7,4i3,i8,f8.1,1x,a22)
flush(32)
if(msg.eq.'VK7MO K1JT FN20 ') then
write(33,1012) ndone,ngood,nbad,ntry,log10(float(1+ntry))
1012 format(4i8,f8.3)
flush(33)
endif
rewind 40
write(40,1080)
1080 format('Totals:')
write(40,1090) ns
1090 format(8i7)
write(40,1091)
1091 format(/'error:')
write(40,1090) np0
write(40,1092)
1092 format(/'sym = mrsym:')
write(40,1090) np1
write(40,1093)
1093 format(/'sym = mr2sym:')
write(40,1090) np2
write(40,1095)
1095 format(/'Probability of error:')
perr=nint(100.0*float(np0)/(ns+0.001))
write(40,1096) perr
1096 format(8i7)
write(40,1097)
1097 format(/'P(mr2 correct | mr not correct) :')
pmr2=nint(100.0*float(np2)/(np0+0.001))
write(40,1096) pmr2
flush(40)
return
end subroutine extract2