Initial Commit

.svn/pristine/75/753158fabfdb6b3e04094b86d1be8ba93e9008fa.svn-base

@@ -0,0 +1,145 @@
+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