2007-07-10 16:57:29 +00:00
|
|
|
subroutine extract(s3,nadd,ncount,nhist,decoded,ltext)
|
2006-09-06 18:09:05 +00:00
|
|
|
|
|
|
|
|
real s3(64,63)
|
2007-01-11 21:25:52 +00:00
|
|
|
real tmp(4032)
|
2006-09-06 18:09:05 +00:00
|
|
|
character decoded*22
|
2007-01-11 21:25:52 +00:00
|
|
|
integer era(51),dat4(12),indx(64)
|
2006-09-06 18:09:05 +00:00
|
|
|
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
|
2007-07-10 16:57:29 +00:00
|
|
|
logical first,ltext
|
2006-09-06 18:09:05 +00:00
|
|
|
data first/.true./,nsec1/0/
|
|
|
|
|
save
|
|
|
|
|
|
2007-01-11 21:25:52 +00:00
|
|
|
nfail=0
|
|
|
|
|
1 call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
|
2006-09-06 18:09:05 +00:00
|
|
|
if(ntest.lt.50 .or. nlow.gt.20) then
|
|
|
|
|
ncount=-999 !Flag bad data
|
|
|
|
|
go to 900
|
|
|
|
|
endif
|
2007-01-11 21:25:52 +00:00
|
|
|
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
|
2006-09-06 18:09:05 +00:00
|
|
|
|
|
|
|
|
call graycode(mrsym,63,-1)
|
|
|
|
|
call interleave63(mrsym,-1)
|
|
|
|
|
call interleave63(mrprob,-1)
|
|
|
|
|
|
|
|
|
|
ndec=1
|
2007-01-11 21:25:52 +00:00
|
|
|
nemax=30 !Was 200 (30)
|
2006-09-06 18:09:05 +00:00
|
|
|
maxe=8
|
2007-12-26 19:40:29 +00:00
|
|
|
xlambda=13.0 !Was 12
|
2006-09-06 18:09:05 +00:00
|
|
|
|
|
|
|
|
if(ndec.eq.1) then
|
|
|
|
|
call graycode(mr2sym,63,-1)
|
|
|
|
|
call interleave63(mr2sym,-1)
|
|
|
|
|
call interleave63(mr2prob,-1)
|
|
|
|
|
|
|
|
|
|
nsec1=nsec1+1
|
2009-07-26 16:31:11 +00:00
|
|
|
call cs_lock('extracta')
|
2006-09-06 18:09:05 +00:00
|
|
|
write(22,rec=1) nsec1,xlambda,maxe,200,
|
|
|
|
|
+ mrsym,mrprob,mr2sym,mr2prob
|
|
|
|
|
call flushqqq(22)
|
2009-07-26 16:31:11 +00:00
|
|
|
call cs_unlock
|
2006-09-06 18:09:05 +00:00
|
|
|
call runqqq('kvasd.exe','-q',iret)
|
|
|
|
|
if(iret.ne.0) then
|
2009-07-26 16:31:11 +00:00
|
|
|
call cs_lock('extractb')
|
2007-01-11 21:25:52 +00:00
|
|
|
if(first) write(*,1000) iret
|
2006-09-06 18:09:05 +00:00
|
|
|
1000 format('Error in KV decoder, or no KV decoder present.'/
|
2007-01-11 21:25:52 +00:00
|
|
|
+ 'Return code:',i8,'. Will use BM algorithm.')
|
2009-07-26 16:31:11 +00:00
|
|
|
call cs_unlock
|
2006-09-06 18:09:05 +00:00
|
|
|
ndec=0
|
|
|
|
|
first=.false.
|
|
|
|
|
go to 20
|
|
|
|
|
endif
|
|
|
|
|
read(22,rec=2) nsec2,ncount,dat4
|
|
|
|
|
decoded=' '
|
2007-07-10 16:57:29 +00:00
|
|
|
ltext=.false.
|
2006-09-06 18:09:05 +00:00
|
|
|
if(ncount.ge.0) then
|
|
|
|
|
call unpackmsg(dat4,decoded) !Unpack the user message
|
2007-07-10 16:57:29 +00:00
|
|
|
if(iand(dat4(10),8).ne.0) ltext=.true.
|
2006-09-06 18:09:05 +00:00
|
|
|
endif
|
|
|
|
|
endif
|
|
|
|
|
20 if(ndec.eq.0) then
|
|
|
|
|
call indexx(63,mrprob,indx)
|
|
|
|
|
do i=1,nemax
|
|
|
|
|
j=indx(i)
|
|
|
|
|
if(mrprob(j).gt.120) then
|
|
|
|
|
ne2=i-1
|
|
|
|
|
go to 2
|
|
|
|
|
endif
|
|
|
|
|
era(i)=j-1
|
|
|
|
|
enddo
|
|
|
|
|
ne2=nemax
|
|
|
|
|
2 decoded=' '
|
|
|
|
|
do nerase=0,ne2,2
|
|
|
|
|
call rs_decode(mrsym,era,nerase,dat4,ncount)
|
|
|
|
|
if(ncount.ge.0) then
|
|
|
|
|
call unpackmsg(dat4,decoded)
|
|
|
|
|
go to 900
|
|
|
|
|
endif
|
|
|
|
|
enddo
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
900 return
|
|
|
|
|
end
|
