1subroutine extract(s3,nadd,ncount,nhist,decoded,ltext)
2
3  use packjt
4  use timer_module, only: timer
5  real s3(64,63)
6  character decoded*22
7  integer dat4(12)
8  integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
9  logical first,ltext
10  integer correct(63),itmp(63)
11  integer param(0:8)
12  integer h0(0:11),d0(0:11)
13  real r0(0:11)
14  common/test001/s3a(64,63),mrs(63),mrs2(63)        !### TEST ONLY ###
15
16!          0  1  2  3  4  5  6  7  8  9 10 11
17  data h0/41,42,43,43,44,45,46,47,48,48,49,49/
18  data d0/71,72,73,74,76,77,78,80,81,82,83,83/
19!            0    1    2    3    4    5    6    7    8    9   10   11
20  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/
21
22  data first/.true./,nsec1/0/
23  save
24
25  nfail=0
26  call pctile(s3,4032,50,base)     ! ### or, use ave from demod64a
27  s3=s3/base
28  s3a=s3
291 call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
30!  if(ntest.lt.50 .or. nlow.gt.20) then
31!     ncount=-999                         !Flag bad data
32!     go to 900
33!  endif
34  call chkhist(mrsym,nhist,ipk)
35
36  if(nhist.ge.20) then
37     nfail=nfail+1
38     call pctile(s3,4032,50,base)     ! ### or, use ave from demod64a
39     s3(ipk,1:63)=base
40     if(nfail.gt.30) then
41        decoded='                      '
42        ncount=-1
43        go to 900
44     endif
45     go to 1
46  endif
47
48  mrs=mrsym
49  mrs2=mr2sym
50
51  call graycode(mrsym,63,-1)
52  call interleave63(mrsym,-1)
53  call interleave63(mrprob,-1)
54
55  call graycode(mr2sym,63,-1)
56  call interleave63(mr2sym,-1)
57  call interleave63(mr2prob,-1)
58
59  ntrials=10000
60  naggressive=10
61
62  ntry=0
63  param=0
64
65  call timer('ftrsd   ',0)
66  call ftrsd2(mrsym,mrprob,mr2sym,mr2prob,ntrials,correct,param,ntry)
67  call timer('ftrsd   ',1)
68  ncandidates=param(0)
69  nhard=param(1)
70  nsoft=param(2)
71  nerased=param(3)
72  rtt=0.001*param(4)
73  ntotal=param(5)
74  qual=0.001*param(7)
75  nd0=81
76  r00=0.87
77  if(naggressive.eq.10) then
78     nd0=83
79     r00=0.90
80  endif
81  if(ntotal.le.nd0 .and. rtt.le.r00) nft=1
82  n=naggressive
83  if(nhard.gt.50) nft=0
84  if(nhard.gt.h0(n)) nft=0
85  if(ntotal.gt.d0(n)) nft=0
86  if(rtt.gt.r0(n)) nft=0
87
88  ncount=-1
89  decoded='                      '
90  ltext=.false.
91  if(nft.gt.0) then
92! Turn the corrected symbol array into channel symbols for subtraction;
93! pass it back to jt65a via common block "chansyms65".
94     do i=1,12
95        dat4(i)=correct(13-i)
96     enddo
97     do i=1,63
98       itmp(i)=correct(64-i)
99     enddo
100     correct(1:63)=itmp(1:63)
101     call interleave63(correct,1)
102     call graycode65(correct,63,1)
103     call unpackmsg(dat4,decoded)     !Unpack the user message
104     ncount=0
105     if(iand(dat4(10),8).ne.0) ltext=.true.
106  endif
107900 continue
108  if(nft.eq.1 .and. nhard.lt.0) decoded='                      '
109!  write(81,3001) naggressive,ncandidates,nhard,ntotal,rtt,qual,decoded
110!3001 format(i2,i6,i3,i4,2f8.2,2x,a22)
111
112  return
113end subroutine extract
114
115subroutine getpp(workdat,p)
116
117  integer workdat(63)
118  integer a(63)
119  common/test001/s3a(64,63),mrs(63),mrs2(63)
120
121  a(1:63)=workdat(63:1:-1)
122  call interleave63(a,1)
123  call graycode(a,63,1)
124
125  psum=0.
126  do j=1,63
127     i=a(j)+1
128     x=s3a(i,j)
129     s3a(i,j)=0.
130     psum=psum + x
131     s3a(i,j)=x
132  enddo
133  p=psum/63.0
134
135  return
136end subroutine getpp
137