Merged master 8748

This commit is contained in:
Jordan Sherer
2018-08-05 11:33:30 -04:00
parent 8f8772f1bd
commit 62899069bf
1095 changed files with 31298 additions and 367679 deletions
@@ -1,222 +0,0 @@
subroutine ft8b(dd0,nfqso,f1,xdt,nharderrors,dmin,nbadcrc,message,xsnr)
use timer_module, only: timer
include 'ft8_params.f90'
parameter(NRECENT=10,NP2=2812)
character message*22,msgsent*22
character*12 recent_calls(NRECENT)
real a(5)
real s1(0:7,ND),s2(0:7,NN)
real ps(0:7)
real rxdata(3*ND),llr(3*ND) !Soft symbols
real dd0(15*12000)
integer*1 decoded(KK),apmask(3*ND),cw(3*ND)
integer itone(NN)
integer icos7(0:6)
complex cd0(NP2)
complex csync(0:6,32)
complex ctwk(32)
complex csymb(32)
logical first
data icos7/2,5,6,0,4,1,3/
data first/.true./
save first,twopi,fs2,dt2,taus,baud,csync
if( first ) then
twopi=8.0*atan(1.0)
fs2=12000.0/64.0
dt2=1/fs2
taus=32*dt2
baud=1/taus
do i=0,6
phi=0.0
dphi=twopi*icos7(i)*baud*dt2
do j=1,32
csync(i,j)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
enddo
enddo
first=.false.
endif
max_iterations=40
norder=2
! if(abs(nfqso-f1).lt.10.0) norder=3
call timer('ft8_down',0)
call ft8_downsample(dd0,f1,cd0)
call timer('ft8_down',1)
i0=xdt*fs2
smax=0.0
do idt=i0-16,i0+16
sync=0
do i=0,6
i1=idt+i*32
i2=i1+36*32
i3=i1+72*32
term1=0.0 ! this needs to be fixed...
term2=0.0
term3=0.0
if( i1.ge.1 .and. i1+31.le.NP2 ) &
term1=abs(sum(cd0(i1:i1+31)*conjg(csync(i,1:32))))
if( i2.ge.1 .and. i2+31.le.NP2 ) &
term2=abs(sum(cd0(i2:i2+31)*conjg(csync(i,1:32))))
if( i3.ge.1 .and. i3+31.le.NP2 ) &
term3=abs(sum(cd0(i3:i3+31)*conjg(csync(i,1:32))))
sync=sync+term1+term2+term3
enddo
if( sync .gt. smax ) then
smax=sync
ibest=idt
endif
enddo
xdt2=ibest*dt2
! peak up the frequency
i0=xdt2*fs2
smax=0.0
do ifr=-5,5
delf=ifr*0.5
dphi=twopi*delf*dt2
phi=0.0
do i=1,32
ctwk(i)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
enddo
sync=0.0
do i=0,6
i1=i0+i*32
i2=i1+36*32
i3=i1+72*32
term1=0.0 ! this needs to be fixed...
term2=0.0
term3=0.0
if( i1.ge.1 .and. i1+31.le.NP2 ) &
term1=abs(sum(cd0(i1:i1+31)*conjg(ctwk*csync(i,1:32))))
if( i2.ge.1 .and. i2+31.le.NP2 ) &
term2=abs(sum(cd0(i2:i2+31)*conjg(ctwk*csync(i,1:32))))
if( i3.ge.1 .and. i3+31.le.NP2 ) &
term3=abs(sum(cd0(i3:i3+31)*conjg(ctwk*csync(i,1:32))))
sync=sync+term1+term2+term3
enddo
if( sync .gt. smax ) then
smax=sync
delfbest=delf
endif
enddo
a=0.0
a(1)=-delfbest
call twkfreq1(cd0,NP2,fs2,a,cd0)
xdt=xdt2
f1=f1+delfbest
j=0
do k=1,NN
i1=ibest+(k-1)*32
csymb=cmplx(0.0,0.0)
if( i1.ge.1 .and. i1+31 .le. NP2 ) csymb=cd0(i1:i1+31)
call four2a(csymb,32,1,-1,1)
s2(0:7,k)=abs(csymb(1:8))
enddo
j=0
do k=1,NN
if(k.le.7) cycle
if(k.ge.37 .and. k.le.43) cycle
if(k.gt.72) cycle
j=j+1
s1(0:7,j)=s2(0:7,k)
enddo
do j=1,ND
ps=s1(0:7,j)
where (ps.gt.0.0) ps=log(ps)
r1=max(ps(1),ps(3),ps(5),ps(7))-max(ps(0),ps(2),ps(4),ps(6))
r2=max(ps(2),ps(3),ps(6),ps(7))-max(ps(0),ps(1),ps(4),ps(5))
r4=max(ps(4),ps(5),ps(6),ps(7))-max(ps(0),ps(1),ps(2),ps(3))
rxdata(3*j-2)=r4
rxdata(3*j-1)=r2
rxdata(3*j)=r1
enddo
rxav=sum(rxdata)/(3.0*ND)
rx2av=sum(rxdata*rxdata)/(3.0*ND)
var=rx2av-rxav*rxav
if( var .gt. 0.0 ) then
rxsig=sqrt(var)
else
rxsig=sqrt(rx2av)
endif
rxdata=rxdata/rxsig
ss=0.84
llr=2.0*rxdata/(ss*ss)
apmask=0
cw=0
call timer('bpd174 ',0)
call bpdecode174(llr,apmask,max_iterations,decoded,cw,nharderrors)
call timer('bpd174 ',1)
dmin=0.0
if(nharderrors.lt.0) then
call timer('osd174 ',0)
call osd174(llr,norder,decoded,cw,nharderrors,dmin)
call timer('osd174 ',1)
endif
nbadcrc=1
message=' '
xsnr=-99.0
if(count(cw.eq.0).eq.174) go to 900 !Reject the all-zero codeword
if( nharderrors.ge.0 .and. dmin.le.30.0 .and. nharderrors .lt. 30) then
call chkcrc12a(decoded,nbadcrc)
else
nharderrors=-1
go to 900
endif
if(nbadcrc.eq.0) then
call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent)
call genft8(message,msgsent,itone)
xsig=0.0
xnoi=0.0
do i=1,79
xsig=xsig+s2(itone(i),i)**2
ios=mod(itone(i)+4,7)
xnoi=xnoi+s2(ios,i)**2
enddo
xsnr=0.001
if( xnoi.gt.0 .and. xnoi.lt.xsig ) xsnr=xsig/xnoi-1.0
xsnr=10.0*log10(xsnr)-27.0
if( xsnr .lt. -24.0 ) xsnr=-24.0
endif
900 continue
return
end subroutine ft8b
subroutine ft8_downsample(dd,f0,c1)
! Downconvert to complex data sampled at 187.5 Hz, 32 samples/symbol
parameter (NMAX=15*12000,NFFT2=2812)
complex c1(0:NFFT2-1)
complex cx(0:NMAX/2-1)
real dd(NMAX),x(NMAX)
equivalence (x,cx)
save x
df=12000.0/NMAX
x=dd
call four2a(x,NMAX,1,-1,0) !r2c FFT to freq domain
baud=12000.0/(32.0*64.0)
i0=nint(f0/df)
ft=f0+8.0*baud
it=min(nint(ft/df),NMAX/2-1)
fb=f0-1.0*baud
ib=max(1,nint(fb/df))
k=0
c1=cmplx(0.0,0.0)
do i=ib,it
c1(k)=cx(i)
k=k+1
enddo
c1=cshift(c1,i0-ib)
call four2a(c1,NFFT2,1,1,1) !c2c FFT back to time domain
c1=c1/(NMAX*NFFT2)
return
end subroutine ft8_downsample
@@ -1,567 +0,0 @@
/* RAND.C - Random number generation module. */
/* 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.
*/
/* Random generation routines at the end of this file are taken from the
GNU C library, see the copyright notice there. */
/* NOTE: See rand.html for documentation on these procedures. */
#include <stdlib.h>
#include <stdint.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include "rand.h"
static long int this_nrand48 (unsigned short int [3]);
/* Local version of nrand48 */
/* This module uses the 'this_nrand48' pseudo-random number generator from the
GNU C library, included below, but renamed to 'this_nrand48'. The
output of this generator is combined with a file of real random numbers.
Many of the methods used in this module may be found in the following
reference:
Devroye, L. (1986) Non-Uniform Random Variate Generation,
New York: Springer-Verlag.
The methods used here are not necessarily the fastest available. They're
selected to be reasonably fast while also being easy to write.
*/
/* CONSTANT PI. Defined here if not in <math.h>. */
#ifndef M_PI
#define M_PI 3.14159265358979323846
#endif
/* TABLES OF REAL RANDOM NUMBERS. A file of 100000 real random numbers
(NOT pseudo-random) is used in conjunction with pseudo-random numbers
for extra insurance. These are employed in the form of five tables
of 5000 32-bit integers.
The file must be located at the path given by RAND_FILE, which should
be defined on the "cc" command line. */
#define Table_size 5000 /* Number of words in each table */
static int rn[N_tables][Table_size]; /* Random number tables */
/* STATE OF RANDOM NUMBER GENERATOR. */
static int initialized = 0; /* Has module been initialized? */
static rand_state state0; /* Default state structure */
static rand_state *state; /* Pointer to current state */
/* INITIALIZE MODULE. Sets things up using the default state structure,
set as if rand_seed had been called with a seed of one. */
static void initialize (void)
{
int i, j, k, w;
char b;
FILE *f;
if (!initialized)
{
f = fopen(RAND_FILE,"rb");
if (f==NULL)
{ fprintf(stderr,"Can't open file of random numbers (%s)\n",RAND_FILE);
exit(1);
}
for (i = 0; i<N_tables; i++)
{ for (j = 0; j<Table_size; j++)
{ w = 0;
for (k = 0; k<4; k++)
{ if (fread(&b,1,1,f)!=1)
{ fprintf(stderr,"Error reading file of random numbers (%s)\n",
RAND_FILE);
exit(1);
}
w = (w<<8) | (b&0xff);
}
rn[i][j] = w;
}
}
state = &state0;
initialized = 1;
rand_seed(1);
}
}
/* SET CURRENT STATE ACCORDING TO SEED. */
void rand_seed
( int seed
)
{
int j;
if (!initialized) initialize();
state->seed = seed;
state->state48[0] = seed>>16;
state->state48[1] = seed&0xffff;
state->state48[2] = rn[0][(seed&0x7fffffff)%Table_size];
for (j = 0; j<N_tables; j++)
{ state->ptr[j] = seed%Table_size;
seed /= Table_size;
}
}
/* SET STATE STRUCTURE TO USE. */
void rand_use_state
( rand_state *st
)
{
if (!initialized) initialize();
state = st;
}
/* RETURN POINTER TO CURRENT STATE. */
rand_state *rand_get_state (void)
{
if (!initialized) initialize();
return state;
}
/* GENERATE RANDOM 31-BIT INTEGER. Not really meant for use outside this
module. */
int rand_word(void)
{
int v;
int j;
if (!initialized) initialize();
v = this_nrand48(state->state48);
for (j = 0; j<N_tables; j++)
{ v ^= rn[j][state->ptr[j]];
}
for (j = 0; j<N_tables && state->ptr[j]==Table_size-1; j++)
{ state->ptr[j] = 0;
}
if (j<N_tables)
{ state->ptr[j] += 1;
}
return v & 0x7fffffff;
}
/* GENERATE UNIFORMLY FROM [0,1). */
double rand_uniform (void)
{
return (double)rand_word() / (1.0+(double)0x7fffffff);
}
/* GENERATE UNIFORMLY FORM (0,1). */
double rand_uniopen (void)
{
return (0.5+(double)rand_word()) / (1.0+(double)0x7fffffff);
}
/* GENERATE RANDOM INTEGER FROM 0, 1, ..., (n-1). */
int rand_int
( int n
)
{
return (int) (n * rand_uniform());
}
/* GENERATE INTEGER FROM 0, 1, ..., (n-1), WITH GIVEN DISTRIBUTION. */
int rand_pickd
( double *p,
int n
)
{
double t, r;
int i;
t = 0;
for (i = 0; i<n; i++)
{ if (p[i]<0) abort();
t += p[i];
}
if (t<=0) abort();
r = t * rand_uniform();
for (i = 0; i<n; i++)
{ r -= p[i];
if (r<0) return i;
}
/* Return value with non-zero probability if we get here due to roundoff. */
for (i = 0; i<n; i++)
{ if (p[i]>0) return i;
}
abort();
}
/* SAME PROCEDURE AS ABOVE, BUT WITH FLOAT ARGUMENT. */
int rand_pickf
( float *p,
int n
)
{
double t, r;
int i;
t = 0;
for (i = 0; i<n; i++)
{ if (p[i]<=0) abort();
t += p[i];
}
if (t<=0) abort();
r = t * rand_uniform();
for (i = 0; i<n; i++)
{ r -= p[i];
if (r<0) return i;
}
/* Return value with non-zero probability if we get here due to roundoff. */
for (i = 0; i<n; i++)
{ if (p[i]>0) return i;
}
abort();
}
/* GENERATE RANDOM PERMUTATION OF INTEGERS FROM 1 TO N. */
void rand_permutation
( int *perm, /* Place to store permutation */
int n /* Number of integers to permute */
)
{
int i, j, t;
for (i = 0; i<n; i++)
{ perm[i] = i+1;
}
for (i = 0; i<n; i++)
{ t = perm[i];
j = i + rand_int(n-i);
perm[i] = perm[j];
perm[j] = t;
}
}
/* POISSON GENERATOR. The method used is simple, but not very fast. See
Devroye, p. 503. Very large means are done using Gaussian approximation. */
int rand_poisson
( double lambda
)
{ int v;
if (lambda>10000)
{ v = (int) (lambda + rand_gaussian()*sqrt(lambda) + 0.5);
}
else
{ v = 0;
for (;;)
{ lambda -= rand_exp();
if (lambda<=0) break;
v += 1;
}
}
return v;
}
/* GAUSSIAN GENERATOR. Done by using the Box-Muller method, but only one
of the variates is retained (using both would require saving more state).
See Devroye, p. 235.
As written, should never deliver exactly zero, which may sometimes be
helpful. */
double rand_gaussian (void)
{
double a, b;
a = rand_uniform();
b = rand_uniopen();
return cos(2.0*M_PI*a) * sqrt(-2.0*log(b));
}
/* EXPONENTIAL GENERATOR. See Devroye, p. 29. Written so as to never
return exactly zero. */
double rand_exp (void)
{
return -log(rand_uniopen());
}
/* LOGISTIC GENERATOR. Just inverts the CDF. */
double rand_logistic (void)
{ double u;
u = rand_uniopen();
return log(u/(1-u));
}
/* CAUCHY GENERATOR. See Devroye, p. 29. */
double rand_cauchy (void)
{
return tan (M_PI * (rand_uniopen()-0.5));
}
/* GAMMA GENERATOR. Generates a positive real number, r, with density
proportional to r^(a-1) * exp(-r). See Devroye, p. 410 and p. 420.
Things are fiddled to avoid ever returning a value that is very near
zero. */
double rand_gamma
( double a
)
{
double b, c, X, Y, Z, U, V, W;
if (a<0.00001)
{ X = a;
}
else if (a<=1)
{
U = rand_uniopen();
X = rand_gamma(1+a) * pow(U,1/a);
}
else if (a<1.00001)
{ X = rand_exp();
}
else
{
b = a-1;
c = 3*a - 0.75;
for (;;)
{
U = rand_uniopen();
V = rand_uniopen();
W = U*(1-U);
Y = sqrt(c/W) * (U-0.5);
X = b+Y;
if (X>=0)
{
Z = 64*W*W*W*V*V;
if (Z <= 1 - 2*Y*Y/X || log(Z) <= 2 * (b*log(X/b) - Y)) break;
}
}
}
return X<1e-30 && X<a ? (a<1e-30 ? a : 1e-30) : X;
}
/* BETA GENERATOR. Generates a real number, r, in (0,1), with density
proportional to r^(a-1) * (1-r)^(b-1). Things are fiddled to avoid
the end-points, and to make the procedure symmetric between a and b. */
double rand_beta
( double a,
double b
)
{
double x, y, r;
do
{ x = rand_gamma(a);
y = rand_gamma(b);
r = 1.0 + x/(x+y);
r = r - 1.0;
} while (r<=0.0 || r>=1.0);
return r;
}
/* ROUTINES FROM THE GNU C LIBRARY. These were modified to extract
only the routines used here, and to allow them to be included in
this module without any possible name conflict with other modules.
Inclusion here ensures that these routines are always available, and
operate in exactly the same way on all systems. The routines as copied
below are still easily useable by other programs by simply inserting
this source code into an appropriate source file.
The following is the copyright notice for these routines:
Copyright (C) 1995, 1996, 1997, 2002 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Ulrich Drepper <drepper@gnu.ai.mit.edu>, August 1995.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
The GNU C Library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with the GNU C Library; if not, write to the Free
Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
02111-1307 USA.
The GNU Lesser General Public License is included with these source
files in the file LGPL. */
#include <errno.h>
#include <limits.h>
#include <sys/types.h>
struct this_drand48_data
{
unsigned short int x[3]; /* Current state. */
unsigned short int old_x[3]; /* Old state. */
unsigned short int c; /* Additive const. in congruential formula. */
unsigned short int init; /* Flag for initializing. */
unsigned long long int a; /* Factor in congruential formula. */
};
/* Global state for non-reentrant functions. */
struct this_drand48_data libc_this_drand48_data;
static int this_nrand48_r (unsigned short int xsubi[3],
struct this_drand48_data *buffer,
long int *result);
/* Internal function to compute next state of the generator. */
static int this_drand48_iterate (unsigned short int xsubi[3],
struct this_drand48_data *buffer);
static long int this_nrand48 (xsubi)
unsigned short int xsubi[3];
{
long int result;
(void) this_nrand48_r (xsubi, &libc_this_drand48_data, &result);
return result;
}
static int this_nrand48_r (xsubi, buffer, result)
unsigned short int xsubi[3];
struct this_drand48_data *buffer;
long int *result;
{
/* Compute next state. */
if (this_drand48_iterate (xsubi, buffer) < 0)
return -1;
/* Store the result. */
if (sizeof (unsigned short int) == 2)
*result = xsubi[2] << 15 | xsubi[1] >> 1;
else
*result = xsubi[2] >> 1;
return 0;
}
static int this_drand48_iterate (xsubi, buffer)
unsigned short int xsubi[3];
struct this_drand48_data *buffer;
{
uint64_t X;
uint64_t result;
/* Initialize buffer, if not yet done. */
if (!buffer->init)
{
buffer->a = 0x5deece66dull;
buffer->c = 0xb;
buffer->init = 1;
}
/* Do the real work. We choose a data type which contains at least
48 bits. Because we compute the modulus it does not care how
many bits really are computed. */
X = (uint64_t) xsubi[2] << 32 | (uint32_t) xsubi[1] << 16 | xsubi[0];
result = X * buffer->a + buffer->c;
xsubi[0] = result & 0xffff;
xsubi[1] = (result >> 16) & 0xffff;
xsubi[2] = (result >> 32) & 0xffff;
return 0;
}
File diff suppressed because it is too large Load Diff