SVN r8748
This commit is contained in:
Jordan Sherer
@@ -1,58 +0,0 @@
|
||||
subroutine afc65b(cx,npts,fsample,nflip,a,ccfbest,dtbest)
|
||||
|
||||
! Find delta f, f1, f2 ==> a(1:3)
|
||||
|
||||
complex cx(npts)
|
||||
real a(5),deltaa(5)
|
||||
|
||||
a(1)=0.
|
||||
a(2)=0.
|
||||
a(3)=0.
|
||||
a(4)=0.
|
||||
deltaa(1)=2.0
|
||||
deltaa(2)=2.0
|
||||
deltaa(3)=1.0
|
||||
nterms=2 !Maybe 2 is enough?
|
||||
|
||||
! Start the iteration
|
||||
chisqr=0.
|
||||
chisqr0=1.e6
|
||||
do iter=1,3 !One iteration is enough?
|
||||
do j=1,nterms
|
||||
chisq1=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax)
|
||||
fn=0.
|
||||
delta=deltaa(j)
|
||||
10 a(j)=a(j)+delta
|
||||
chisq2=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax)
|
||||
if(chisq2.eq.chisq1) go to 10
|
||||
if(chisq2.gt.chisq1) then
|
||||
delta=-delta !Reverse direction
|
||||
a(j)=a(j)+delta
|
||||
tmp=chisq1
|
||||
chisq1=chisq2
|
||||
chisq2=tmp
|
||||
endif
|
||||
20 fn=fn+1.0
|
||||
a(j)=a(j)+delta
|
||||
chisq3=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax)
|
||||
if(chisq3.lt.chisq2) then
|
||||
chisq1=chisq2
|
||||
chisq2=chisq3
|
||||
go to 20
|
||||
endif
|
||||
|
||||
! Find minimum of parabola defined by last three points
|
||||
delta=delta*(1./(1.+(chisq1-chisq2)/(chisq3-chisq2))+0.5)
|
||||
a(j)=a(j)-delta
|
||||
deltaa(j)=deltaa(j)*fn/3.
|
||||
enddo
|
||||
chisqr=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax)
|
||||
if(chisqr/chisqr0.gt.0.9999) go to 30
|
||||
chisqr0=chisqr
|
||||
enddo
|
||||
|
||||
30 ccfbest=ccfmax * (1378.125/fsample)**2
|
||||
dtbest=dtmax
|
||||
|
||||
return
|
||||
end subroutine afc65b
|
||||
@@ -1,39 +0,0 @@
|
||||
# Compilers
|
||||
CC = gcc
|
||||
CXX = g++
|
||||
FC = gfortran
|
||||
AR = ar cr
|
||||
RANLIB = ranlib
|
||||
MKDIR = mkdir -p
|
||||
CP = cp
|
||||
RM = rm -f
|
||||
|
||||
FFLAGS = -O2 -fbounds-check -Wall -Wno-conversion
|
||||
CFLAGS = -O2 -I.
|
||||
|
||||
# Default rules
|
||||
%.o: %.c
|
||||
${CC} ${CFLAGS} -c $<
|
||||
%.o: %.f
|
||||
${FC} ${FFLAGS} -c $<
|
||||
%.o: %.F
|
||||
${FC} ${FFLAGS} -c $<
|
||||
%.o: %.f90
|
||||
${FC} ${FFLAGS} -c $<
|
||||
%.o: %.F90
|
||||
${FC} ${FFLAGS} -c $<
|
||||
|
||||
all: ldpcsim
|
||||
|
||||
OBJS = ldpcsim.o alloc.o rcode.o dec.o enc.o \
|
||||
intio.o blockio.o check.o open.o mod2dense.o \
|
||||
mod2sparse.o mod2convert.o distrib.o rand.o gran.o
|
||||
|
||||
ldpcsim:$(OBJS)
|
||||
$(FC) -o ldpcsim $(OBJS)
|
||||
|
||||
rand.o:
|
||||
$(CC) $(CFLAGS) -DRAND_FILE=\"./randfile\" -c rand.c
|
||||
|
||||
clean:
|
||||
$(RM) *.o msksim
|
||||
@@ -0,0 +1,37 @@
|
||||
subroutine compress(c)
|
||||
|
||||
parameter (NMAX=15*12000) !Samples in iwave (180,000)
|
||||
complex c(0:NMAX-1)
|
||||
real xr(0:NMAX-1),xi(0:NMAX-1)
|
||||
|
||||
xr=real(c)
|
||||
call wavestats(xr,NMAX,rms,pk,pwr_pk,pwr_ave)
|
||||
xr=xr/rms
|
||||
xi=aimag(c)/rms
|
||||
|
||||
do i=0,NMAX-1
|
||||
c(i)=rms*cmplx(h1(xr(i)),h1(xi(i)))
|
||||
enddo
|
||||
|
||||
! par=pwr_pk/pwr_ave
|
||||
! write(*,1010) 5,rms,pk,pwr_pk,pwr_ave,par
|
||||
!1010 format(i3,2f10.3,3f10.2)
|
||||
! call wavestats(xi,NMAX,rms,pk,pwr_pk,pwr_ave)
|
||||
! par=pwr_pk/pwr_ave
|
||||
! write(*,1010) 5,rms,pk,pwr_pk,pwr_ave,par
|
||||
|
||||
return
|
||||
end subroutine compress
|
||||
|
||||
subroutine wavestats(x,kz,rms,pk,pwr_pk,pwr_ave)
|
||||
|
||||
real x(kz)
|
||||
|
||||
sumsq=dot_product(x,x)
|
||||
rms=sqrt(sumsq/kz)
|
||||
pk=max(maxval(x),-minval(x))
|
||||
pwr_pk=pk*pk
|
||||
pwr_ave=sumsq/kz
|
||||
|
||||
return
|
||||
end subroutine wavestats
|
||||
@@ -0,0 +1,29 @@
|
||||
include::./links.adoc[]
|
||||
_{prog}_ is free software: you may redistribute and/or modify it
|
||||
under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
_{prog}_ is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this documentation. If not, see {gnu_gpl}.
|
||||
|
||||
Except where otherwise noted, all algorithms, protocol designs, source
|
||||
code, and supporting files contained in the _{prog}_ package are the
|
||||
intellectual property of the program's authors. The authors assert
|
||||
*Copyright ownership* of this material, whether or not such copyright
|
||||
notice appears in each individual file. Others who make fair use of
|
||||
our work under terms of the GNU General Public License must display
|
||||
the following copyright notice prominently:
|
||||
|
||||
*The algorithms, source code, look-and-feel of _{prog}_ and related
|
||||
programs, and protocol specifications for the modes FSK441, FT8, JT4,
|
||||
JT6M, JT9, JT65, JTMS, QRA64, ISCAT, and MSK144 are Copyright (C)
|
||||
2001-2018 by one or more of the following authors: Joseph Taylor,
|
||||
K1JT; Bill Somerville, G4WJS; Steven Franke, K9AN; Nico Palermo,
|
||||
IV3NWV; Greg Beam, KI7MT; Michael Black, W9MDB; Edson Pereira, PY2SDR;
|
||||
Philip Karn, KA9Q; and other members of the WSJT Development Group.*
|
||||
@@ -1,217 +0,0 @@
|
||||
/* RCODE.C - Procedures to read parity check and generator matrices. */
|
||||
|
||||
/* Copyright (c) 1995-2012 by Radford M. Neal.
|
||||
*
|
||||
* Permission is granted for anyone to copy, use, modify, and distribute
|
||||
* these programs and accompanying documents for any purpose, provided
|
||||
* this copyright notice is retained and prominently displayed, and note
|
||||
* is made of any changes made to these programs. These programs and
|
||||
* documents are distributed without any warranty, express or implied.
|
||||
* As the programs were written for research purposes only, they have not
|
||||
* been tested to the degree that would be advisable in any important
|
||||
* application. All use of these programs is entirely at the user's own
|
||||
* risk.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <math.h>
|
||||
|
||||
#include "alloc.h"
|
||||
#include "intio.h"
|
||||
#include "open.h"
|
||||
#include "mod2sparse.h"
|
||||
#include "mod2dense.h"
|
||||
#include "mod2convert.h"
|
||||
#include "rcode.h"
|
||||
|
||||
|
||||
/* VARIABLES DECLARED IN RCODE.H. These global variables are set to
|
||||
representations of the parity check and generator matrices by read_pchk
|
||||
and read_gen. */
|
||||
|
||||
mod2sparse *H; /* Parity check matrix */
|
||||
|
||||
int M; /* Number of rows in parity check matrix */
|
||||
int N; /* Number of columns in parity check matrix */
|
||||
|
||||
char type; /* Type of generator matrix representation (s/d/m) */
|
||||
int *cols; /* Ordering of columns in generator matrix */
|
||||
|
||||
mod2sparse *L, *U; /* Sparse LU decomposition, if type=='s' */
|
||||
int *rows; /* Ordering of rows in generator matrix (type 's') */
|
||||
|
||||
mod2dense *G; /* Dense or mixed representation of generator matrix,
|
||||
if type=='d' or type=='m' */
|
||||
|
||||
|
||||
/* READ PARITY CHECK MATRIX. Sets the H, M, and N global variables. If an
|
||||
error is encountered, a message is displayed on standard error, and the
|
||||
program is terminated. */
|
||||
|
||||
void read_pchk
|
||||
( char *pchk_file
|
||||
)
|
||||
{
|
||||
FILE *f;
|
||||
|
||||
f = open_file_std(pchk_file,"rb");
|
||||
if (f==NULL)
|
||||
{ fprintf(stderr,"Can't open parity check file: %s\n",pchk_file);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
if (intio_read(f)!=('P'<<8)+0x80)
|
||||
{ fprintf(stderr,"File %s doesn't contain a parity check matrix\n",pchk_file);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
H = mod2sparse_read(f);
|
||||
|
||||
if (H==0)
|
||||
{ fprintf(stderr,"Error reading parity check matrix from %s\n",pchk_file);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
M = mod2sparse_rows(H);
|
||||
N = mod2sparse_cols(H);
|
||||
|
||||
fclose(f);
|
||||
}
|
||||
|
||||
|
||||
/* READ GENERATOR MATRIX. The parity check matrix must have already been
|
||||
read, unless the last argument is set to 1. The generator matrix must be
|
||||
compatible with the parity check matrix, if it has been read. If the
|
||||
second argument is 1, only the column ordering (the last N-M of which are
|
||||
the indexes of the message bits) is read, into the 'cols' global variable.
|
||||
Otherwise, everything is read, into the global variables appropriate
|
||||
to the representation. The 'type' global variable is set to a letter
|
||||
indicating which represention is used.
|
||||
|
||||
If an error is encountered, a message is displayed on standard error,
|
||||
and the program is terminated. */
|
||||
|
||||
void read_gen
|
||||
( char *gen_file, /* Name of generator matrix file */
|
||||
int cols_only, /* Read only column ordering? */
|
||||
int no_pchk_file /* No parity check file used? */
|
||||
)
|
||||
{
|
||||
int M2, N2;
|
||||
FILE *f;
|
||||
int i;
|
||||
|
||||
f = open_file_std(gen_file,"rb");
|
||||
if (f==NULL)
|
||||
{ fprintf(stderr,"Can't open generator matrix file: %s\n",gen_file);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
if (intio_read(f)!=('G'<<8)+0x80)
|
||||
{ fprintf(stderr,"File %s doesn't contain a generator matrix\n",gen_file);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
if (fread (&type, 1, 1, f) != 1) goto error;
|
||||
|
||||
M2 = intio_read(f);
|
||||
N2 = intio_read(f);
|
||||
|
||||
if (feof(f) || ferror(f)) goto error;
|
||||
|
||||
if (no_pchk_file)
|
||||
{ M = M2;
|
||||
N = N2;
|
||||
}
|
||||
else
|
||||
{ if (M2!=M || N2!=N)
|
||||
{ fprintf(stderr,
|
||||
"Generator matrix and parity-check matrix are incompatible\n");
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
cols = chk_alloc (N, sizeof *cols);
|
||||
rows = chk_alloc (M, sizeof *rows);
|
||||
|
||||
for (i = 0; i<N; i++)
|
||||
{ cols[i] = intio_read(f);
|
||||
if (feof(f) || ferror(f)) goto error;
|
||||
}
|
||||
|
||||
if (!cols_only)
|
||||
{
|
||||
switch (type)
|
||||
{
|
||||
case 's':
|
||||
{
|
||||
for (i = 0; i<M; i++)
|
||||
{ rows[i] = intio_read(f);
|
||||
if (feof(f) || ferror(f)) goto error;
|
||||
}
|
||||
|
||||
if ((L = mod2sparse_read(f)) == 0) goto error;
|
||||
if ((U = mod2sparse_read(f)) == 0) goto error;
|
||||
|
||||
if (mod2sparse_rows(L)!=M || mod2sparse_cols(L)!=M) goto garbled;
|
||||
if (mod2sparse_rows(U)!=M || mod2sparse_cols(U)<M) goto garbled;
|
||||
|
||||
break;
|
||||
}
|
||||
|
||||
case 'd':
|
||||
{
|
||||
if ((G = mod2dense_read(f)) == 0) goto error;
|
||||
|
||||
if (mod2dense_rows(G)!=M || mod2dense_cols(G)!=N-M) goto garbled;
|
||||
|
||||
break;
|
||||
}
|
||||
|
||||
case 'm':
|
||||
{
|
||||
if ((G = mod2dense_read(f)) == 0) goto error;
|
||||
|
||||
if (mod2dense_rows(G)!=M || mod2dense_cols(G)!=M) goto garbled;
|
||||
|
||||
break;
|
||||
}
|
||||
|
||||
default:
|
||||
{ fprintf(stderr,
|
||||
"Unknown type of generator matrix in file %s\n",gen_file);
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
fclose(f);
|
||||
|
||||
return;
|
||||
|
||||
error:
|
||||
fprintf(stderr,"Error reading generator matrix from file %s\n",gen_file);
|
||||
exit(1);
|
||||
|
||||
garbled:
|
||||
fprintf(stderr,"Garbled generator matrix in file %s\n",gen_file);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
// Fortran interface routines for WSJT-X
|
||||
void init_ldpc_ (char *pfile, char *gfile )
|
||||
{
|
||||
read_pchk( pfile );
|
||||
read_gen( gfile, 0, 0 );
|
||||
}
|
||||
|
||||
void fini_ldpc_ ()
|
||||
{
|
||||
mod2dense_free (G);
|
||||
mod2sparse_free (U);
|
||||
mod2sparse_free (L);
|
||||
free (cols);
|
||||
free (rows);
|
||||
mod2sparse_free (H);
|
||||
}
|
||||
@@ -0,0 +1,149 @@
|
||||
@import url("doc/src/boostbook.css");
|
||||
@import url("doc/src/docutils.css");
|
||||
/* Copyright David Abrahams 2006. Distributed under the Boost
|
||||
Software License, Version 1.0. (See accompanying
|
||||
file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
|
||||
*/
|
||||
|
||||
dl.docutils dt {
|
||||
font-weight: bold }
|
||||
|
||||
img.boost-logo {
|
||||
border: none;
|
||||
vertical-align: middle
|
||||
}
|
||||
|
||||
pre.literal-block span.concept {
|
||||
font-style: italic;
|
||||
}
|
||||
|
||||
.nav {
|
||||
display: inline;
|
||||
list-style-type: none;
|
||||
}
|
||||
|
||||
.prevpage {
|
||||
padding-top: -5px;
|
||||
text-align: left;
|
||||
float: left;
|
||||
}
|
||||
|
||||
.nextpage {
|
||||
padding-top: -20px;
|
||||
text-align: right;
|
||||
float: right;
|
||||
}
|
||||
|
||||
div.small {
|
||||
font-size: smaller }
|
||||
|
||||
h2 a {
|
||||
font-size: 90%;
|
||||
}
|
||||
h3 a {
|
||||
font-size: 80%;
|
||||
}
|
||||
h4 a {
|
||||
font-size: 70%;
|
||||
}
|
||||
h5 a {
|
||||
font-size: 60%;
|
||||
}
|
||||
|
||||
dl,table
|
||||
{
|
||||
text-align: left;
|
||||
font-size: 10pt;
|
||||
line-height: 1.15;
|
||||
}
|
||||
|
||||
|
||||
/*=============================================================================
|
||||
Tables
|
||||
=============================================================================*/
|
||||
|
||||
/* The only clue docutils gives us that tables are logically tables,
|
||||
and not, e.g., footnotes, is that they have border="1". Therefore
|
||||
we're keying off of that. We used to manually patch docutils to
|
||||
add a "table" class to all logical tables, but that proved much too
|
||||
fragile.
|
||||
*/
|
||||
|
||||
table[border="1"]
|
||||
{
|
||||
width: 92%;
|
||||
margin-left: 4%;
|
||||
margin-right: 4%;
|
||||
}
|
||||
|
||||
table[border="1"]
|
||||
{
|
||||
padding: 4px;
|
||||
}
|
||||
|
||||
/* Table Cells */
|
||||
table[border="1"] tr td
|
||||
{
|
||||
padding: 0.5em;
|
||||
text-align: left;
|
||||
font-size: 9pt;
|
||||
}
|
||||
|
||||
table[border="1"] tr th
|
||||
{
|
||||
padding: 0.5em 0.5em 0.5em 0.5em;
|
||||
border: 1pt solid white;
|
||||
font-size: 80%;
|
||||
}
|
||||
|
||||
@media screen
|
||||
{
|
||||
|
||||
/* Tables */
|
||||
table[border="1"] tr td
|
||||
{
|
||||
border: 1px solid #DCDCDC;
|
||||
}
|
||||
|
||||
table[border="1"] tr th
|
||||
{
|
||||
background-color: #F0F0F0;
|
||||
border: 1px solid #DCDCDC;
|
||||
}
|
||||
|
||||
pre,
|
||||
.screen
|
||||
{
|
||||
border: 1px solid #DCDCDC;
|
||||
}
|
||||
|
||||
td pre
|
||||
td .screen
|
||||
{
|
||||
border: 0px
|
||||
}
|
||||
|
||||
.sidebar pre
|
||||
{
|
||||
border: 0px
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
pre,
|
||||
.screen
|
||||
{
|
||||
font-size: 9pt;
|
||||
display: block;
|
||||
margin: 1pc 4% 0pc 4%;
|
||||
padding: 0.5pc 0.5pc 0.5pc 0.5pc;
|
||||
}
|
||||
|
||||
/* Program listings in tables don't get borders */
|
||||
td pre,
|
||||
td .screen
|
||||
{
|
||||
margin: 0pc 0pc 0pc 0pc;
|
||||
padding: 0pc 0pc 0pc 0pc;
|
||||
}
|
||||
|
||||
@@ -1,19 +0,0 @@
|
||||
/* BLOCKIO.H - Interface to block input/output routines. */
|
||||
|
||||
/* Copyright (c) 1995-2012 by Radford M. Neal.
|
||||
*
|
||||
* Permission is granted for anyone to copy, use, modify, and distribute
|
||||
* these programs and accompanying documents for any purpose, provided
|
||||
* this copyright notice is retained and prominently displayed, and note
|
||||
* is made of any changes made to these programs. These programs and
|
||||
* documents are distributed without any warranty, express or implied.
|
||||
* As the programs were written for research purposes only, they have not
|
||||
* been tested to the degree that would be advisable in any important
|
||||
* application. All use of these programs is entirely at the user's own
|
||||
* risk.
|
||||
*/
|
||||
|
||||
extern int blockio_flush; /* Should blocks written be immediately flushed? */
|
||||
|
||||
int blockio_read (FILE *, char *, int);
|
||||
void blockio_write (FILE *, char *, int);
|
||||
@@ -0,0 +1,245 @@
|
||||
subroutine extract(s3,nadd,mode65,ntrials,naggressive,ndepth,nflip, &
|
||||
mycall_12,hiscall_12,hisgrid,nQSOProgress,ljt65apon, &
|
||||
nexp_decode,ncount, &
|
||||
nhist,decoded,ltext,nft,qual)
|
||||
|
||||
! Input:
|
||||
! s3 64-point spectra for each of 63 data symbols
|
||||
! nadd number of spectra summed into s3
|
||||
! nqd 0/1 to indicate decode attempt at QSO frequency
|
||||
|
||||
! Output:
|
||||
! ncount number of symbols requiring correction (-1 for no KV decode)
|
||||
! nhist maximum number of identical symbol values
|
||||
! decoded decoded message (if ncount >=0)
|
||||
! ltext true if decoded message is free text
|
||||
! nft 0=no decode; 1=FT decode; 2=hinted decode
|
||||
|
||||
use prog_args !shm_key, exe_dir, data_dir
|
||||
use packjt
|
||||
use jt65_mod
|
||||
use timer_module, only: timer
|
||||
|
||||
real s3(64,63)
|
||||
character decoded*22, apmessage*22
|
||||
character*12 mycall_12,hiscall_12
|
||||
character*6 mycall,hiscall,hisgrid
|
||||
character*6 mycall0,hiscall0,hisgrid0
|
||||
integer apsymbols(7,12),ap(12)
|
||||
integer nappasses(0:5) ! the number of decoding passes to use for each QSO state
|
||||
integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now
|
||||
integer dat4(12)
|
||||
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
|
||||
integer correct(63),tmp(63)
|
||||
logical first,ltext,ljt65apon
|
||||
common/chansyms65/correct
|
||||
data first/.true./
|
||||
save
|
||||
|
||||
if(mode65.eq.-99) stop !Silence compiler warning
|
||||
if(first) then
|
||||
|
||||
! aptype
|
||||
!------------------------
|
||||
! 1 CQ ??? ???
|
||||
! 2 MyCall ??? ???
|
||||
! 3 MyCall DxCall ???
|
||||
! 4 MyCall DxCall RRR
|
||||
! 5 MyCall DxCall 73
|
||||
! 6 MyCall DxCall DxGrid
|
||||
! 7 CQ DxCall DxGrid
|
||||
|
||||
apsymbols=-1
|
||||
nappasses=(/3,4,2,3,3,4/)
|
||||
naptypes(0,1:4)=(/1,2,6,0/) ! Tx6
|
||||
naptypes(1,1:4)=(/2,3,6,7/) ! Tx1
|
||||
naptypes(2,1:4)=(/2,3,0,0/) ! Tx2
|
||||
naptypes(3,1:4)=(/3,4,5,0/) ! Tx3
|
||||
naptypes(4,1:4)=(/3,4,5,0/) ! Tx4
|
||||
naptypes(5,1:4)=(/2,3,4,5/) ! Tx5
|
||||
first=.false.
|
||||
endif
|
||||
|
||||
mycall=mycall_12(1:6)
|
||||
hiscall=hiscall_12(1:6)
|
||||
! Fill apsymbols array
|
||||
if(ljt65apon .and. &
|
||||
(mycall.ne.mycall0 .or. hiscall.ne.hiscall0 .or. hisgrid.ne.hisgrid0)) then
|
||||
!write(*,*) 'initializing apsymbols '
|
||||
apsymbols=-1
|
||||
mycall0=mycall
|
||||
hiscall0=hiscall
|
||||
ap=-1
|
||||
apsymbols(1,1:4)=(/62,32,32,49/) ! CQ
|
||||
if(len_trim(mycall).gt.0) then
|
||||
apmessage=mycall//" "//mycall//" RRR"
|
||||
call packmsg(apmessage,ap,itype,.false.)
|
||||
if(itype.ne.1) ap=-1
|
||||
apsymbols(2,1:4)=ap(1:4)
|
||||
!write(*,*) 'mycall symbols ',ap(1:4)
|
||||
if(len_trim(hiscall).gt.0) then
|
||||
apmessage=mycall//" "//hiscall//" RRR"
|
||||
call packmsg(apmessage,ap,itype,.false.)
|
||||
if(itype.ne.1) ap=-1
|
||||
apsymbols(3,1:9)=ap(1:9)
|
||||
apsymbols(4,:)=ap
|
||||
apmessage=mycall//" "//hiscall//" 73"
|
||||
call packmsg(apmessage,ap,itype,.false.)
|
||||
if(itype.ne.1) ap=-1
|
||||
apsymbols(5,:)=ap
|
||||
if(len_trim(hisgrid(1:4)).gt.0) then
|
||||
apmessage=mycall//' '//hiscall//' '//hisgrid(1:4)
|
||||
call packmsg(apmessage,ap,itype,.false.)
|
||||
if(itype.ne.1) ap=-1
|
||||
apsymbols(6,:)=ap
|
||||
apmessage='CQ'//' '//hiscall//' '//hisgrid(1:4)
|
||||
call packmsg(apmessage,ap,itype,.false.)
|
||||
if(itype.ne.1) ap=-1
|
||||
apsymbols(7,:)=ap
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
||||
qual=0.
|
||||
nbirdie=20
|
||||
npct=50
|
||||
afac1=1.1
|
||||
nft=0
|
||||
nfail=0
|
||||
decoded=' '
|
||||
call pctile(s3,4032,npct,base)
|
||||
s3=s3/base
|
||||
s3a=s3 !###
|
||||
|
||||
! Get most reliable and second-most-reliable symbol values, and their
|
||||
! probabilities
|
||||
1 call demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
|
||||
|
||||
call chkhist(mrsym,nhist,ipk) !Test for birdies and QRM
|
||||
if(nhist.ge.nbirdie) then
|
||||
nfail=nfail+1
|
||||
call pctile(s3,4032,npct,base)
|
||||
s3(ipk,1:63)=base
|
||||
if(nfail.gt.30) then
|
||||
decoded=' '
|
||||
ncount=-1
|
||||
go to 900
|
||||
endif
|
||||
go to 1
|
||||
endif
|
||||
|
||||
mrs=mrsym
|
||||
mrs2=mr2sym
|
||||
|
||||
call graycode65(mrsym,63,-1) !Remove gray code
|
||||
call interleave63(mrsym,-1) !Remove interleaving
|
||||
call interleave63(mrprob,-1)
|
||||
|
||||
call graycode65(mr2sym,63,-1) !Remove gray code and interleaving
|
||||
call interleave63(mr2sym,-1) !from second-most-reliable symbols
|
||||
call interleave63(mr2prob,-1)
|
||||
|
||||
npass=1 ! if ap decoding is disabled
|
||||
if(ljt65apon .and. len_trim(mycall).gt.0) then
|
||||
npass=1+nappasses(nQSOProgress)
|
||||
!write(*,*) 'ap is on: ',npass-1,'ap passes of types ',naptypes(nQSOProgress,:)
|
||||
endif
|
||||
do ipass=1,npass
|
||||
ap=-1
|
||||
ntype=0
|
||||
if(ipass.gt.1) then
|
||||
ntype=naptypes(nQSOProgress,ipass-1)
|
||||
!write(*,*) 'ap pass, type ',ntype
|
||||
ap=apsymbols(ntype,:)
|
||||
if(count(ap.ge.0).eq.0) cycle ! don't bother if all ap symbols are -1
|
||||
!write(*,'(12i3)') ap
|
||||
endif
|
||||
ntry=0
|
||||
call timer('ftrsd ',0)
|
||||
param=0
|
||||
call ftrsdap(mrsym,mrprob,mr2sym,mr2prob,ap,ntrials,correct,param,ntry)
|
||||
call timer('ftrsd ',1)
|
||||
ncandidates=param(0)
|
||||
nhard=param(1)
|
||||
nsoft=param(2)
|
||||
nerased=param(3)
|
||||
rtt=0.001*param(4)
|
||||
ntotal=param(5)
|
||||
qual=0.001*param(7)
|
||||
nd0=81
|
||||
r0=0.87
|
||||
if(naggressive.eq.10) then
|
||||
nd0=83
|
||||
r0=0.90
|
||||
endif
|
||||
|
||||
if(ntotal.le.nd0 .and. rtt.le.r0) then
|
||||
nft=1+ishft(ntype,2)
|
||||
endif
|
||||
|
||||
if(nft.gt.0) exit
|
||||
enddo
|
||||
!write(*,*) nft
|
||||
if(nft.eq.0 .and. iand(ndepth,32).eq.32) then
|
||||
qmin=2.0 - 0.1*naggressive
|
||||
call timer('hint65 ',0)
|
||||
call hint65(s3,mrs,mrs2,nadd,nflip,mycall,hiscall,hisgrid,qual,decoded)
|
||||
if(qual.ge.qmin) then
|
||||
nft=2
|
||||
ncount=0
|
||||
else
|
||||
decoded=' '
|
||||
ntry=0
|
||||
endif
|
||||
call timer('hint65 ',1)
|
||||
go to 900
|
||||
endif
|
||||
|
||||
ncount=-1
|
||||
decoded=' '
|
||||
ltext=.false.
|
||||
if(nft.gt.0) then
|
||||
! Turn the corrected symbol array into channel symbols for subtraction;
|
||||
! pass it back to jt65a via common block "chansyms65".
|
||||
do i=1,12
|
||||
dat4(i)=correct(13-i)
|
||||
enddo
|
||||
do i=1,63
|
||||
tmp(i)=correct(64-i)
|
||||
enddo
|
||||
correct(1:63)=tmp(1:63)
|
||||
call interleave63(correct,63,1)
|
||||
call graycode65(correct,63,1)
|
||||
call unpackmsg(dat4,decoded,.false.,' ') !Unpack the user message
|
||||
ncount=0
|
||||
if(iand(dat4(10),8).ne.0) ltext=.true.
|
||||
endif
|
||||
900 continue
|
||||
if(nft.eq.1 .and. nhard.lt.0) decoded=' '
|
||||
|
||||
return
|
||||
end subroutine extract
|
||||
|
||||
subroutine getpp(workdat,p)
|
||||
|
||||
use jt65_mod
|
||||
integer workdat(63)
|
||||
integer a(63)
|
||||
|
||||
a(1:63)=workdat(63:1:-1)
|
||||
call interleave63(a,1)
|
||||
call graycode(a,63,1,a)
|
||||
|
||||
psum=0.
|
||||
do j=1,63
|
||||
i=a(j)+1
|
||||
x=s3a(i,j)
|
||||
s3a(i,j)=0.
|
||||
psum=psum + x
|
||||
s3a(i,j)=x
|
||||
enddo
|
||||
p=psum/63.0
|
||||
|
||||
return
|
||||
end subroutine getpp
|
||||
Reference in New Issue
Block a user