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