comicsansg/ft8d
1
0
Fork 0
mirror of https://github.com/pavel-demin/ft8d.git synced 2024-11-12 23:26:11 -05:00
Code Issues Packages Projects Releases Wiki Activity

switch to 77-bit message protocol

Browse Source
This commit is contained in:
Pavel Demin 2018-12-15 13:25:41 +01:00
parent 69ca3729ae
commit f8f733d450
29 changed files with 2692 additions and 1150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Makefile
View File

@ -1,10 +1,11 @@
TARGET = ft8d
OBJECTS = \
crc12.o crc.o ft8_downsample.o sync8d.o sync8.o grid2deg.o four2a.o \
deg2grid.o chkcrc12a.o determ.o fftw3mod.o baseline.o bpdecode174.o \
fmtmsg.o packjt.o extractmessage174.o indexx.o shell.o pctile.o polyfit.o \
twkfreq1.o osd174.o encode174.o genft8.o db.o ft8b.o ft8d.o
crc14.o crc.o ft8_downsample.o sync8d.o sync8.o grid2deg.o four2a.o \
deg2grid.o determ.o fftw3mod.o baseline.o bpdecode174_91.o fmtmsg.o \
packjt.o chkcrc14a.o extractmessage174_91.o indexx.o shell.o pctile.o \
polyfit.o twkfreq1.o osd174_91.o encode174_91.o chkcall.o packjt77.o \
genft8.o genft8refsig.o subtractft8.o ft8b.o ft8d.o
CC = gcc
FC = gfortran

426
bpdecode174.f90
View File

@ -1,426 +0,0 @@
subroutine platanh(x,y)
isign=+1
z=x
if( x.lt.0 ) then
isign=-1
z=abs(x)
endif
if( z.le. 0.664 ) then
y=x/0.83
return
elseif( z.le. 0.9217 ) then
y=isign*(z-0.4064)/0.322
return
elseif( z.le. 0.9951 ) then
y=isign*(z-0.8378)/0.0524
return
elseif( z.le. 0.9998 ) then
y=isign*(z-0.9914)/0.0012
return
else
y=isign*7.0
return
endif
end subroutine platanh
subroutine bpdecode174(llr,apmask,maxiterations,decoded,cw,nharderror,iter)
!
! A log-domain belief propagation decoder for the (174,87) code.
!
integer, parameter:: N=174, K=87, M=N-K
integer*1 codeword(N),cw(N),apmask(N)
integer colorder(N)
integer*1 decoded(K)
integer Nm(7,M) ! 5, 6, or 7 bits per check
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(7,M)
real tanhtoc(7,M)
real zn(N)
real llr(N)
real Tmn
integer nrw(M)
data colorder/ &
0, 1, 2, 3, 30, 4, 5, 6, 7, 8, 9, 10, 11, 32, 12, 40, 13, 14, 15, 16,&
17, 18, 37, 45, 29, 19, 20, 21, 41, 22, 42, 31, 33, 34, 44, 35, 47, 51, 50, 43,&
36, 52, 63, 46, 25, 55, 27, 24, 23, 53, 39, 49, 59, 38, 48, 61, 60, 57, 28, 62,&
56, 58, 65, 66, 26, 70, 64, 69, 68, 67, 74, 71, 54, 76, 72, 75, 78, 77, 80, 79,&
73, 83, 84, 81, 82, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,&
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,&
120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,&
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,&
160,161,162,163,164,165,166,167,168,169,170,171,172,173/
data Mn/ &
1, 25, 69, &
2, 5, 73, &
3, 32, 68, &
4, 51, 61, &
6, 63, 70, &
7, 33, 79, &
8, 50, 86, &
9, 37, 43, &
10, 41, 65, &
11, 14, 64, &
12, 75, 77, &
13, 23, 81, &
15, 16, 82, &
17, 56, 66, &
18, 53, 60, &
19, 31, 52, &
20, 67, 84, &
21, 29, 72, &
22, 24, 44, &
26, 35, 76, &
27, 36, 38, &
28, 40, 42, &
30, 54, 55, &
34, 49, 87, &
39, 57, 58, &
45, 74, 83, &
46, 62, 80, &
47, 48, 85, &
59, 71, 78, &
1, 50, 53, &
2, 47, 84, &
3, 25, 79, &
4, 6, 14, &
5, 7, 80, &
8, 34, 55, &
9, 36, 69, &
10, 43, 83, &
11, 23, 74, &
12, 17, 44, &
13, 57, 76, &
15, 27, 56, &
16, 28, 29, &
18, 19, 59, &
20, 40, 63, &
21, 35, 52, &
22, 54, 64, &
24, 62, 78, &
26, 32, 77, &
30, 72, 85, &
31, 65, 87, &
33, 39, 51, &
37, 48, 75, &
38, 70, 71, &
41, 42, 68, &
45, 67, 86, &
46, 81, 82, &
49, 66, 73, &
58, 60, 66, &
61, 65, 85, &
1, 14, 21, &
2, 13, 59, &
3, 67, 82, &
4, 32, 73, &
5, 36, 54, &
6, 43, 46, &
7, 28, 75, &
8, 33, 71, &
9, 49, 76, &
10, 58, 64, &
11, 48, 68, &
12, 19, 45, &
15, 50, 61, &
16, 22, 26, &
17, 72, 80, &
18, 40, 55, &
20, 35, 51, &
23, 25, 34, &
24, 63, 87, &
27, 39, 74, &
29, 78, 83, &
30, 70, 77, &
31, 69, 84, &
22, 37, 86, &
38, 41, 81, &
42, 44, 57, &
47, 53, 62, &
52, 56, 79, &
60, 75, 81, &
1, 39, 77, &
2, 16, 41, &
3, 31, 54, &
4, 36, 78, &
5, 45, 65, &
6, 57, 85, &
7, 14, 49, &
8, 21, 46, &
9, 15, 72, &
10, 20, 62, &
11, 17, 71, &
12, 34, 47, &
13, 68, 86, &
18, 23, 43, &
19, 64, 73, &
24, 48, 79, &
25, 70, 83, &
26, 80, 87, &
27, 32, 40, &
28, 56, 69, &
29, 63, 66, &
30, 42, 50, &
33, 37, 82, &
35, 60, 74, &
38, 55, 84, &
44, 52, 61, &
51, 53, 72, &
58, 59, 67, &
47, 56, 76, &
1, 19, 37, &
2, 61, 75, &
3, 8, 66, &
4, 60, 84, &
5, 34, 39, &
6, 26, 53, &
7, 32, 57, &
9, 52, 67, &
10, 12, 15, &
11, 51, 69, &
13, 14, 65, &
16, 31, 43, &
17, 20, 36, &
18, 80, 86, &
21, 48, 59, &
22, 40, 46, &
23, 33, 62, &
24, 30, 74, &
25, 42, 64, &
27, 49, 85, &
28, 38, 73, &
29, 44, 81, &
35, 68, 70, &
41, 63, 76, &
45, 49, 71, &
50, 58, 87, &
48, 54, 83, &
13, 55, 79, &
77, 78, 82, &
1, 2, 24, &
3, 6, 75, &
4, 56, 87, &
5, 44, 53, &
7, 50, 83, &
8, 10, 28, &
9, 55, 62, &
11, 29, 67, &
12, 33, 40, &
14, 16, 20, &
15, 35, 73, &
17, 31, 39, &
18, 36, 57, &
19, 46, 76, &
21, 42, 84, &
22, 34, 59, &
23, 26, 61, &
25, 60, 65, &
27, 64, 80, &
30, 37, 66, &
32, 45, 72, &
38, 51, 86, &
41, 77, 79, &
43, 56, 68, &
47, 74, 82, &
40, 52, 78, &
54, 61, 71, &
46, 58, 69/
data Nm/ &
1, 30, 60, 89, 118, 147, 0, &
2, 31, 61, 90, 119, 147, 0, &
3, 32, 62, 91, 120, 148, 0, &
4, 33, 63, 92, 121, 149, 0, &
2, 34, 64, 93, 122, 150, 0, &
5, 33, 65, 94, 123, 148, 0, &
6, 34, 66, 95, 124, 151, 0, &
7, 35, 67, 96, 120, 152, 0, &
8, 36, 68, 97, 125, 153, 0, &
9, 37, 69, 98, 126, 152, 0, &
10, 38, 70, 99, 127, 154, 0, &
11, 39, 71, 100, 126, 155, 0, &
12, 40, 61, 101, 128, 145, 0, &
10, 33, 60, 95, 128, 156, 0, &
13, 41, 72, 97, 126, 157, 0, &
13, 42, 73, 90, 129, 156, 0, &
14, 39, 74, 99, 130, 158, 0, &
15, 43, 75, 102, 131, 159, 0, &
16, 43, 71, 103, 118, 160, 0, &
17, 44, 76, 98, 130, 156, 0, &
18, 45, 60, 96, 132, 161, 0, &
19, 46, 73, 83, 133, 162, 0, &
12, 38, 77, 102, 134, 163, 0, &
19, 47, 78, 104, 135, 147, 0, &
1, 32, 77, 105, 136, 164, 0, &
20, 48, 73, 106, 123, 163, 0, &
21, 41, 79, 107, 137, 165, 0, &
22, 42, 66, 108, 138, 152, 0, &
18, 42, 80, 109, 139, 154, 0, &
23, 49, 81, 110, 135, 166, 0, &
16, 50, 82, 91, 129, 158, 0, &
3, 48, 63, 107, 124, 167, 0, &
6, 51, 67, 111, 134, 155, 0, &
24, 35, 77, 100, 122, 162, 0, &
20, 45, 76, 112, 140, 157, 0, &
21, 36, 64, 92, 130, 159, 0, &
8, 52, 83, 111, 118, 166, 0, &
21, 53, 84, 113, 138, 168, 0, &
25, 51, 79, 89, 122, 158, 0, &
22, 44, 75, 107, 133, 155, 172, &
9, 54, 84, 90, 141, 169, 0, &
22, 54, 85, 110, 136, 161, 0, &
8, 37, 65, 102, 129, 170, 0, &
19, 39, 85, 114, 139, 150, 0, &
26, 55, 71, 93, 142, 167, 0, &
27, 56, 65, 96, 133, 160, 174, &
28, 31, 86, 100, 117, 171, 0, &
28, 52, 70, 104, 132, 144, 0, &
24, 57, 68, 95, 137, 142, 0, &
7, 30, 72, 110, 143, 151, 0, &
4, 51, 76, 115, 127, 168, 0, &
16, 45, 87, 114, 125, 172, 0, &
15, 30, 86, 115, 123, 150, 0, &
23, 46, 64, 91, 144, 173, 0, &
23, 35, 75, 113, 145, 153, 0, &
14, 41, 87, 108, 117, 149, 170, &
25, 40, 85, 94, 124, 159, 0, &
25, 58, 69, 116, 143, 174, 0, &
29, 43, 61, 116, 132, 162, 0, &
15, 58, 88, 112, 121, 164, 0, &
4, 59, 72, 114, 119, 163, 173, &
27, 47, 86, 98, 134, 153, 0, &
5, 44, 78, 109, 141, 0, 0, &
10, 46, 69, 103, 136, 165, 0, &
9, 50, 59, 93, 128, 164, 0, &
14, 57, 58, 109, 120, 166, 0, &
17, 55, 62, 116, 125, 154, 0, &
3, 54, 70, 101, 140, 170, 0, &
1, 36, 82, 108, 127, 174, 0, &
5, 53, 81, 105, 140, 0, 0, &
29, 53, 67, 99, 142, 173, 0, &
18, 49, 74, 97, 115, 167, 0, &
2, 57, 63, 103, 138, 157, 0, &
26, 38, 79, 112, 135, 171, 0, &
11, 52, 66, 88, 119, 148, 0, &
20, 40, 68, 117, 141, 160, 0, &
11, 48, 81, 89, 146, 169, 0, &
29, 47, 80, 92, 146, 172, 0, &
6, 32, 87, 104, 145, 169, 0, &
27, 34, 74, 106, 131, 165, 0, &
12, 56, 84, 88, 139, 0, 0, &
13, 56, 62, 111, 146, 171, 0, &
26, 37, 80, 105, 144, 151, 0, &
17, 31, 82, 113, 121, 161, 0, &
28, 49, 59, 94, 137, 0, 0, &
7, 55, 83, 101, 131, 168, 0, &
24, 50, 78, 106, 143, 149, 0/
data nrw/ &
6,6,6,6,6,6,6,6,6,6, &
6,6,6,6,6,6,6,6,6,6, &
6,6,6,6,6,6,6,6,6,6, &
6,6,6,6,6,6,6,6,6,7, &
6,6,6,6,6,7,6,6,6,6, &
6,6,6,6,6,7,6,6,6,6, &
7,6,5,6,6,6,6,6,6,5, &
6,6,6,6,6,6,6,6,6,6, &
5,6,6,6,5,6,6/
ncw=3
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
! write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it
codeword=cw(colorder+1)
decoded=codeword(M+1:N)
nerr=0
do i=1,N
if( (2*cw(i)-1)*llr(i) .lt. 0.0 ) nerr=nerr+1
enddo
nharderror=nerr
return
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:7,i)=tanh(-toc(1:7,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
nharderror=-1
return
end subroutine bpdecode174

140
bpdecode174_91.f90 Normal file
View File

@ -0,0 +1,140 @@
subroutine platanh(x,y)
isign=+1
z=x
if( x.lt.0 ) then
isign=-1
z=abs(x)
endif
if( z.le. 0.664 ) then
y=x/0.83
return
elseif( z.le. 0.9217 ) then
y=isign*(z-0.4064)/0.322
return
elseif( z.le. 0.9951 ) then
y=isign*(z-0.8378)/0.0524
return
elseif( z.le. 0.9998 ) then
y=isign*(z-0.9914)/0.0012
return
else
y=isign*7.0
return
endif
end subroutine platanh
subroutine bpdecode174_91(llr,apmask,maxiterations,message77,cw,nharderror,iter)
!
! A log-domain belief propagation decoder for the (174,91) code.
!
use iso_c_binding, only: c_loc,c_size_t
use crc
integer, parameter:: N=174, K=91, M=N-K
integer*1 cw(N),apmask(N)
integer*1 decoded(K)
integer*1 message77(77)
integer nrw(M),ncw
integer Nm(7,M)
integer Mn(3,N) ! 3 checks per bit
integer synd(M)
real tov(3,N)
real toc(7,M)
real tanhtoc(7,M)
real zn(N)
real llr(N)
real Tmn
include "ldpc_174_91_c_reordered_parity.f90"
decoded=0
toc=0
tov=0
tanhtoc=0
! initialize messages to checks
do j=1,M
do i=1,nrw(j)
toc(i,j)=llr((Nm(i,j)))
enddo
enddo
ncnt=0
do iter=0,maxiterations
! Update bit log likelihood ratios (tov=0 in iteration 0).
do i=1,N
if( apmask(i) .ne. 1 ) then
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
enddo
! Check to see if we have a codeword (check before we do any iteration).
cw=0
where( zn .gt. 0. ) cw=1
ncheck=0
do i=1,M
synd(i)=sum(cw(Nm(1:nrw(i),i)))
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied'
enddo
! write(*,*) 'number of unsatisfied parity checks ',ncheck
if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it
decoded=cw(1:K)
call chkcrc14a(decoded,nbadcrc)
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
if(nbadcrc.eq.0) then
message77=decoded(1:77)
return
endif
endif
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
nd=ncheck-nclast
if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased
ncnt=0 ! reset counter
else
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
nharderror=-1
return
endif
endif
nclast=ncheck
! Send messages from bits to check nodes
do j=1,M
do i=1,nrw(j)
ibj=Nm(i,j)
toc(i,j)=zn(ibj)
do kk=1,ncw ! subtract off what the bit had received from the check
if( Mn(kk,ibj) .eq. j ) then
toc(i,j)=toc(i,j)-tov(kk,ibj)
endif
enddo
enddo
enddo
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:7,i)=tanh(-toc(1:7,i)/2)
enddo
do j=1,N
do i=1,ncw
ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j
Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j)
call platanh(-Tmn,y)
! y=atanh(-Tmn)
tov(i,j)=2*y
enddo
enddo
enddo
nharderror=-1
return
end subroutine bpdecode174_91

58
chkcall.f90 Normal file
View File

@ -0,0 +1,58 @@
subroutine chkcall(w,bc,cok)
! Check "w" to see if it could be a valid standard callsign or a valid
! compound callsign.
! Return base call "bc" and a logical "cok" indicator.
character w*13 !A putative callsign
character bc*6 !Base call (tentative)
character c*1
logical cok,isdigit,isletter
isdigit(c)=(ichar(c).ge.ichar('0')) .and. (ichar(c).le.ichar('9'))
isletter(c)=(ichar(c).ge.ichar('A')) .and. (ichar(c).le.ichar('Z'))
cok=.true.
bc=w(1:6)
n1=len_trim(w)
if(n1.gt.11) go to 100
if(index(w,'.').ge.1) go to 100
if(index(w,'+').ge.1) go to 100
if(index(w,'-').ge.1) go to 100
if(index(w,'?').ge.1) go to 100
if(n1.gt.6 .and. index(w,'/').le.0) go to 100
i0=index(w,'/')
if(max(i0-1,n1-i0).gt.6) go to 100 !Base call must be < 7 characters
if(i0.ge.2 .and. i0.le.n1-1) then !Extract base call from compound call
if(i0-1.le.n1-i0) bc=w(i0+1:n1)//' '
if(i0-1.gt.n1-i0) bc=w(1:i0-1)//' '
endif
nbc=len_trim(bc)
if(nbc.gt.6) go to 100 !Base call should have no more than 6 characters
! One of first two characters (c1 or c2) must be a letter
if((.not.isletter(bc(1:1))) .and. (.not.isletter(bc(2:2)))) go to 100
if(bc(1:1).eq.'Q') go to 100 !Calls don't start with Q
! Must have a digit in 2nd or 3rd position
i1=0
if(isdigit(bc(2:2))) i1=2
if(isdigit(bc(3:3))) i1=3
if(i1.eq.0) go to 100
! Callsign must have a suffix of 1-3 letters
if(i1.eq.nbc) go to 100
n=0
do i=i1+1,nbc
j=ichar(bc(i:i))
if(j.lt.ichar('A') .or. j.gt.ichar('Z')) go to 100
n=n+1
enddo
if(n.ge.1 .and. n.le.3) go to 200
100 cok=.false.
200 return
end subroutine chkcall

24
chkcrc12a.f90
View File

@ -1,24 +0,0 @@
subroutine chkcrc12a(decoded,nbadcrc)
use crc
integer*1 decoded(87)
integer*1, target:: i1Dec8BitBytes(11)
character*87 cbits
! Write decoded bits into cbits: 75-bit message plus 12-bit CRC
write(cbits,1000) decoded
1000 format(87i1)
read(cbits,1001) i1Dec8BitBytes
1001 format(11b8)
read(cbits,1002) ncrc12 !Received CRC12
1002 format(75x,b12)
i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),128+64+32)
i1Dec8BitBytes(11)=0
icrc12=crc12(c_loc(i1Dec8BitBytes),11) !CRC12 computed from 75 msg bits
nbadcrc=1
if(ncrc12.eq.icrc12) nbadcrc=0
return
end subroutine chkcrc12a

24
chkcrc14a.f90 Normal file
View File

@ -0,0 +1,24 @@
subroutine chkcrc14a(decoded,nbadcrc)
use crc
integer*1 decoded(91)
integer*1, target:: i1Dec8BitBytes(12)
character*91 cbits
! Write decoded bits into cbits: 77-bit message plus 14-bit CRC
write(cbits,1000) decoded
1000 format(91i1)
read(cbits,1001) i1Dec8BitBytes
1001 format(12b8)
read(cbits,1002) ncrc14 !Received CRC14
1002 format(77x,b14)
i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),128+64+32+16+8)
i1Dec8BitBytes(11:12)=0
icrc14=crc14(c_loc(i1Dec8BitBytes),12) !CRC14 computed from 77 msg bits
nbadcrc=1
if(ncrc14.eq.icrc14) nbadcrc=0
return
end subroutine chkcrc14a

34
crc.f90
View File

@ -10,7 +10,7 @@ module crc
integer (c_int), value :: length
end function crc14
function crc14_check (data, length) bind (C, name="crc16_check")
function crc14_check (data, length) bind (C, name="crc14_check")
use, intrinsic :: iso_c_binding, only: c_bool, c_ptr, c_int
implicit none
logical (c_bool) :: crc14_check
@ -18,37 +18,5 @@ module crc
integer (c_int), value :: length
end function crc14_check
function crc12 (data, length) bind (C, name="crc12")
use, intrinsic :: iso_c_binding, only: c_short, c_ptr, c_int
implicit none
integer (c_short) :: crc12
type (c_ptr), value :: data
integer (c_int), value :: length
end function crc12
function crc12_check (data, length) bind (C, name="crc12_check")
use, intrinsic :: iso_c_binding, only: c_bool, c_ptr, c_int
implicit none
logical (c_bool) :: crc12_check
type (c_ptr), value :: data
integer (c_int), value :: length
end function crc12_check
function crc10 (data, length) bind (C, name="crc10")
use, intrinsic :: iso_c_binding, only: c_short, c_ptr, c_int
implicit none
integer (c_short) :: crc10
type (c_ptr), value :: data
integer (c_int), value :: length
end function crc10
function crc10_check (data, length) bind (C, name="crc10_check")
use, intrinsic :: iso_c_binding, only: c_bool, c_ptr, c_int
implicit none
logical (c_bool) :: crc10_check
type (c_ptr), value :: data
integer (c_int), value :: length
end function crc10_check
end interface
end module crc

59
crc12.c
View File

@ -1,59 +0,0 @@
#include <stdbool.h>
static unsigned short table[256] =
{
0x0000, 0x1c06, 0x340a, 0x280c, 0x6814, 0x7412, 0x5c1e, 0x4018,
0xdc2e, 0xc028, 0xe824, 0xf422, 0xb43a, 0xa83c, 0x8030, 0x9c36,
0xb45a, 0xa85c, 0x8050, 0x9c56, 0xdc4e, 0xc048, 0xe844, 0xf442,
0x6874, 0x7472, 0x5c7e, 0x4078, 0x0060, 0x1c66, 0x346a, 0x286c,
0x68b4, 0x74b2, 0x5cbe, 0x40b8, 0x00a0, 0x1ca6, 0x34aa, 0x28ac,
0xb49a, 0xa89c, 0x8090, 0x9c96, 0xdc8e, 0xc088, 0xe884, 0xf482,
0xdcee, 0xc0e8, 0xe8e4, 0xf4e2, 0xb4fa, 0xa8fc, 0x80f0, 0x9cf6,
0x00c0, 0x1cc6, 0x34ca, 0x28cc, 0x68d4, 0x74d2, 0x5cde, 0x40d8,
0xdd6e, 0xc168, 0xe964, 0xf562, 0xb57a, 0xa97c, 0x8170, 0x9d76,
0x0140, 0x1d46, 0x354a, 0x294c, 0x6954, 0x7552, 0x5d5e, 0x4158,
0x6934, 0x7532, 0x5d3e, 0x4138, 0x0120, 0x1d26, 0x352a, 0x292c,
0xb51a, 0xa91c, 0x8110, 0x9d16, 0xdd0e, 0xc108, 0xe904, 0xf502,
0xb5da, 0xa9dc, 0x81d0, 0x9dd6, 0xddce, 0xc1c8, 0xe9c4, 0xf5c2,
0x69f4, 0x75f2, 0x5dfe, 0x41f8, 0x01e0, 0x1de6, 0x35ea, 0x29ec,
0x0180, 0x1d86, 0x358a, 0x298c, 0x6994, 0x7592, 0x5d9e, 0x4198,
0xddae, 0xc1a8, 0xe9a4, 0xf5a2, 0xb5ba, 0xa9bc, 0x81b0, 0x9db6,
0xb6da, 0xaadc, 0x82d0, 0x9ed6, 0xdece, 0xc2c8, 0xeac4, 0xf6c2,
0x6af4, 0x76f2, 0x5efe, 0x42f8, 0x02e0, 0x1ee6, 0x36ea, 0x2aec,
0x0280, 0x1e86, 0x368a, 0x2a8c, 0x6a94, 0x7692, 0x5e9e, 0x4298,
0xdeae, 0xc2a8, 0xeaa4, 0xf6a2, 0xb6ba, 0xaabc, 0x82b0, 0x9eb6,
0xde6e, 0xc268, 0xea64, 0xf662, 0xb67a, 0xaa7c, 0x8270, 0x9e76,
0x0240, 0x1e46, 0x364a, 0x2a4c, 0x6a54, 0x7652, 0x5e5e, 0x4258,
0x6a34, 0x7632, 0x5e3e, 0x4238, 0x0220, 0x1e26, 0x362a, 0x2a2c,
0xb61a, 0xaa1c, 0x8210, 0x9e16, 0xde0e, 0xc208, 0xea04, 0xf602,
0x6bb4, 0x77b2, 0x5fbe, 0x43b8, 0x03a0, 0x1fa6, 0x37aa, 0x2bac,
0xb79a, 0xab9c, 0x8390, 0x9f96, 0xdf8e, 0xc388, 0xeb84, 0xf782,
0xdfee, 0xc3e8, 0xebe4, 0xf7e2, 0xb7fa, 0xabfc, 0x83f0, 0x9ff6,
0x03c0, 0x1fc6, 0x37ca, 0x2bcc, 0x6bd4, 0x77d2, 0x5fde, 0x43d8,
0x0300, 0x1f06, 0x370a, 0x2b0c, 0x6b14, 0x7712, 0x5f1e, 0x4318,
0xdf2e, 0xc328, 0xeb24, 0xf722, 0xb73a, 0xab3c, 0x8330, 0x9f36,
0xb75a, 0xab5c, 0x8350, 0x9f56, 0xdf4e, 0xc348, 0xeb44, 0xf742,
0x6b74, 0x7772, 0x5f7e, 0x4378, 0x0360, 0x1f66, 0x376a, 0x2b6c
};
short crc12(unsigned char const *data, int length)
{
unsigned short remainder = 0;
unsigned char index;
int i;
for(i = 0; i < length; ++i)
{
index = remainder >> 4;
remainder <<= 8;
remainder |= data[i];
remainder ^= table[index];
}
return remainder & 0x0fff;
}
bool crc12_check(unsigned char const *data, int length)
{
return !crc12(data, length);
}

59
crc14.c Normal file
View File

@ -0,0 +1,59 @@
#include <stdbool.h>
static unsigned short table[256] =
{
0x0000, 0x6757, 0xe9f9, 0x8eae, 0xf4a5, 0x93f2, 0x1d5c, 0x7a0b,
0xce1d, 0xa94a, 0x27e4, 0x40b3, 0x3ab8, 0x5def, 0xd341, 0xb416,
0x9c3a, 0xfb6d, 0x75c3, 0x1294, 0x689f, 0x0fc8, 0x8166, 0xe631,
0x5227, 0x3570, 0xbbde, 0xdc89, 0xa682, 0xc1d5, 0x4f7b, 0x282c,
0x3874, 0x5f23, 0xd18d, 0xb6da, 0xccd1, 0xab86, 0x2528, 0x427f,
0xf669, 0x913e, 0x1f90, 0x78c7, 0x02cc, 0x659b, 0xeb35, 0x8c62,
0xa44e, 0xc319, 0x4db7, 0x2ae0, 0x50eb, 0x37bc, 0xb912, 0xde45,
0x6a53, 0x0d04, 0x83aa, 0xe4fd, 0x9ef6, 0xf9a1, 0x770f, 0x1058,
0x57bf, 0x30e8, 0xbe46, 0xd911, 0xa31a, 0xc44d, 0x4ae3, 0x2db4,
0x99a2, 0xfef5, 0x705b, 0x170c, 0x6d07, 0x0a50, 0x84fe, 0xe3a9,
0xcb85, 0xacd2, 0x227c, 0x452b, 0x3f20, 0x5877, 0xd6d9, 0xb18e,
0x0598, 0x62cf, 0xec61, 0x8b36, 0xf13d, 0x966a, 0x18c4, 0x7f93,
0x6fcb, 0x089c, 0x8632, 0xe165, 0x9b6e, 0xfc39, 0x7297, 0x15c0,
0xa1d6, 0xc681, 0x482f, 0x2f78, 0x5573, 0x3224, 0xbc8a, 0xdbdd,
0xf3f1, 0x94a6, 0x1a08, 0x7d5f, 0x0754, 0x6003, 0xeead, 0x89fa,
0x3dec, 0x5abb, 0xd415, 0xb342, 0xc949, 0xae1e, 0x20b0, 0x47e7,
0xaf7e, 0xc829, 0x4687, 0x21d0, 0x5bdb, 0x3c8c, 0xb222, 0xd575,
0x6163, 0x0634, 0x889a, 0xefcd, 0x95c6, 0xf291, 0x7c3f, 0x1b68,
0x3344, 0x5413, 0xdabd, 0xbdea, 0xc7e1, 0xa0b6, 0x2e18, 0x494f,
0xfd59, 0x9a0e, 0x14a0, 0x73f7, 0x09fc, 0x6eab, 0xe005, 0x8752,
0x970a, 0xf05d, 0x7ef3, 0x19a4, 0x63af, 0x04f8, 0x8a56, 0xed01,
0x5917, 0x3e40, 0xb0ee, 0xd7b9, 0xadb2, 0xcae5, 0x444b, 0x231c,
0x0b30, 0x6c67, 0xe2c9, 0x859e, 0xff95, 0x98c2, 0x166c, 0x713b,
0xc52d, 0xa27a, 0x2cd4, 0x4b83, 0x3188, 0x56df, 0xd871, 0xbf26,
0xf8c1, 0x9f96, 0x1138, 0x766f, 0x0c64, 0x6b33, 0xe59d, 0x82ca,
0x36dc, 0x518b, 0xdf25, 0xb872, 0xc279, 0xa52e, 0x2b80, 0x4cd7,
0x64fb, 0x03ac, 0x8d02, 0xea55, 0x905e, 0xf709, 0x79a7, 0x1ef0,
0xaae6, 0xcdb1, 0x431f, 0x2448, 0x5e43, 0x3914, 0xb7ba, 0xd0ed,
0xc0b5, 0xa7e2, 0x294c, 0x4e1b, 0x3410, 0x5347, 0xdde9, 0xbabe,
0x0ea8, 0x69ff, 0xe751, 0x8006, 0xfa0d, 0x9d5a, 0x13f4, 0x74a3,
0x5c8f, 0x3bd8, 0xb576, 0xd221, 0xa82a, 0xcf7d, 0x41d3, 0x2684,
0x9292, 0xf5c5, 0x7b6b, 0x1c3c, 0x6637, 0x0160, 0x8fce, 0xe899
};
short crc14(unsigned char const *data, int length)
{
unsigned short remainder = 0;
unsigned char index;
int i;
for(i = 0; i < length; ++i)
{
index = remainder >> 6;
remainder <<= 8;
remainder |= data[i];
remainder ^= table[index];
}
return remainder & 0x3fff;
}
bool crc14_check(unsigned char const *data, int length)
{
return !crc14(data, length);
}

5
db.f90
View File

@ -1,5 +0,0 @@
real function db(x)
db=-99.0
if(x.gt.1.259e-10) db=10.0*log10(x)
return
end function db

50
encode174.f90
View File

@ -1,50 +0,0 @@
subroutine encode174(message,codeword)
! Encode an 87-bit message and return a 174-bit codeword.
! The generator matrix has dimensions (87,87).
! The code is a (174,87) regular ldpc code with column weight 3.
! The code was generated using the PEG algorithm.
! After creating the codeword, the columns are re-ordered according to
! "colorder" to make the codeword compatible with the parity-check matrix
!
include "ldpc_174_87_params.f90"
integer*1 codeword(N)
integer*1 gen(M,K)
integer*1 itmp(N)
integer*1 message(K)
integer*1 pchecks(M)
logical first
data first/.true./
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,11
read(g(i)( (j-1)*2+1:(j-1)*2+2 ),"(Z2)") istr
do jj=1, 8
icol=(j-1)*8+jj
if( icol .le. 87 ) then
if( btest(istr,8-jj) ) gen(i,icol)=1
endif
enddo
enddo
enddo
first=.false.
endif
do i=1,M
nsum=0
do j=1,K
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
itmp(1:M)=pchecks
itmp(M+1:N)=message(1:K)
codeword(colorder+1)=itmp(1:N)
return
end subroutine encode174

58
encode174_91.f90 Normal file
View File

@ -0,0 +1,58 @@
subroutine encode174_91(message77,codeword)
!
! Add a 14-bit CRC to a 77-bit message and return a 174-bit codeword
!
use, intrinsic :: iso_c_binding
use iso_c_binding, only: c_loc,c_size_t
use crc
integer, parameter:: N=174, K=91, M=N-K
character*91 tmpchar
integer*1 codeword(N)
integer*1 gen(M,K)
integer*1 message77(77),message(K)
integer*1 pchecks(M)
integer*1, target :: i1MsgBytes(12)
include "ldpc_174_91_c_generator.f90"
logical first
data first/.true./
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,23
read(g(i)(j:j),"(Z1)") istr
ibmax=4
if(j.eq.23) ibmax=3
do jj=1, ibmax
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
first=.false.
endif
! Add 14-bit CRC to form 91-bit message+CRC14
write(tmpchar,'(77i1)') message77
tmpchar(78:80)='000'
i1MsgBytes=0
read(tmpchar,'(10b8)') i1MsgBytes(1:10)
ncrc14 = crc14 (c_loc (i1MsgBytes), 12)
write(tmpchar(78:91),'(b14)') ncrc14
read(tmpchar,'(91i1)') message
do i=1,M
nsum=0
do j=1,K
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
codeword(1:K)=message
codeword(K+1:N)=pchecks
return
end subroutine encode174_91

42
extractmessage174.f90
View File

@ -1,42 +0,0 @@
subroutine extractmessage174(decoded,msgreceived,msgcall,msggrid,ncrcflag)
use iso_c_binding, only: c_loc,c_size_t
use crc
use packjt
character msgreceived*22, msgcall*6, msggrid*4
character*87 cbits
integer*1 decoded(87)
integer*1, target:: i1Dec8BitBytes(11)
integer*4 i4Dec6BitWords(12)
! Write decoded bits into cbits: 75-bit message plus 12-bit CRC
write(cbits,1000) decoded
1000 format(87i1)
read(cbits,1001) i1Dec8BitBytes
1001 format(11b8)
read(cbits,1002) ncrc12 !Received CRC12
1002 format(75x,b12)
i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),128+64+32)
i1Dec8BitBytes(11)=0
icrc12=crc12(c_loc(i1Dec8BitBytes),11) !CRC12 computed from 75 msg bits
if(ncrc12.eq.icrc12 .or. sum(decoded(57:87)).eq.0) then !### Kludge ###
! CRC12 checks out --- unpack 72-bit message
do ibyte=1,12
itmp=0
do ibit=1,6
itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*6+ibit))
enddo
i4Dec6BitWords(ibyte)=itmp
enddo
call unpackmsg(i4Dec6BitWords,msgreceived,msgcall,msggrid)
ncrcflag=1
else
msgreceived=' '
msgcall=' '
msggrid=' '
ncrcflag=-1
endif
return
end subroutine extractmessage174

40
extractmessage174_91.f90 Normal file
View File

@ -0,0 +1,40 @@
subroutine extractmessage174_91(decoded,msgreceived,ncrcflag)
use iso_c_binding, only: c_loc,c_size_t
use crc
use packjt
character*22 msgreceived
character*91 cbits
integer*1 decoded(91)
integer*1, target:: i1Dec8BitBytes(12)
integer*4 i4Dec6BitWords(12)
! Write decoded bits into cbits: 77-bit message plus 14-bit CRC
write(cbits,1000) decoded
1000 format(91i1)
read(cbits,1001) i1Dec8BitBytes
1001 format(12b8)
read(cbits,1002) ncrc14 !Received CRC12
1002 format(77x,b14)
i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),128+64+32+16+8)
i1Dec8BitBytes(11:12)=0
icrc14=crc14(c_loc(i1Dec8BitBytes),12) !CRC12 computed from 75 msg bits
if(ncrc14.eq.icrc14 .or. sum(decoded(57:87)).eq.0) then !### Kludge ###
! CRC14 checks out --- unpack 72-bit message
do ibyte=1,12
itmp=0
do ibit=1,6
itmp=ishft(itmp,1)+iand(1,decoded((ibyte-1)*6+ibit))
enddo
i4Dec6BitWords(ibyte)=itmp
enddo
call unpackmsg(i4Dec6BitWords,msgreceived)
ncrcflag=1
else
msgreceived=' '
ncrcflag=-1
endif
return
end subroutine extractmessage174_91

8
fmtmsg.f90
View File

@ -1,16 +1,16 @@
subroutine fmtmsg(msg,iz)
character*22 msg
character*(*) msg
! Convert all letters to upper case
iz=22
do i=1,22
iz=len(msg)
do i=1,iz
if(msg(i:i).ge.'a' .and. msg(i:i).le.'z') &
msg(i:i)= char(ichar(msg(i:i))+ichar('A')-ichar('a'))
if(msg(i:i).ne.' ') iz=i
enddo
do iter=1,5 !Collapse multiple blanks into one
do iter=1,37 !Collapse multiple blanks into one
ib2=index(msg(1:iz),' ')
if(ib2.lt.1) go to 100
msg=msg(1:ib2)//msg(ib2+2:)

6
ft8_params.f90
View File

@ -1,5 +1,5 @@
! LDPC (174,87) code
parameter (KK=87) !Information bits (75 + CRC12)
! LDPC (174,91) code
parameter (KK=91) !Information bits (77 + CRC14)
parameter (ND=58) !Data symbols
parameter (NS=21) !Sync symbols (3 @ Costas 7x7)
parameter (NN=NS+ND) !Total channel symbols (79)
@ -10,4 +10,4 @@ parameter (NFFT1=2*NSPS) !Length of FFTs for symbol spectra
parameter (NSTEP=NSPS/4) !Rough time-sync step size
parameter (NHSYM=NMAX/NSTEP-3) !Number of symbol spectra (1/4-sym steps)
parameter (NDOWN=20) !Downsample factor
parameter (MAXCAND=200)
parameter (MAXCAND=300)

556
ft8b.f90
View File

@ -1,42 +1,55 @@
subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
napwid,nagain,iaptype,f1,xdt,xbase,apsym,nharderrors,dmin, &
nbadcrc,ipass,msgcall,msggrid,xsnr)
napwid,lsubtract,nagain,ncontest,iaptype,f1,xdt,xbase,apsym,nharderrors, &
dmin,nbadcrc,ipass,msg37,msgcall,msggrid,xsnr)
use crc
use packjt77
include 'ft8_params.f90'
parameter(NP2=2812)
character msgcall*6,msggrid*4,message*22
character*37 msg37
character*13 msgcall
character*4 msggrid
character*77 c77
real a(5)
real s1(0:7,ND),s2(0:7,NN),s1sort(8*ND)
real ps(0:7),psl(0:7)
real bmeta(3*ND),bmetb(3*ND),bmetap(3*ND)
real llr(3*ND),llra(3*ND),llr0(3*ND),llr1(3*ND),llrap(3*ND) !Soft symbols
real s8(0:7,NN)
real s2(0:511),s2l(0:511)
real bmeta(174),bmetb(174),bmetc(174)
real llra(174),llrb(174),llrc(174),llrd(174) !Soft symbols
complex dd0(NMAX)
integer*1 decoded(KK),apmask(3*ND),cw(3*ND)
integer apsym(KK)
integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16)
integer*1 message77(77),apmask(174),cw(174)
integer apsym(58)
integer mcq(29),mcqru(29),mcqfd(29),mcqtest(29)
integer mrrr(19),m73(19),mrr73(19)
integer itone(NN)
integer indxs1(8*ND)
integer icos7(0:6),ip(1)
integer nappasses(0:5) !Number of decoding passes to use for each QSO state
integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now
complex cd0(3200)
integer ncontest,ncontest0
logical one(0:511,0:8)
integer graymap(0:7)
complex cd0(0:3199)
complex ctwk(32)
complex csymb(32)
logical first,newdat,lapon,lapcqonly,nagain
equivalence (s1,s1sort)
data icos7/2,5,6,0,4,1,3/
data mcq/1,1,1,1,1,0,1,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,1,1,0,0,1/
data mrrr/0,1,1,1,1,1,1,0,1,1,0,0,1,1,1,1/
data m73/0,1,1,1,1,1,1,0,1,1,0,1,0,0,0,0/
data mde/1,1,1,1,1,1,1,1,0,1,1,0,0,1,0,0,0,0,0,1,1,1,0,1,0,0,0,1/
data mrr73/0,0,0,0,0,0,1,0,0,0,0,1,0,1,0,1/
complex cs(0:7,NN)
logical first,newdat,lsubtract,lapon,lapcqonly,nagain,unpk77_success
data icos7/3,1,4,0,6,5,2/ ! Flipped w.r.t. original FT8 sync array
data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/
data mcqru/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,0,0,1,1,0,0/
data mcqfd/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,0,0,0,1,0/
data mcqtest/0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,0,1,0,1,1,1,1,1,1,0,0,1,0/
data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/
data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/
data mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,0,1/
data first/.true./
save nappasses,naptypes
data graymap/0,1,3,2,5,6,4,7/
save nappasses,naptypes,ncontest0,one
if(first) then
if(first.or.(ncontest.ne.ncontest0)) then
mcq=2*mcq-1
mde=2*mde-1
mcqfd=2*mcqfd-1
mcqru=2*mcqru-1
mcqtest=2*mcqtest-1
mrrr=2*mrrr-1
m73=2*m73-1
mrr73=2*mrr73-1
@ -49,25 +62,33 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
! iaptype
!------------------------
! 1 CQ ??? ???
! 2 MyCall ??? ???
! 3 MyCall DxCall ???
! 4 MyCall DxCall RRR
! 5 MyCall DxCall 73
! 6 MyCall DxCall RR73
! 7 ??? DxCall ???
! 1 CQ ??? ??? (29+3=32 ap bits)
! 2 MyCall ??? ??? (29+3=32 ap bits)
! 3 MyCall DxCall ??? (58+3=61 ap bits)
! 4 MyCall DxCall RRR (77 ap bits)
! 5 MyCall DxCall 73 (77 ap bits)
! 6 MyCall DxCall RR73 (77 ap bits)
naptypes(0,1:4)=(/1,2,0,0/)
naptypes(1,1:4)=(/2,3,0,0/)
naptypes(2,1:4)=(/2,3,0,0/)
naptypes(3,1:4)=(/3,4,5,6/)
naptypes(4,1:4)=(/3,4,5,6/)
naptypes(5,1:4)=(/3,1,2,0/)
naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ)
naptypes(1,1:4)=(/2,3,0,0/) ! Tx1
naptypes(2,1:4)=(/2,3,0,0/) ! Tx2
naptypes(3,1:4)=(/3,4,5,6/) ! Tx3
naptypes(4,1:4)=(/3,4,5,6/) ! Tx4
naptypes(5,1:4)=(/3,1,2,0/) ! Tx5
one=.false.
do i=0,511
do j=0,8
if(iand(i,2**j).ne.0) one(i,j)=.true.
enddo
enddo
first=.false.
ncontest0=ncontest
endif
max_iterations=30
nharderrors=-1
nbadcrc=1 ! this is used upstream to flag good decodes.
fs2=4000.0/NDOWN
dt2=1.0/fs2
twopi=8.0*atan(1.0)
@ -98,7 +119,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
ctwk(i)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
enddo
call sync8d(cd0,i0,ctwk,1,sync)
call sync8d(cd0,i0,ctwk,1,sync)
if( sync .gt. smax ) then
smax=sync
delfbest=delf
@ -109,16 +130,15 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
call twkfreq1(cd0,NP2,fs2,a,cd0)
xdt=xdt2
f1=f1+delfbest !Improved estimate of DF
call sync8d(cd0,i0,ctwk,0,sync)
call sync8d(cd0,i0,ctwk,2,sync)
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)
if( i1.ge.0 .and. i1+31 .le. NP2-1 ) csymb=cd0(i1:i1+31)
call four2a(csymb,32,1,-1,1)
s2(0:7,k)=abs(csymb(1:8))/1e3
cs(0:7,k)=csymb(1:8)/1e3
s8(0:7,k)=abs(csymb(1:8))
enddo
! sync quality check
@ -126,11 +146,11 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
is2=0
is3=0
do k=1,7
ip=maxloc(s2(:,k))
ip=maxloc(s8(:,k))
if(icos7(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s2(:,k+36))
ip=maxloc(s8(:,k+36))
if(icos7(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s2(:,k+72))
ip=maxloc(s8(:,k+72))
if(icos7(k-1).eq.(ip(1)-1)) is3=is3+1
enddo
! hard sync sum - max is 21
@ -140,245 +160,258 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
return
endif
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)
do nsym=1,3
nt=2**(3*nsym)
do ihalf=1,2
do k=1,29,nsym
if(ihalf.eq.1) ks=k+7
if(ihalf.eq.2) ks=k+43
amax=-1.0
do i=0,nt-1
i1=i/64
i2=iand(i,63)/8
i3=iand(i,7)
if(nsym.eq.1) then
s2(i)=abs(cs(graymap(i3),ks))
elseif(nsym.eq.2) then
s2(i)=abs(cs(graymap(i2),ks)+cs(graymap(i3),ks+1))
elseif(nsym.eq.3) then
s2(i)=abs(cs(graymap(i1),ks)+cs(graymap(i2),ks+1)+cs(graymap(i3),ks+2))
else
print*,"Error - nsym must be 1, 2, or 3."
endif
enddo
s2l(0:nt-1)=log(s2(0:nt-1)+1e-32)
i32=1+(k-1)*3+(ihalf-1)*87
if(nsym.eq.1) ibmax=2
if(nsym.eq.2) ibmax=5
if(nsym.eq.3) ibmax=8
do ib=0,ibmax
bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - &
maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))
if(i32+ib .gt.174) cycle
if(nsym.eq.1) then
bmeta(i32+ib)=bm
elseif(nsym.eq.2) then
bmetb(i32+ib)=bm
elseif(nsym.eq.3) then
bmetc(i32+ib)=bm
endif
enddo
enddo
enddo
enddo
call normalizebmet(bmeta,174)
call normalizebmet(bmetb,174)
call normalizebmet(bmetc,174)
call indexx(s1sort,8*ND,indxs1)
xmeds1=s1sort(indxs1(nint(0.5*8*ND)))
s1=s1/xmeds1
scalefac=2.83
llra=scalefac*bmeta
llrb=scalefac*bmetb
llrc=scalefac*bmetc
do j=1,ND
i4=3*j-2
i2=3*j-1
i1=3*j
! Max amplitude
ps=s1(0:7,j)
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))
bmeta(i4)=r4
bmeta(i2)=r2
bmeta(i1)=r1
bmetap(i4)=r4
bmetap(i2)=r2
bmetap(i1)=r1
! Max log metric
psl=log(ps+1e-32)
r1=max(psl(1),psl(3),psl(5),psl(7))-max(psl(0),psl(2),psl(4),psl(6))
r2=max(psl(2),psl(3),psl(6),psl(7))-max(psl(0),psl(1),psl(4),psl(5))
r4=max(psl(4),psl(5),psl(6),psl(7))-max(psl(0),psl(1),psl(2),psl(3))
bmetb(i4)=r4
bmetb(i2)=r2
bmetb(i1)=r1
apmag=maxval(abs(llra))*1.01
! Metric for Cauchy noise
! r1=log(ps(1)**3+ps(3)**3+ps(5)**3+ps(7)**3)- &
! log(ps(0)**3+ps(2)**3+ps(4)**3+ps(6)**3)
! r2=log(ps(2)**3+ps(3)**3+ps(6)**3+ps(7)**3)- &
! log(ps(0)**3+ps(1)**3+ps(4)**3+ps(5)**3)
! r4=log(ps(4)**3+ps(5)**3+ps(6)**3+ps(7)**3)- &
! log(ps(0)**3+ps(1)**3+ps(2)**3+ps(3)**3)
! Metric for AWGN, no fading
! bscale=2.5
! b0=bessi0(bscale*ps(0))
! b1=bessi0(bscale*ps(1))
! b2=bessi0(bscale*ps(2))
! b3=bessi0(bscale*ps(3))
! b4=bessi0(bscale*ps(4))
! b5=bessi0(bscale*ps(5))
! b6=bessi0(bscale*ps(6))
! b7=bessi0(bscale*ps(7))
! r1=log(b1+b3+b5+b7)-log(b0+b2+b4+b6)
! r2=log(b2+b3+b6+b7)-log(b0+b1+b4+b5)
! r4=log(b4+b5+b6+b7)-log(b0+b1+b2+b3)
! pass #
!------------------------------
! 1 regular decoding, nsym=1
! 2 regular decoding, nsym=2
! 3 regular decoding, nsym=3
! 4 ap pass 1, nsym=1 (for now?)
! 5 ap pass 2
! 6 ap pass 3
! 7 ap pass 4
if(nQSOProgress .eq. 0 .or. nQSOProgress .eq. 5) then
! When bits 88:115 are set as ap bits, bit 115 lives in symbol 39 along
! with no-ap bits 116 and 117. Take care of metrics for bits 116 and 117.
if(j.eq.39) then ! take care of bits that live in symbol 39
if(apsym(28).lt.0) then
bmetap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1))
bmetap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2))
else
bmetap(i2)=max(ps(6),ps(7))-max(ps(4),ps(5))
bmetap(i1)=max(ps(5),ps(7))-max(ps(4),ps(6))
if(lapon.or.ncontest.eq.6) then !Hounds always use AP
if(.not.lapcqonly) then
npasses=3+nappasses(nQSOProgress)
else
npasses=4
endif
else
npasses=3
endif
do ipass=1,npasses
llrd=llra
if(ipass.eq.2) llrd=llrb
if(ipass.eq.3) llrd=llrc
if(ipass.le.3) then
apmask=0
iaptype=0
endif
if(ipass .gt. 3) then
llrd=llra
if(.not.lapcqonly) then
iaptype=naptypes(nQSOProgress,ipass-3)
else
iaptype=1
endif
! ncontest=0 : NONE
! 1 : NA_VHF
! 2 : EU_VHF
! 3 : FIELD DAY
! 4 : RTTY
! 5 : FOX
! 6 : HOUND
!
! Conditions that cause us to bail out of AP decoding
if(ncontest.le.4 .and. iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) cycle
if(ncontest.eq.5) cycle ! No AP for Foxes
if(ncontest.eq.6.and.f1.gt.950.0) cycle ! Hounds use AP only for signals below 950 Hz
if(iaptype.ge.2 .and. apsym(1).gt.1) cycle ! No, or nonstandard, mycall
if(iaptype.ge.3 .and. apsym(30).gt.1) cycle ! No, or nonstandard, dxcall
if(iaptype.eq.1) then ! CQ or CQ RU or CQ TEST or CQ FD
apmask=0
apmask(1:29)=1
if(ncontest.eq.0) llrd(1:29)=apmag*mcq(1:29)
if(ncontest.eq.1) llrd(1:29)=apmag*mcqtest(1:29)
if(ncontest.eq.2) llrd(1:29)=apmag*mcqtest(1:29)
if(ncontest.eq.3) llrd(1:29)=apmag*mcqfd(1:29)
if(ncontest.eq.4) llrd(1:29)=apmag*mcqru(1:29)
if(ncontest.eq.6) llrd(1:29)=apmag*mcq(1:29)
apmask(75:77)=1
llrd(75:76)=apmag*(-1)
llrd(77)=apmag*(+1)
endif
if(iaptype.eq.2) then ! MyCall,???,???
apmask=0
if(ncontest.eq.0.or.ncontest.eq.1) then
apmask(1:29)=1
llrd(1:29)=apmag*apsym(1:29)
apmask(75:77)=1
llrd(75:76)=apmag*(-1)
llrd(77)=apmag*(+1)
else if(ncontest.eq.2) then
apmask(1:28)=1
llrd(1:28)=apmag*apsym(1:28)
apmask(72:74)=1
llrd(72)=apmag*(-1)
llrd(73)=apmag*(+1)
llrd(74)=apmag*(-1)
apmask(75:77)=1
llrd(75:77)=apmag*(-1)
else if(ncontest.eq.3) then
apmask(1:28)=1
llrd(1:28)=apmag*apsym(1:28)
apmask(75:77)=1
llrd(75:77)=apmag*(-1)
else if(ncontest.eq.4) then
apmask(2:29)=1
llrd(2:29)=apmag*apsym(1:28)
apmask(75:77)=1
llrd(75)=apmag*(-1)
llrd(76:77)=apmag*(+1)
else if(ncontest.eq.6) then ! ??? RR73; MyCall <???> ???
apmask(29:56)=1
llrd(29:56)=apmag*apsym(1:28)
apmask(72:77)=1
llrd(72:73)=apmag*(-1)
llrd(74)=apmag*(+1)
llrd(75:77)=apmag*(-1)
endif
endif
if(iaptype.eq.3) then ! MyCall,DxCall,???
apmask=0
if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.2.or.ncontest.eq.6) then
apmask(1:58)=1
llrd(1:58)=apmag*apsym
apmask(75:77)=1
llrd(75:76)=apmag*(-1)
llrd(77)=apmag*(+1)
else if(ncontest.eq.3) then ! Field Day
apmask(1:56)=1
llrd(1:28)=apmag*apsym(1:28)
llrd(29:56)=apmag*apsym(30:57)
apmask(72:74)=1
apmask(75:77)=1
llrd(75:77)=apmag*(-1)
else if(ncontest.eq.4) then ! RTTY RU
apmask(2:57)=1
llrd(2:29)=apmag*apsym(1:28)
llrd(30:57)=apmag*apsym(30:57)
apmask(75:77)=1
llrd(75)=apmag*(-1)
llrd(76:77)=apmag*(+1)
endif
endif
if(iaptype.eq.5.and.ncontest.eq.6) cycle !Hound
if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then
apmask=0
if(ncontest.le.4 .or. (ncontest.eq.6.and.iaptype.eq.6)) then
apmask(1:77)=1 ! mycall, hiscall, RRR|73|RR73
llrd(1:58)=apmag*apsym
if(iaptype.eq.4) llrd(59:77)=apmag*mrrr
if(iaptype.eq.5) llrd(59:77)=apmag*m73
if(iaptype.eq.6) llrd(59:77)=apmag*mrr73
else if(ncontest.eq.6.and.iaptype.eq.4) then ! Hound listens for MyCall RR73;...
apmask(1:28)=1
llrd(1:28)=apmag*apsym(1:28)
apmask(72:77)=1
llrd(72:73)=apmag*(-1)
llrd(74)=apmag*(1)
llrd(75:77)=apmag*(-1)
endif
endif
endif
! When bits 116:143 are set as ap bits, bit 115 lives in symbol 39 along
! with ap bits 116 and 117. Take care of metric for bit 115.
! if(j.eq.39) then ! take care of bit 115
! iii=2*(apsym(29)+1)/2 + (apsym(30)+1)/2 ! known values of bits 116 & 117
! if(iii.eq.0) bmetap(i4)=ps(4)-ps(0)
! if(iii.eq.1) bmetap(i4)=ps(5)-ps(1)
! if(iii.eq.2) bmetap(i4)=ps(6)-ps(2)
! if(iii.eq.3) bmetap(i4)=ps(7)-ps(3)
! endif
! bit 144 lives in symbol 48 and will be 1 if it is set as an ap bit.
! take care of metrics for bits 142 and 143
if(j.eq.48) then ! bit 144 is always 1
bmetap(i4)=max(ps(5),ps(7))-max(ps(1),ps(3))
bmetap(i2)=max(ps(3),ps(7))-max(ps(1),ps(5))
endif
! bit 154 lives in symbol 52 and will be 0 if it is set as an ap bit
! take care of metrics for bits 155 and 156
if(j.eq.52) then ! bit 154 will be 0 if it is set as an ap bit.
bmetap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1))
bmetap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2))
endif
enddo
call normalizebmet(bmeta,3*ND)
call normalizebmet(bmetb,3*ND)
call normalizebmet(bmetap,3*ND)
scalefac=2.83
llr0=scalefac*bmeta
llr1=scalefac*bmetb
llra=scalefac*bmetap ! llr's for use with ap
apmag=scalefac*(maxval(abs(bmetap))*1.01)
! pass #
!------------------------------
! 1 regular decoding
! 2 erase 24
! 3 erase 48
! 4 ap pass 1
! 5 ap pass 2
! 6 ap pass 3
! 7 ap pass 4, etc.
if(lapon) then
if(.not.lapcqonly) then
npasses=4+nappasses(nQSOProgress)
else
npasses=5
endif
else
npasses=4
endif
do ipass=1,npasses
llr=llr0
if(ipass.eq.2) llr=llr1
if(ipass.eq.3) llr(1:24)=0.
if(ipass.eq.4) llr(1:48)=0.
if(ipass.le.4) then
apmask=0
llrap=llr
iaptype=0
endif
if(ipass .gt. 4) then
if(.not.lapcqonly) then
iaptype=naptypes(nQSOProgress,ipass-4)
else
iaptype=1
endif
if(iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) cycle
if(iaptype.eq.1 .or. iaptype.eq.2 ) then ! AP,???,???
apmask=0
apmask(88:115)=1 ! first 28 bits are AP
apmask(144)=1 ! not free text
llrap=llr
if(iaptype.eq.1) llrap(88:115)=apmag*mcq
if(iaptype.eq.2) llrap(88:115)=apmag*apsym(1:28)
llrap(116:117)=llra(116:117)
llrap(142:143)=llra(142:143)
llrap(144)=-apmag
endif
if(iaptype.eq.3) then ! mycall, dxcall, ???
apmask=0
apmask(88:115)=1 ! mycall
apmask(116:143)=1 ! hiscall
apmask(144)=1 ! not free text
llrap=llr
llrap(88:143)=apmag*apsym(1:56)
llrap(144)=-apmag
endif
if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then
apmask=0
apmask(88:115)=1 ! mycall
apmask(116:143)=1 ! hiscall
apmask(144:159)=1 ! RRR or 73 or RR73
llrap=llr
llrap(88:143)=apmag*apsym(1:56)
if(iaptype.eq.4) llrap(144:159)=apmag*mrrr
if(iaptype.eq.5) llrap(144:159)=apmag*m73
if(iaptype.eq.6) llrap(144:159)=apmag*mrr73
endif
if(iaptype.eq.7) then ! ???, dxcall, ???
apmask=0
apmask(116:143)=1 ! hiscall
apmask(144)=1 ! not free text
llrap=llr
llrap(115)=llra(115)
llrap(116:143)=apmag*apsym(29:56)
llrap(144)=-apmag
endif
endif
cw=0
call bpdecode174(llrap,apmask,max_iterations,decoded,cw,nharderrors, &
call bpdecode174_91(llrd,apmask,max_iterations,message77,cw,nharderrors, &
niterations)
dmin=0.0
if(ndepth.eq.3 .and. nharderrors.lt.0) then
ndeep=3
if(abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid) then
if((ipass.eq.3 .or. ipass.eq.4) .and. .not.nagain) then
ndeep=3
else
ndeep=4
endif
ndeep=4
endif
if(nagain) ndeep=5
call osd174(llrap,apmask,ndeep,decoded,cw,nharderrors,dmin)
call osd174_91(llrd,apmask,ndeep,message77,cw,nharderrors,dmin)
endif
nbadcrc=1
message=' '
xsnr=-99.0
msg37=' '
if(nharderrors.lt.0 .or. nharderrors.gt.36) cycle
if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword
if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. &
.not.(sync.lt.2.0 .and. nharderrors.gt.35) .and. &
.not.(ipass.gt.2 .and. nharderrors.gt.39) .and. &
.not.(ipass.eq.4 .and. nharderrors.gt.30) &
) then
call chkcrc12a(decoded,nbadcrc)
else
nharderrors=-1
write(c77,'(77i1)') message77
read(c77(72:74),'(b3)') n3
read(c77(75:77),'(b3)') i3
if(i3.gt.4 .or. (i3.eq.0.and.n3.gt.5)) then
cycle
endif
if(nbadcrc.eq.0) then
call extractmessage174(decoded,message,msgcall,msggrid,ncrcflag)
call genft8(message,0,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
xsnr2=db(xsig/xbase - 1.0) - 32.0
if(.not.nagain) xsnr=xsnr2
if(xsnr .lt. -24.0) xsnr=-24.0
return
call unpack77(c77,msg37,msgcall,msggrid,unpk77_success)
if(.not.unpk77_success) then
cycle
endif
enddo
nbadcrc=0 ! If we get this far: valid codeword, valid (i3,n3), nonquirky message.
call get_tones_from_77bits(message77,itone)
if(lsubtract) call subtractft8(dd0,itone,f1,xdt)
xsig=0.0
xnoi=0.0
do i=1,79
xsig=xsig+s8(itone(i),i)**2
ios=mod(itone(i)+4,7)
xnoi=xnoi+s8(ios,i)**2
enddo
xsnr=0.001
xsnr2=0.001
arg=xsig/xnoi-1.0
if(arg.gt.0.1) xsnr=arg
arg=xsig/xbase/2.6e6-1.0
if(arg.gt.0.1) xsnr2=arg
xsnr=10.0*log10(xsnr)-27.0
xsnr2=10.0*log10(xsnr2)-27.0
if(.not.nagain) then
xsnr=xsnr2
endif
if(xsnr .lt. -24.0) xsnr=-24.0
return
enddo
return
end subroutine ft8b
@ -420,4 +453,3 @@ function bessi0(x)
endif
return
end function bessi0

85
ft8d.f90
View File

@ -3,14 +3,16 @@ program ft8d
! Decode FT8 data read from *.c2 files.
include 'ft8_params.f90'
character infile*80,date*6,time*4
character msgcall*6,msggrid*4
character infile*80,msg37*37,date*6,time*4
character msgcall*13,msggrid*4
character*37 allmessages(100)
real s(NFFT1,NHSYM)
real sbase(NFFT1)
real candidate(3,MAXCAND)
real*8 dialfreq
complex dd(NMAX,4)
logical newdat
logical newdat,lft8apon,lsubtract,ldupe
integer allsnrs(100)
integer apsym(KK)
nargs=iargc()
@ -19,13 +21,6 @@ program ft8d
go to 999
endif
twopi=8.0*atan(1.0)
fs=4000.0 !Sample rate
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
ts=2*NSPS*dt !Duration of OQPSK symbols (s)
baud=1.0/tt !Keying rate (baud)
txt=NZ*dt !Transmission length (s)
nfa=-1600
nfb=+1600
nfqso=0
@ -38,29 +33,59 @@ program ft8d
date=infile(j2-11:j2-6)
time=infile(j2-4:j2-1)
do ipart=1,4
nQSOProgress=0
ndecodes=0
n2=0
allmessages=' '
allsnrs=0
ncontest=0
lft8apon=.false.
ndepth=1
newdat=.true.
syncmin=1.5
call sync8(dd(1:NMAX,ipart),nfa+2000,nfb+2000,syncmin, &
nfqso+2000,s,candidate,ncand,sbase)
do icand=1,ncand
sync=candidate(3,icand)
f1=candidate(1,icand)
xdt=candidate(2,icand)
xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0))
call ft8b(dd(1:NMAX,ipart),newdat,nQSOProgress,nfqso+2000, &
nftx,ndepth,lft8apon,lapcqonly,napwid,nagain,iaptype, &
f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,iappass, &
msgcall,msggrid,xsnr)
nsnr=nint(xsnr)
xdt=xdt-0.5
hd=nharderrors+dmin
if(nbadcrc.eq.0) then
write(*,1004) date,time,15*(ipart-1),min(sync,999.0),nint(xsnr), &
xdt,nint(f1-2000+dialfreq),msgcall,msggrid
1004 format(a6,1x,a4,i2.2,f6.1,i4,f6.2,i9,1x,a6,1x,a4)
if(ndepth.eq.1) npass=1
if(ndepth.ge.2) npass=3
do ipass=1,npass
newdat=.true.
syncmin=1.5
if(ipass.eq.1) then
lsubtract=.true.
if(ndepth.eq.1) lsubtract=.false.
elseif(ipass.eq.2) then
n2=ndecodes
if(ndecodes.eq.0) cycle
lsubtract=.true.
elseif(ipass.eq.3) then
if((ndecodes-n2).eq.0) cycle
lsubtract=.false.
endif
call sync8(dd(1:NMAX,ipart),nfa+2000,nfb+2000,syncmin, &
nfqso+2000,s,candidate,ncand,sbase)
do icand=1,ncand
sync=candidate(3,icand)
f1=candidate(1,icand)
xdt=candidate(2,icand)
xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0))
call ft8b(dd(1:NMAX,ipart),newdat,nQSOProgress,nfqso+2000, &
nftx,ndepth,lft8apon,lapcqonly,napwid,lsubtract,nagain, &
ncontest,iaptype,f1,xdt,xbase,apsym,nharderrors,dmin, &
nbadcrc,iappass,msg37,msgcall,msggrid,xsnr)
nsnr=nint(xsnr)
xdt=xdt-0.5
hd=nharderrors+dmin
if(nbadcrc.eq.0) then
ldupe=.false.
do id=1,ndecodes
if(msg37.eq.allmessages(id).and.nsnr.le.allsnrs(id)) ldupe=.true.
enddo
if(.not.ldupe) then
ndecodes=ndecodes+1
allmessages(ndecodes)=msg37
allsnrs(ndecodes)=nsnr
endif
write(*,1004) date,time,15*(ipart-1),min(sync,999.0),nint(xsnr), &
xdt,nint(f1-2000+dialfreq),msgcall,msggrid
1004 format(a6,1x,a4,i2.2,f6.1,i4,f6.2,i9,1x,a13,1x,a4)
endif
enddo
enddo
enddo ! ipart loop

51
genft8.f90
View File

@ -1,35 +1,33 @@
subroutine genft8(msg,i3bit,itone)
subroutine genft8(msg,i3,n3,msgsent,msgbits,itone)
! Encode an FT8 message, producing array itone().
use crc
use packjt
use packjt77
include 'ft8_params.f90'
character*22 msg
character*87 cbits
integer*4 i4Msg6BitWords(12) !72-bit message as 6-bit words
integer*1 msgbits(KK),codeword(3*ND)
integer*1, target:: i1Msg8BitBytes(11)
integer itone(NN)
character msg*37,msgsent*37,msgcall*13,msggrid*4
character*77 c77
integer*1 msgbits(77),codeword(174)
integer itone(79)
integer icos7(0:6)
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
integer graymap(0:7)
logical unpk77_success
data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern
data graymap/0,1,3,2,5,6,4,7/
call packmsg(msg,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes
i3=-1
n3=-1
call pack77(msg,i3,n3,c77)
call unpack77(c77,msgsent,msgcall,msggrid,unpk77_success)
read(c77,'(77i1)',err=1) msgbits
if(unpk77_success) go to 2
1 msgbits=0
itone=0
msgsent='*** bad message *** '
go to 900
write(cbits,1000) i4Msg6BitWords,32*i3bit
1000 format(12b6.6,b8.8)
read(cbits,1001) i1Msg8BitBytes(1:10)
1001 format(10b8)
i1Msg8BitBytes(10)=iand(i1Msg8BitBytes(10),128+64+32)
i1Msg8BitBytes(11)=0
icrc12=crc12(c_loc(i1Msg8BitBytes),11)
entry get_tones_from_77bits(msgbits,itone)
write(cbits,1003) i4Msg6BitWords,i3bit,icrc12
1003 format(12b6.6,b3.3,b12.12)
read(cbits,1004) msgbits
1004 format(87i1)
call encode174(msgbits,codeword) !Encode the test message
2 call encode174_91(msgbits,codeword) !Encode the test message
! Message structure: S7 D29 S7 D29 S7
itone(1:7)=icos7
@ -40,8 +38,9 @@ subroutine genft8(msg,i3bit,itone)
i=3*j -2
k=k+1
if(j.eq.30) k=k+7
itone(k)=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2)
indx=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2)
itone(k)=graymap(indx)
enddo
return
900 return
end subroutine genft8

23
genft8refsig.f90 Normal file
View File

@ -0,0 +1,23 @@
subroutine genft8refsig(itone,cref,f0)
complex cref(79*640)
integer itone(79)
! real*8 twopi,phi,dphi,dt,xnsps
real twopi,phi,dphi,dt,xnsps
data twopi/0.d0/
save twopi
if( twopi .lt. 0.1 ) twopi=8.d0*atan(1.d0)
xnsps=640.d0
dt=1.d0/4000.d0
phi=0.d0
k=1
do i=1,79
dphi=twopi*(f0*dt+itone(i)/xnsps)
do is=1,640
cref(k)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
k=k+1
enddo
enddo
return
end subroutine genft8refsig

102
ldpc_174_87_params.f90
View File

@ -1,102 +0,0 @@
integer, parameter:: N=174, K=87, M=N-K
character*22 g(87)
integer colorder(N)
data g/ & !parity generator matrix for (174,87) code
"23bba830e23b6b6f50982e", &
"1f8e55da218c5df3309052", &
"ca7b3217cd92bd59a5ae20", &
"56f78313537d0f4382964e", &
"29c29dba9c545e267762fe", &
"6be396b5e2e819e373340c", &
"293548a138858328af4210", &
"cb6c6afcdc28bb3f7c6e86", &
"3f2a86f5c5bd225c961150", &
"849dd2d63673481860f62c", &
"56cdaec6e7ae14b43feeee", &
"04ef5cfa3766ba778f45a4", &
"c525ae4bd4f627320a3974", &
"fe37802941d66dde02b99c", &
"41fd9520b2e4abeb2f989c", &
"40907b01280f03c0323946", &
"7fb36c24085a34d8c1dbc4", &
"40fc3e44bb7d2bb2756e44", &
"d38ab0a1d2e52a8ec3bc76", &
"3d0f929ef3949bd84d4734", &
"45d3814f504064f80549ae", &
"f14dbf263825d0bd04b05e", &
"f08a91fb2e1f78290619a8", &
"7a8dec79a51e8ac5388022", &
"ca4186dd44c3121565cf5c", &
"db714f8f64e8ac7af1a76e", &
"8d0274de71e7c1a8055eb0", &
"51f81573dd4049b082de14", &
"d037db825175d851f3af00", &
"d8f937f31822e57c562370", &
"1bf1490607c54032660ede", &
"1616d78018d0b4745ca0f2", &
"a9fa8e50bcb032c85e3304", &
"83f640f1a48a8ebc0443ea", &
"eca9afa0f6b01d92305edc", &
"3776af54ccfbae916afde6", &
"6abb212d9739dfc02580f2", &
"05209a0abb530b9e7e34b0", &
"612f63acc025b6ab476f7c", &
"0af7723161ec223080be86", &
"a8fc906976c35669e79ce0", &
"45b7ab6242b77474d9f11a", &
"b274db8abd3c6f396ea356", &
"9059dfa2bb20ef7ef73ad4", &
"3d188ea477f6fa41317a4e", &
"8d9071b7e7a6a2eed6965e", &
"a377253773ea678367c3f6", &
"ecbd7c73b9cd34c3720c8a", &
"b6537f417e61d1a7085336", &
"6c280d2a0523d9c4bc5946", &
"d36d662a69ae24b74dcbd8", &
"d747bfc5fd65ef70fbd9bc", &
"a9fa2eefa6f8796a355772", &
"cc9da55fe046d0cb3a770c", &
"f6ad4824b87c80ebfce466", &
"cc6de59755420925f90ed2", &
"164cc861bdd803c547f2ac", &
"c0fc3ec4fb7d2bb2756644", &
"0dbd816fba1543f721dc72", &
"a0c0033a52ab6299802fd2", &
"bf4f56e073271f6ab4bf80", &
"57da6d13cb96a7689b2790", &
"81cfc6f18c35b1e1f17114", &
"481a2a0df8a23583f82d6c", &
"1ac4672b549cd6dba79bcc", &
"c87af9a5d5206abca532a8", &
"97d4169cb33e7435718d90", &
"a6573f3dc8b16c9d19f746", &
"2c4142bf42b01e71076acc", &
"081c29a10d468ccdbcecb6", &
"5b0f7742bca86b8012609a", &
"012dee2198eba82b19a1da", &
"f1627701a2d692fd9449e6", &
"35ad3fb0faeb5f1b0c30dc", &
"b1ca4ea2e3d173bad4379c", &
"37d8e0af9258b9e8c5f9b2", &
"cd921fdf59e882683763f6", &
"6114e08483043fd3f38a8a", &
"2e547dd7a05f6597aac516", &
"95e45ecd0135aca9d6e6ae", &
"b33ec97be83ce413f9acc8", &
"c8b5dffc335095dcdcaf2a", &
"3dd01a59d86310743ec752", &
"14cd0f642fc0c5fe3a65ca", &
"3a0a1dfd7eee29c2e827e0", &
"8abdb889efbe39a510a118", &
"3f231f212055371cf3e2a2"/
data colorder/ &
0, 1, 2, 3, 30, 4, 5, 6, 7, 8, 9, 10, 11, 32, 12, 40, 13, 14, 15, 16,&
17, 18, 37, 45, 29, 19, 20, 21, 41, 22, 42, 31, 33, 34, 44, 35, 47, 51, 50, 43,&
36, 52, 63, 46, 25, 55, 27, 24, 23, 53, 39, 49, 59, 38, 48, 61, 60, 57, 28, 62,&
56, 58, 65, 66, 26, 70, 64, 69, 68, 67, 74, 71, 54, 76, 72, 75, 78, 77, 80, 79,&
73, 83, 84, 81, 82, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,&
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,&
120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,&
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,&
160,161,162,163,164,165,166,167,168,169,170,171,172,173/

86
ldpc_174_91_c_generator.f90 Normal file
View File

@ -0,0 +1,86 @@
character*23 g(83)
data g/ &
"8329ce11bf31eaf509f27fc", &
"761c264e25c259335493132", &
"dc265902fb277c6410a1bdc", &
"1b3f417858cd2dd33ec7f62", &
"09fda4fee04195fd034783a", &
"077cccc11b8873ed5c3d48a", &
"29b62afe3ca036f4fe1a9da", &
"6054faf5f35d96d3b0c8c3e", &
"e20798e4310eed27884ae90", &
"775c9c08e80e26ddae56318", &
"b0b811028c2bf997213487c", &
"18a0c9231fc60adf5c5ea32", &
"76471e8302a0721e01b12b8", &
"ffbccb80ca8341fafb47b2e", &
"66a72a158f9325a2bf67170", &
"c4243689fe85b1c51363a18", &
"0dff739414d1a1b34b1c270", &
"15b48830636c8b99894972e", &
"29a89c0d3de81d665489b0e", &
"4f126f37fa51cbe61bd6b94", &
"99c47239d0d97d3c84e0940", &
"1919b75119765621bb4f1e8", &
"09db12d731faee0b86df6b8", &
"488fc33df43fbdeea4eafb4", &
"827423ee40b675f756eb5fe", &
"abe197c484cb74757144a9a", &
"2b500e4bc0ec5a6d2bdbdd0", &
"c474aa53d70218761669360", &
"8eba1a13db3390bd6718cec", &
"753844673a27782cc42012e", &
"06ff83a145c37035a5c1268", &
"3b37417858cc2dd33ec3f62", &
"9a4a5a28ee17ca9c324842c", &
"bc29f465309c977e89610a4", &
"2663ae6ddf8b5ce2bb29488", &
"46f231efe457034c1814418", &
"3fb2ce85abe9b0c72e06fbe", &
"de87481f282c153971a0a2e", &
"fcd7ccf23c69fa99bba1412", &
"f0261447e9490ca8e474cec", &
"4410115818196f95cdd7012", &
"088fc31df4bfbde2a4eafb4", &
"b8fef1b6307729fb0a078c0", &
"5afea7acccb77bbc9d99a90", &
"49a7016ac653f65ecdc9076", &
"1944d085be4e7da8d6cc7d0", &
"251f62adc4032f0ee714002", &
"56471f8702a0721e00b12b8", &
"2b8e4923f2dd51e2d537fa0", &
"6b550a40a66f4755de95c26", &
"a18ad28d4e27fe92a4f6c84", &
"10c2e586388cb82a3d80758", &
"ef34a41817ee02133db2eb0", &
"7e9c0c54325a9c15836e000", &
"3693e572d1fde4cdf079e86", &
"bfb2cec5abe1b0c72e07fbe", &
"7ee18230c583cccc57d4b08", &
"a066cb2fedafc9f52664126", &
"bb23725abc47cc5f4cc4cd2", &
"ded9dba3bee40c59b5609b4", &
"d9a7016ac653e6decdc9036", &
"9ad46aed5f707f280ab5fc4", &
"e5921c77822587316d7d3c2", &
"4f14da8242a8b86dca73352", &
"8b8b507ad467d4441df770e", &
"22831c9cf1169467ad04b68", &
"213b838fe2ae54c38ee7180", &
"5d926b6dd71f085181a4e12", &
"66ab79d4b29ee6e69509e56", &
"958148682d748a38dd68baa", &
"b8ce020cf069c32a723ab14", &
"f4331d6d461607e95752746", &
"6da23ba424b9596133cf9c8", &
"a636bcbc7b30c5fbeae67fe", &
"5cb0d86a07df654a9089a20", &
"f11f106848780fc9ecdd80a", &
"1fbb5364fb8d2c9d730d5ba", &
"fcb86bc70a50c9d02a5d034", &
"a534433029eac15f322e34c", &
"c989d9c7c3d3b8c55d75130", &
"7bb38b2f0186d46643ae962", &
"2644ebadeb44b9467d1f42c", &
"608cc857594bfbb55d69600"/

270
ldpc_174_91_c_reordered_parity.f90 Normal file
View File

@ -0,0 +1,270 @@
data Mn/ &
16, 45, 73, &
25, 51, 62, &
33, 58, 78, &
1, 44, 45, &
2, 7, 61, &
3, 6, 54, &
4, 35, 48, &
5, 13, 21, &
8, 56, 79, &
9, 64, 69, &
10, 19, 66, &
11, 36, 60, &
12, 37, 58, &
14, 32, 43, &
15, 63, 80, &
17, 28, 77, &
18, 74, 83, &
22, 53, 81, &
23, 30, 34, &
24, 31, 40, &
26, 41, 76, &
27, 57, 70, &
29, 49, 65, &
3, 38, 78, &
5, 39, 82, &
46, 50, 73, &
51, 52, 74, &
55, 71, 72, &
44, 67, 72, &
43, 68, 78, &
1, 32, 59, &
2, 6, 71, &
4, 16, 54, &
7, 65, 67, &
8, 30, 42, &
9, 22, 31, &
10, 18, 76, &
11, 23, 82, &
12, 28, 61, &
13, 52, 79, &
14, 50, 51, &
15, 81, 83, &
17, 29, 60, &
19, 33, 64, &
20, 26, 73, &
21, 34, 40, &
24, 27, 77, &
25, 55, 58, &
35, 53, 66, &
36, 48, 68, &
37, 46, 75, &
38, 45, 47, &
39, 57, 69, &
41, 56, 62, &
20, 49, 53, &
46, 52, 63, &
45, 70, 75, &
27, 35, 80, &
1, 15, 30, &
2, 68, 80, &
3, 36, 51, &
4, 28, 51, &
5, 31, 56, &
6, 20, 37, &
7, 40, 82, &
8, 60, 69, &
9, 10, 49, &
11, 44, 57, &
12, 39, 59, &
13, 24, 55, &
14, 21, 65, &
16, 71, 78, &
17, 30, 76, &
18, 25, 80, &
19, 61, 83, &
22, 38, 77, &
23, 41, 50, &
7, 26, 58, &
29, 32, 81, &
33, 40, 73, &
18, 34, 48, &
13, 42, 64, &
5, 26, 43, &
47, 69, 72, &
54, 55, 70, &
45, 62, 68, &
10, 63, 67, &
14, 66, 72, &
22, 60, 74, &
35, 39, 79, &
1, 46, 64, &
1, 24, 66, &
2, 5, 70, &
3, 31, 65, &
4, 49, 58, &
1, 4, 5, &
6, 60, 67, &
7, 32, 75, &
8, 48, 82, &
9, 35, 41, &
10, 39, 62, &
11, 14, 61, &
12, 71, 74, &
13, 23, 78, &
11, 35, 55, &
15, 16, 79, &
7, 9, 16, &
17, 54, 63, &
18, 50, 57, &
19, 30, 47, &
20, 64, 80, &
21, 28, 69, &
22, 25, 43, &
13, 22, 37, &
2, 47, 51, &
23, 54, 74, &
26, 34, 72, &
27, 36, 37, &
21, 36, 63, &
29, 40, 44, &
19, 26, 57, &
3, 46, 82, &
14, 15, 58, &
33, 52, 53, &
30, 43, 52, &
6, 9, 52, &
27, 33, 65, &
25, 69, 73, &
38, 55, 83, &
20, 39, 77, &
18, 29, 56, &
32, 48, 71, &
42, 51, 59, &
28, 44, 79, &
34, 60, 62, &
31, 45, 61, &
46, 68, 77, &
6, 24, 76, &
8, 10, 78, &
40, 41, 70, &
17, 50, 53, &
42, 66, 68, &
4, 22, 72, &
36, 64, 81, &
13, 29, 47, &
2, 8, 81, &
56, 67, 73, &
5, 38, 50, &
12, 38, 64, &
59, 72, 80, &
3, 26, 79, &
45, 76, 81, &
1, 65, 74, &
7, 18, 77, &
11, 56, 59, &
14, 39, 54, &
16, 37, 66, &
10, 28, 55, &
15, 60, 70, &
17, 25, 82, &
20, 30, 31, &
12, 67, 68, &
23, 75, 80, &
27, 32, 62, &
24, 69, 75, &
19, 21, 71, &
34, 53, 61, &
35, 46, 47, &
33, 59, 76, &
40, 43, 83, &
41, 42, 63, &
49, 75, 83, &
20, 44, 48, &
42, 49, 57/
data Nm/ &
4, 31, 59, 91, 92, 96, 153, &
5, 32, 60, 93, 115, 146, 0, &
6, 24, 61, 94, 122, 151, 0, &
7, 33, 62, 95, 96, 143, 0, &
8, 25, 63, 83, 93, 96, 148, &
6, 32, 64, 97, 126, 138, 0, &
5, 34, 65, 78, 98, 107, 154, &
9, 35, 66, 99, 139, 146, 0, &
10, 36, 67, 100, 107, 126, 0, &
11, 37, 67, 87, 101, 139, 158, &
12, 38, 68, 102, 105, 155, 0, &
13, 39, 69, 103, 149, 162, 0, &
8, 40, 70, 82, 104, 114, 145, &
14, 41, 71, 88, 102, 123, 156, &
15, 42, 59, 106, 123, 159, 0, &
1, 33, 72, 106, 107, 157, 0, &
16, 43, 73, 108, 141, 160, 0, &
17, 37, 74, 81, 109, 131, 154, &
11, 44, 75, 110, 121, 166, 0, &
45, 55, 64, 111, 130, 161, 173, &
8, 46, 71, 112, 119, 166, 0, &
18, 36, 76, 89, 113, 114, 143, &
19, 38, 77, 104, 116, 163, 0, &
20, 47, 70, 92, 138, 165, 0, &
2, 48, 74, 113, 128, 160, 0, &
21, 45, 78, 83, 117, 121, 151, &
22, 47, 58, 118, 127, 164, 0, &
16, 39, 62, 112, 134, 158, 0, &
23, 43, 79, 120, 131, 145, 0, &
19, 35, 59, 73, 110, 125, 161, &
20, 36, 63, 94, 136, 161, 0, &
14, 31, 79, 98, 132, 164, 0, &
3, 44, 80, 124, 127, 169, 0, &
19, 46, 81, 117, 135, 167, 0, &
7, 49, 58, 90, 100, 105, 168, &
12, 50, 61, 118, 119, 144, 0, &
13, 51, 64, 114, 118, 157, 0, &
24, 52, 76, 129, 148, 149, 0, &
25, 53, 69, 90, 101, 130, 156, &
20, 46, 65, 80, 120, 140, 170, &
21, 54, 77, 100, 140, 171, 0, &
35, 82, 133, 142, 171, 174, 0, &
14, 30, 83, 113, 125, 170, 0, &
4, 29, 68, 120, 134, 173, 0, &
1, 4, 52, 57, 86, 136, 152, &
26, 51, 56, 91, 122, 137, 168, &
52, 84, 110, 115, 145, 168, 0, &
7, 50, 81, 99, 132, 173, 0, &
23, 55, 67, 95, 172, 174, 0, &
26, 41, 77, 109, 141, 148, 0, &
2, 27, 41, 61, 62, 115, 133, &
27, 40, 56, 124, 125, 126, 0, &
18, 49, 55, 124, 141, 167, 0, &
6, 33, 85, 108, 116, 156, 0, &
28, 48, 70, 85, 105, 129, 158, &
9, 54, 63, 131, 147, 155, 0, &
22, 53, 68, 109, 121, 174, 0, &
3, 13, 48, 78, 95, 123, 0, &
31, 69, 133, 150, 155, 169, 0, &
12, 43, 66, 89, 97, 135, 159, &
5, 39, 75, 102, 136, 167, 0, &
2, 54, 86, 101, 135, 164, 0, &
15, 56, 87, 108, 119, 171, 0, &
10, 44, 82, 91, 111, 144, 149, &
23, 34, 71, 94, 127, 153, 0, &
11, 49, 88, 92, 142, 157, 0, &
29, 34, 87, 97, 147, 162, 0, &
30, 50, 60, 86, 137, 142, 162, &
10, 53, 66, 84, 112, 128, 165, &
22, 57, 85, 93, 140, 159, 0, &
28, 32, 72, 103, 132, 166, 0, &
28, 29, 84, 88, 117, 143, 150, &
1, 26, 45, 80, 128, 147, 0, &
17, 27, 89, 103, 116, 153, 0, &
51, 57, 98, 163, 165, 172, 0, &
21, 37, 73, 138, 152, 169, 0, &
16, 47, 76, 130, 137, 154, 0, &
3, 24, 30, 72, 104, 139, 0, &
9, 40, 90, 106, 134, 151, 0, &
15, 58, 60, 74, 111, 150, 163, &
18, 42, 79, 144, 146, 152, 0, &
25, 38, 65, 99, 122, 160, 0, &
17, 42, 75, 129, 170, 172, 0/
data nrw/ &
7,6,6,6,7,6,7,6,6,7,6,6,7,7,6,6, &
6,7,6,7,6,7,6,6,6,7,6,6,6,7,6,6, &
6,6,7,6,6,6,7,7,6,6,6,6,7,7,6,6, &
6,6,7,6,6,6,7,6,6,6,6,7,6,6,6,7, &
6,6,6,7,7,6,6,7,6,6,6,6,6,6,6,7, &
6,6,6/
ncw=3

81
osd174.f90 → osd174_91.f90
View File

@ -1,9 +1,8 @@
subroutine osd174(llr,apmask,ndeep,decoded,cw,nhardmin,dmin)
subroutine osd174_91(llr,apmask,ndeep,message77,cw,nhardmin,dmin)
!
! An ordered-statistics decoder for the (174,87) code.
! An ordered-statistics decoder for the (174,91) code.
!
include "ldpc_174_87_params.f90"
integer, parameter:: N=174, K=91, M=N-K
integer*1 apmask(N),apmaskr(N)
integer*1 gen(K,N)
integer*1 genmrb(K,N),g2(N,K)
@ -12,8 +11,12 @@ integer*1 r2pat(N-K)
integer indices(N),nxor(N)
integer*1 cw(N),ce(N),c0(N),hdec(N)
integer*1 decoded(K)
integer*1 message77(77)
integer indx(N)
real llr(N),rx(N),absrx(N)
include "ldpc_174_91_c_generator.f90"
logical first,reset
data first/.true./
save first,gen
@ -21,23 +24,24 @@ save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,22
do j=1,23
read(g(i)(j:j),"(Z1)") istr
do jj=1, 4
irow=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(irow,i)=1
enddo
ibmax=4
if(j.eq.23) ibmax=3
do jj=1, ibmax
irow=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(irow,K+i)=1
enddo
enddo
enddo
do irow=1,K
gen(irow,M+irow)=1
gen(irow,irow)=1
enddo
first=.false.
endif
! Re-order received vector to place systematic msg bits at the end.
rx=llr(colorder+1)
apmaskr=apmask(colorder+1)
rx=llr
apmaskr=apmask
! Hard decisions on the received word.
hdec=0
@ -92,7 +96,7 @@ absrx=absrx(indices)
rx=rx(indices)
apmaskr=apmaskr(indices)
call mrbencode(m0,c0,g2,N,K)
call mrbencode91(m0,c0,g2,N,K)
nxor=ieor(c0,hdec)
nhardmin=sum(nxor)
dmin=sum(nxor*absrx)
@ -155,7 +159,7 @@ do iorder=1,nord
ntotal=ntotal+1
me=ieor(m0,mi)
if(n1.eq.iflag) then
call mrbencode(me,ce,g2,N,K)
call mrbencode91(me,ce,g2,N,K)
e2sub=ieor(ce(K+1:N),hdec(K+1:N))
e2=e2sub
nd1Kpt=sum(e2sub(1:nt))+1
@ -165,7 +169,7 @@ do iorder=1,nord
nd1Kpt=sum(e2(1:nt))+2
endif
if(nd1Kpt .le. ntheta) then
call mrbencode(me,ce,g2,N,K)
call mrbencode91(me,ce,g2,N,K)
nxor=ieor(ce,hdec)
if(n1.eq.iflag) then
dd=d1+sum(e2sub*absrx(K+1:N))
@ -184,7 +188,7 @@ do iorder=1,nord
enddo
! Get the next test error pattern, iflag will go negative
! when the last pattern with weight iorder has been generated.
call nextpat(misub,k,iorder,iflag)
call nextpat91(misub,k,iorder,iflag)
enddo
enddo
@ -195,7 +199,7 @@ if(npre2.eq.1) then
do i2=i1-1,1,-1
ntotal=ntotal+1
mi(1:ntau)=ieor(g2(K+1:K+ntau,i1),g2(K+1:K+ntau,i2))
call boxit(reset,mi(1:ntau),ntau,ntotal,i1,i2)
call boxit91(reset,mi(1:ntau),ntau,ntotal,i1,i2)
enddo
enddo
@ -208,7 +212,7 @@ if(npre2.eq.1) then
iflag=K-nord+1
do while(iflag .ge.0)
me=ieor(m0,misub)
call mrbencode(me,ce,g2,N,K)
call mrbencode91(me,ce,g2,N,K)
e2sub=ieor(ce(K+1:N),hdec(K+1:N))
do i2=0,ntau
ntotal2=ntotal2+1
@ -216,7 +220,7 @@ if(npre2.eq.1) then
if(i2.gt.0) ui(i2)=1
r2pat=ieor(e2sub,ui)
778 continue
call fetchit(reset,r2pat(1:ntau),ntau,in1,in2)
call fetchit91(reset,r2pat(1:ntau),ntau,in1,in2)
if(in1.gt.0.and.in2.gt.0) then
ncount2=ncount2+1
mi=misub
@ -224,7 +228,7 @@ if(npre2.eq.1) then
mi(in2)=1
if(sum(mi).lt.nord+npre1+npre2.or.any(iand(apmaskr(1:K),mi).eq.1)) cycle
me=ieor(m0,mi)
call mrbencode(me,ce,g2,N,K)
call mrbencode91(me,ce,g2,N,K)
nxor=ieor(ce,hdec)
dd=sum(nxor*absrx)
if( dd .lt. dmin ) then
@ -235,20 +239,23 @@ if(npre2.eq.1) then
goto 778
endif
enddo
call nextpat(misub,K,nord,iflag)
call nextpat91(misub,K,nord,iflag)
enddo
endif
998 continue
! Re-order the codeword to place message bits at the end.
! Re-order the codeword to [message bits][parity bits] format.
cw(indices)=cw
hdec(indices)=hdec
decoded=cw(M+1:N)
cw(colorder+1)=cw ! put the codeword back into received-word order
return
end subroutine osd174
decoded=cw(1:K)
call chkcrc14a(decoded,nbadcrc)
message77=decoded(1:77)
if(nbadcrc.eq.1) nhardmin=-nhardmin
subroutine mrbencode(me,codeword,g2,N,K)
return
end subroutine osd174_91
subroutine mrbencode91(me,codeword,g2,N,K)
integer*1 me(K),codeword(N),g2(N,K)
! fast encoding for low-weight test patterns
codeword=0
@ -258,9 +265,9 @@ integer*1 me(K),codeword(N),g2(N,K)
endif
enddo
return
end subroutine mrbencode
end subroutine mrbencode91
subroutine nextpat(mi,k,iorder,iflag)
subroutine nextpat91(mi,k,iorder,iflag)
integer*1 mi(k),ms(k)
! generate the next test error pattern
ind=-1
@ -287,11 +294,11 @@ subroutine nextpat(mi,k,iorder,iflag)
endif
enddo
return
end subroutine nextpat
end subroutine nextpat91
subroutine boxit(reset,e2,ntau,npindex,i1,i2)
subroutine boxit91(reset,e2,ntau,npindex,i1,i2)
integer*1 e2(1:ntau)
integer indexes(4000,2),fp(0:525000),np(4000)
integer indexes(5000,2),fp(0:525000),np(5000)
logical reset
common/boxes/indexes,fp,np
@ -323,10 +330,10 @@ subroutine boxit(reset,e2,ntau,npindex,i1,i2)
np(ip)=npindex
endif
return
end subroutine boxit
end subroutine boxit91
subroutine fetchit(reset,e2,ntau,i1,i2)
integer indexes(4000,2),fp(0:525000),np(4000)
subroutine fetchit91(reset,e2,ntau,i1,i2)
integer indexes(5000,2),fp(0:525000),np(5000)
integer lastpat
integer*1 e2(ntau)
logical reset
@ -361,5 +368,5 @@ subroutine fetchit(reset,e2,ntau,i1,i2)
endif
lastpat=ipat
return
end subroutine fetchit
end subroutine fetchit91

204
packjt.f90
View File

@ -6,7 +6,52 @@ module packjt
contains
subroutine packcall(callsign,ncall,text)
subroutine packbits(dbits,nsymd,m0,sym)
! Pack 0s and 1s from dbits() into sym() with m0 bits per word.
! NB: nsymd is the number of packed output words.
integer sym(:)
integer*1 dbits(:)
k=0
do i=1,nsymd
n=0
do j=1,m0
k=k+1
m=dbits(k)
n=ior(ishft(n,1),m)
enddo
sym(i)=n
enddo
return
end subroutine packbits
subroutine unpackbits(sym,nsymd,m0,dbits)
! Unpack bits from sym() into dbits(), one bit per byte.
! NB: nsymd is the number of input words, and m0 their length.
! there will be m0*nsymd output bytes, each 0 or 1.
integer sym(:)
integer*1 dbits(:)
k=0
do i=1,nsymd
mask=ishft(1,m0-1)
do j=1,m0
k=k+1
dbits(k)=0
if(iand(mask,sym(i)).ne.0) dbits(k)=1
mask=ishft(mask,-1)
enddo
enddo
return
end subroutine unpackbits
subroutine packcall(callsign,ncall,text)
! Pack a valid callsign into a 28-bit integer.
@ -489,12 +534,12 @@ subroutine packcall(callsign,ncall,text)
return
end subroutine packmsg
subroutine unpackmsg(dat,msg,msgcall,msggrid)
subroutine unpackmsg(dat,msg)
parameter (NBASE=37*36*10*27*27*27)
parameter (NGBASE=180*180)
integer dat(:)
character c1*12,c2*12,grid*4,msg*22,msgcall*6,msggrid*4,grid6*6,psfx*4,junk2*4
character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4
logical cqnnn
cqnnn=.false.
@ -526,16 +571,39 @@ subroutine packcall(callsign,ncall,text)
endif
call unpackcall(nc2,c2,junk1,junk2)
msgcall=c2(:6)
msggrid=' '
if(ng.lt.32400 .and. ng.ne.533) then
dlat=mod(ng,180)-90
dlong=(ng/180)*2 - 180 + 2
call deg2grid(dlong,dlat,grid6)
if(grid6(1:2).ne.'KA' .and. grid6(1:2).ne.'LA') msggrid=grid6(:4)
endif
call unpackgrid(ng,grid)
if(iv2.gt.0) then
! This is a JT65v2 message
do i=1,4
if(ichar(psfx(i:i)).eq.0) psfx(i:i)=' '
enddo
n1=len_trim(psfx)
n2=len_trim(c2)
if(iv2.eq.1) msg='CQ '//psfx(:n1)//'/'//c2(:n2)//' '//grid
if(iv2.eq.2) msg='QRZ '//psfx(:n1)//'/'//c2(:n2)//' '//grid
if(iv2.eq.3) msg='DE '//psfx(:n1)//'/'//c2(:n2)//' '//grid
if(iv2.eq.4) msg='CQ '//c2(:n2)//'/'//psfx(:n1)//' '//grid
if(iv2.eq.5) msg='QRZ '//c2(:n2)//'/'//psfx(:n1)//' '//grid
if(iv2.eq.6) msg='DE '//c2(:n2)//'/'//psfx(:n1)//' '//grid
if(iv2.eq.7) then
grid6=grid//'ma'
call grid2k(grid6,k)
if(k.ge.451 .and. k.le.900) then
call getpfx2(k,c2)
n2=len_trim(c2)
msg='DE '//c2(:n2)
else
msg='DE '//c2(:n2)//' '//grid
endif
endif
if(iv2.eq.8) msg=' '
go to 100
else
endif
grid6=grid//'ma'
call grid2k(grid6,k)
if(k.ge.1 .and. k.le.450) call getpfx2(k,c1)
@ -648,7 +716,7 @@ subroutine packcall(callsign,ncall,text)
nc1=nc1a
nc2=nc2a
nc3=iand(nc3a,32767) !Remove the "plain text" bit
nc3=iand(nc3a,32767) !Remove the "plain text" bit
if(iand(nc1,1).ne.0) nc3=nc3+32768
nc1=nc1/2
if(iand(nc2,1).ne.0) nc3=nc3+65536
@ -826,6 +894,32 @@ subroutine packcall(callsign,ncall,text)
return
end subroutine k2grid
subroutine grid2n(grid,n)
character*4 grid
i1=ichar(grid(1:1))-ichar('A')
i2=ichar(grid(3:3))-ichar('0')
i=10*i1 + i2
n=-i - 31
return
end subroutine grid2n
subroutine n2grid(n,grid)
character*4 grid
if(n.gt.-31 .or. n.lt.-70) stop 'Error in n2grid'
i=-(n+31) !NB: 0 <= i <= 39
i1=i/10
i2=mod(i,10)
grid(1:1)=char(ichar('A')+i1)
grid(2:2)='A'
grid(3:3)=char(ichar('0')+i2)
grid(4:4)='0'
return
end subroutine n2grid
function nchar(c)
! Convert ascii number, letter, or space to 0-36 for callsign packing.
@ -850,4 +944,90 @@ subroutine packcall(callsign,ncall,text)
return
end function nchar
subroutine pack50(n1,n2,dat)
integer*1 dat(:),i1
i1=iand(ishft(n1,-20),255) !8 bits
dat(1)=i1
i1=iand(ishft(n1,-12),255) !8 bits
dat(2)=i1
i1=iand(ishft(n1, -4),255) !8 bits
dat(3)=i1
i1=16*iand(n1,15)+iand(ishft(n2,-18),15) !4+4 bits
dat(4)=i1
i1=iand(ishft(n2,-10),255) !8 bits
dat(5)=i1
i1=iand(ishft(n2, -2),255) !8 bits
dat(6)=i1
i1=64*iand(n2,3) !2 bits
dat(7)=i1
dat(8)=0
dat(9)=0
dat(10)=0
dat(11)=0
return
end subroutine pack50
subroutine packpfx(call1,n1,ng,nadd)
character*12 call1,call0
character*3 pfx
logical text
i1=index(call1,'/')
if(call1(i1+2:i1+2).eq.' ') then
! Single-character add-on suffix (maybe also fourth suffix letter?)
call0=call1(:i1-1)
call packcall(call0,n1,text)
nadd=1
nc=ichar(call1(i1+1:i1+1))
if(nc.ge.48 .and. nc.le.57) then
n=nc-48
else if(nc.ge.65 .and. nc.le.90) then
n=nc-65+10
else
n=38
endif
nadd=1
ng=60000-32768+n
else if(call1(i1+3:i1+3).eq.' ') then
! Two-character numerical suffix, /10 to /99
call0=call1(:i1-1)
call packcall(call0,n1,text)
nadd=1
n=10*(ichar(call1(i1+1:i1+1))-48) + ichar(call1(i1+2:i1+2)) - 48
nadd=1
ng=60000 + 26 + n
else
! Prefix of 1 to 3 characters
pfx=call1(:i1-1)
if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2)
if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2)
call0=call1(i1+1:)
call packcall(call0,n1,text)
ng=0
do i=1,3
nc=ichar(pfx(i:i))
if(nc.ge.48 .and. nc.le.57) then
n=nc-48
else if(nc.ge.65 .and. nc.le.90) then
n=nc-65+10
else
n=36
endif
ng=37*ng + n
enddo
nadd=0
if(ng.ge.32768) then
ng=ng-32768
nadd=1
endif
endif
return
end subroutine packpfx
end module packjt

1227
packjt77.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

65
subtractft8.f90 Normal file
View File

@ -0,0 +1,65 @@
subroutine subtractft8(dd,itone,f0,dt)
! Subtract an ft8 signal
!
! Measured signal : dd(t) = a(t)cos(2*pi*f0*t+theta(t))
! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) )
! Complex amp : cfilt(t) = LPF[ dd(t)*CONJG(cref(t)) ]
! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt}
parameter (NMAX=15*4000,NFRAME=640*79)
parameter (NFFT=NMAX,NFILT=1400)
real*4 window(-NFILT/2:NFILT/2)
complex dd(NMAX)
complex cref,camp,cfilt,cw
integer itone(79)
logical first
data first/.true./
common/heap8/cref(NFRAME),camp(NMAX),cfilt(NMAX),cw(NMAX)
save first
if(f0.lt.2000.0) then
f=f0+2000.0
else
f=f0-2000.0
endif
nstart=dt*4000+1
call genft8refsig(itone,cref,f)
camp=0.
do i=1,nframe
id=nstart-1+i
if(id.ge.1.and.id.le.NMAX) camp(i)=dd(id)*conjg(cref(i))
enddo
if(first) then
! Create and normalize the filter
pi=4.0*atan(1.0)
fac=1.0/float(nfft)
sum=0.0
do j=-NFILT/2,NFILT/2
window(j)=cos(pi*j/NFILT)**2
sum=sum+window(j)
enddo
cw=0.
cw(1:NFILT+1)=window/sum
cw=cshift(cw,NFILT/2+1)
call four2a(cw,nfft,1,-1,1)
cw=cw*fac
first=.false.
endif
cfilt=0.0
cfilt(1:nframe)=camp(1:nframe)
call four2a(cfilt,nfft,1,-1,1)
cfilt(1:nfft)=cfilt(1:nfft)*cw(1:nfft)
call four2a(cfilt,nfft,1,1,1)
! Subtract the reconstructed signal
do i=1,nframe
j=nstart+i-1
if(j.ge.1 .and. j.le.NMAX) dd(j)=dd(j)-cfilt(i)*cref(i)
enddo
return
end subroutine subtractft8

40
sync8.f90
View File

@ -17,7 +17,7 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
integer indx(NFFT1)
integer ii(1)
integer icos7(0:6)
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern
equivalence (x,cx)
! Compute symbol spectra, stepping by NSTEP steps.
@ -38,17 +38,14 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
savg=savg + s(1:NFFT1,j) !Average spectrum
enddo
call baseline(savg,nfa,nfb,sbase)
! savg=savg/NHSYM
! do i=1,NFFT1
! write(51,3051) i*df,savg(i),db(savg(i))
!3051 format(f10.3,e12.3,f12.3)
! enddo
ia=max(1,nint(nfa/df))
ib=nint(nfb/df)
nssy=NSPS/NSTEP ! # steps per symbol
nfos=NFFT1/NSPS ! # frequency bin oversampling factor
jstrt=0.5/tstep
candidate0=0.
k=0
do i=ia,ib
do j=-JZ,+JZ
@ -59,23 +56,22 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
t0b=0.
t0c=0.
do n=0,6
k=j+jstrt+nssy*n
if(k.ge.1.and.k.le.NHSYM) then
ta=ta + s(i+nfos*icos7(n),k)
t0a=t0a + sum(s(i:i+nfos*6:nfos,k))
m=j+jstrt+nssy*n
if(m.ge.1.and.m.le.NHSYM) then
ta=ta + s(i+nfos*icos7(n),m)
t0a=t0a + sum(s(i:i+nfos*6:nfos,m))
endif
tb=tb + s(i+nfos*icos7(n),k+nssy*36)
t0b=t0b + sum(s(i:i+nfos*6:nfos,k+nssy*36))
if(k+nssy*72.le.NHSYM) then
tc=tc + s(i+nfos*icos7(n),k+nssy*72)
t0c=t0c + sum(s(i:i+nfos*6:nfos,k+nssy*72))
tb=tb + s(i+nfos*icos7(n),m+nssy*36)
t0b=t0b + sum(s(i:i+nfos*6:nfos,m+nssy*36))
if(m+nssy*72.le.NHSYM) then
tc=tc + s(i+nfos*icos7(n),m+nssy*72)
t0c=t0c + sum(s(i:i+nfos*6:nfos,m+nssy*72))
endif
enddo
t=ta+tb+tc
t0=t0a+t0b+t0c
t0=(t0-t)/6.0
sync_abc=t/t0
t=tb+tc
t0=t0b+t0c
t0=(t0-t)/6.0
@ -90,8 +86,6 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
j0=ii(1)
jpeak(i)=j0
red(i)=sync2d(i,j0)
! write(52,3052) i*df,red(i),db(red(i))
!3052 format(3f12.3)
enddo
iz=ib-ia+1
call indexx(red(ia:ib),iz,indx)
@ -101,9 +95,7 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
base=red(ibase)
red=red/base
candidate0=0.
k=0
do i=1,MAXCAND
do i=1,min(MAXCAND,iz)
n=ia + indx(iz+1-i) - 1
if(red(n).lt.syncmin.or.isnan(red(n)).or.k.eq.MAXCAND) exit
k=k+1
@ -124,9 +116,6 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
if(candidate0(3,i).lt.candidate0(3,j)) candidate0(3,i)=0.
endif
enddo
! write(*,3001) i,candidate0(1,i-1),candidate0(1,i),candidate0(3,i-1), &
! candidate0(3,i)
!3001 format(i2,4f8.1)
endif
enddo
@ -143,9 +132,8 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
j=indx(i)
! if( candidate0(3,j) .ge. syncmin .and. candidate0(2,j).ge.-1.5 ) then
if( candidate0(3,j) .ge. syncmin ) then
candidate(2:3,k)=candidate0(2:3,j)
candidate(1,k)=abs(candidate0(1,j))
candidate(2,k)=candidate0(2,j)
candidate(3,k)=candidate0(3,j)
k=k+1
endif
enddo

10
sync8d.f90
View File

@ -3,14 +3,14 @@ subroutine sync8d(cd0,i0,ctwk,itwk,sync)
! Compute sync power for a complex, downsampled FT8 signal.
parameter(NP2=2812,NDOWN=20)
complex cd0(3125)
complex cd0(0:3199)
complex csync(0:6,32)
complex csync2(32)
complex ctwk(32)
complex z1,z2,z3
logical first
integer icos7(0:6)
data icos7/2,5,6,0,4,1,3/
data icos7/3,1,4,0,6,5,2/
data first/.true./
save first,twopi,fs2,dt2,taus,baud,csync
@ -44,9 +44,9 @@ subroutine sync8d(cd0,i0,ctwk,itwk,sync)
z1=0.
z2=0.
z3=0.
if(i1.ge.1 .and. i1+31.le.NP2) z1=sum(cd0(i1:i1+31)*conjg(csync2))
if(i2.ge.1 .and. i2+31.le.NP2) z2=sum(cd0(i2:i2+31)*conjg(csync2))
if(i3.ge.1 .and. i3+31.le.NP2) z3=sum(cd0(i3:i3+31)*conjg(csync2))
if(i1.ge.0 .and. i1+31.le.NP2-1) z1=sum(cd0(i1:i1+31)*conjg(csync2))
if(i2.ge.0 .and. i2+31.le.NP2-1) z2=sum(cd0(i2:i2+31)*conjg(csync2))
if(i3.ge.0 .and. i3+31.le.NP2-1) z3=sum(cd0(i3:i3+31)*conjg(csync2))
sync = sync + p(z1) + p(z2) + p(z3)
enddo