mirror of
https://github.com/pavel-demin/ft8d.git
synced 2024-11-23 12:58:37 -05:00
remove signal subtraction and simplify output format
This commit is contained in:
Pavel Demin
parent
fa4f5a12e2
commit
61ae08bf0c
10
Makefile
10
Makefile
@ -1,12 +1,10 @@
|
||||
TARGET = ft8d
|
||||
|
||||
OBJECTS = \
|
||||
timer_module.o crc10.o 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 bpdecode144.o geodist.o azdist.o fix_contest_msg.o \
|
||||
to_contest_msg.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 genft8refsig.o subtractft8.o db.o ft8b.o ft8d.o
|
||||
crc12.o crc.o ft8_downsample.o sync8d.o sync8.o four2a.o deg2grid.o \
|
||||
chkcrc12a.o determ.o fftw3mod.o baseline.o bpdecode174.o packjt.o \
|
||||
extractmessage174.o indexx.o shell.o pctile.o polyfit.o twkfreq1.o \
|
||||
osd174.o db.o ft8b.o ft8d.o
|
||||
|
||||
CC = gcc
|
||||
FC = gfortran
|
||||
|
||||
129
azdist.f90
129
azdist.f90
@ -1,129 +0,0 @@
|
||||
subroutine azdist(grid1,grid2,utch,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter)
|
||||
|
||||
character*(*) grid1,grid2
|
||||
character*6 MyGrid,HisGrid,mygrid0,hisgrid0
|
||||
real*8 utch,utch0
|
||||
logical HotABetter,IamEast
|
||||
real eltab(22),daztab(22)
|
||||
data eltab/18.,15.,13.,11.,9.,8.,7.,6.,5.3,4.7,4.,3.3,2.7, &
|
||||
2.,1.5,1.,0.8,0.6,0.4,0.2,0.0,0.0/
|
||||
data daztab/21.,18.,16.,15.,14.,13.,12.,11.,10.7,10.3,10., &
|
||||
10.,10.,10.,10.,10.,10.,9.,9.,9.,8.,8./
|
||||
data mygrid0/" "/,hisgrid0/" "/,utch0/-999.d0/
|
||||
save
|
||||
|
||||
MyGrid=grid1//' '
|
||||
HisGrid=grid2//' '
|
||||
if(ichar(MyGrid(5:5)).eq.0) MyGrid(5:6)=' '
|
||||
if(ichar(HisGrid(5:5)).eq.0) HisGrid(5:6)=' '
|
||||
|
||||
if(MyGrid.eq.HisGrid) then
|
||||
naz=0
|
||||
nel=0
|
||||
ndmiles=0
|
||||
ndkm=0
|
||||
nhotaz=0
|
||||
nhotabetter=1
|
||||
go to 999
|
||||
endif
|
||||
|
||||
if(mygrid.eq.mygrid0 .and. hisgrid.eq.hisgrid0 .and. &
|
||||
abs(utch-utch0).lt.0.1666667d0) go to 900
|
||||
utch0=utch
|
||||
mygrid0=mygrid
|
||||
hisgrid0=hisgrid
|
||||
utchours=utch
|
||||
|
||||
if(MyGrid(5:5).eq.' ') MyGrid(5:5)='m'
|
||||
if(MyGrid(6:6).eq.' ') MyGrid(6:6)='m'
|
||||
if(HisGrid(5:5).eq.' ') HisGrid(5:5)='m'
|
||||
if(HisGrid(6:6).eq.' ') HisGrid(6:6)='m'
|
||||
|
||||
if(MyGrid.eq.HisGrid) then
|
||||
Az=0.
|
||||
Dmiles=0.
|
||||
Dkm=0.0
|
||||
El=0.
|
||||
HotA=0.
|
||||
HotB=0.
|
||||
HotABetter=.true.
|
||||
go to 900
|
||||
endif
|
||||
call grid2deg(MyGrid,dlong1,dlat1)
|
||||
call grid2deg(HisGrid,dlong2,dlat2)
|
||||
eps=1.e-6
|
||||
Az=0.
|
||||
Dmiles=0.
|
||||
Dkm=0.0
|
||||
El=0.
|
||||
HotA=0.
|
||||
HotB=0.
|
||||
HotABetter=.true.
|
||||
if(abs(dlat1-dlat2).lt.eps .and. abs(dlong1-dlong2).lt.eps) go to 900
|
||||
|
||||
difflong=mod(dlong1-dlong2+720.0,360.0)
|
||||
if(abs(dlat1+dlat2).lt.eps .and. abs(difflong-180.0).lt.eps) then
|
||||
! Antipodes
|
||||
Dkm=20400
|
||||
go to 900
|
||||
endif
|
||||
|
||||
call geodist(dlat1,dlong1,dlat2,dlong2,Az,Baz,Dkm)
|
||||
|
||||
ndkm=Dkm/100
|
||||
j=ndkm-4
|
||||
if(j.lt.1) j=1
|
||||
if(j.gt.21)j=21
|
||||
if(Dkm.lt.500.0) then
|
||||
El=18.0
|
||||
else
|
||||
u=(Dkm-100.0*ndkm)/100.0
|
||||
El=(1.0-u)*eltab(j) + u*eltab(j+1)
|
||||
endif
|
||||
|
||||
daz=daztab(j) + u * (daztab(j+1)-daztab(j))
|
||||
Dmiles=Dkm/1.609344
|
||||
|
||||
tmid=mod(UTChours-0.5*(dlong1+dlong2)/15.0+48.0,24.0)
|
||||
IamEast=.false.
|
||||
if(dlong1.lt.dlong2) IamEast=.true.
|
||||
if(dlong1.eq.dlong2 .and. dlat1.gt.dlat2) IamEast=.false.
|
||||
azEast=baz
|
||||
if(IamEast) azEast=az
|
||||
if((azEast.ge.45.0 .and. azEast.lt.135.0) .or. &
|
||||
(azEast.ge.225.0 .and. azEast.lt.315.0)) then
|
||||
! The path will be taken as "east-west".
|
||||
HotABetter=.true.
|
||||
if(abs(tmid-6.0).lt.6.0) HotABetter=.false.
|
||||
if((dlat1+dlat2)/2.0 .lt. 0.0) HotABetter=.not.HotABetter
|
||||
else
|
||||
! The path will be taken as "north-south".
|
||||
HotABetter=.false.
|
||||
if(abs(tmid-12.0).lt.6.0) HotABetter=.true.
|
||||
endif
|
||||
if(IamEast) then
|
||||
HotA = Az - daz
|
||||
HotB = Az + daz
|
||||
else
|
||||
HotA = Az + daz
|
||||
HotB = Az - daz
|
||||
endif
|
||||
if(HotA.lt.0.0) HotA=HotA+360.0
|
||||
if(HotA.gt.360.0) HotA=HotA-360.0
|
||||
if(HotB.lt.0.0) HotB=HotB+360.0
|
||||
if(HotB.gt.360.0) HotB=HotB-360.0
|
||||
|
||||
900 continue
|
||||
naz=nint(Az)
|
||||
nel=nint(el)
|
||||
nDmiles=nint(Dmiles)
|
||||
nDkm=nint(Dkm)
|
||||
nHotAz=nint(HotB)
|
||||
nHotABetter=0
|
||||
if(HotABetter) then
|
||||
nHotAz=nint(HotA)
|
||||
nHotABetter=1
|
||||
endif
|
||||
|
||||
999 return
|
||||
end subroutine azdist
|
||||
348
bpdecode144.f90
348
bpdecode144.f90
@ -1,348 +0,0 @@
|
||||
subroutine pltanh(x,y)
|
||||
isign=+1
|
||||
z=x
|
||||
if( x.lt.0 ) then
|
||||
isign=-1
|
||||
z=abs(x)
|
||||
endif
|
||||
if( z.le. 0.8 ) then
|
||||
y=0.83*x
|
||||
return
|
||||
elseif( z.le. 1.6 ) then
|
||||
y=isign*(0.322*z+0.4064)
|
||||
return
|
||||
elseif( z.le. 3.0 ) then
|
||||
y=isign*(0.0524*z+0.8378)
|
||||
return
|
||||
elseif( z.lt. 7.0 ) then
|
||||
y=isign*(0.0012*z+0.9914)
|
||||
return
|
||||
else
|
||||
y=isign*0.9998
|
||||
return
|
||||
endif
|
||||
end subroutine pltanh
|
||||
|
||||
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 bpdecode144(llr,maxiterations,decoded,niterations)
|
||||
!
|
||||
! A log-domain belief propagation decoder for the msk144 code.
|
||||
! The code is a regular (128,80) code with column weight 3 and row weight 8.
|
||||
! k9an August, 2016
|
||||
!
|
||||
integer, parameter:: N=128, K=80, M=N-K
|
||||
integer*1 codeword(N),cw(N)
|
||||
integer*1 colorder(N)
|
||||
integer*1 decoded(K)
|
||||
integer Nm(8,M) ! 8 bits per check
|
||||
integer Mn(3,N) ! 3 checks per bit
|
||||
integer synd(M)
|
||||
real tov(3,N) ! single precision seems to be adequate in log-domain
|
||||
real toc(8,M)
|
||||
real tanhtoc(8,M)
|
||||
real zn(N)
|
||||
real llr(N)
|
||||
real Tmn
|
||||
|
||||
data colorder/0,1,2,3,4,5,6,7,8,9, &
|
||||
10,11,12,13,14,15,24,26,29,30, &
|
||||
32,43,44,47,60,77,79,97,101,111, &
|
||||
96,38,64,53,93,34,59,94,74,90, &
|
||||
108,123,85,57,70,25,69,62,48,49, &
|
||||
50,51,52,33,54,55,56,21,58,36, &
|
||||
16,61,23,63,20,65,66,67,68,46, &
|
||||
22,71,72,73,31,75,76,45,78,17, &
|
||||
80,81,82,83,84,42,86,87,88,89, &
|
||||
39,91,92,35,37,95,19,27,98,99, &
|
||||
100,28,102,103,104,105,106,107,40,109, &
|
||||
110,18,112,113,114,115,116,117,118,119, &
|
||||
120,121,122,41,124,125,126,127/
|
||||
|
||||
data Mn/ &
|
||||
1, 14, 38, &
|
||||
2, 4, 41, &
|
||||
3, 19, 39, &
|
||||
5, 29, 34, &
|
||||
6, 35, 40, &
|
||||
7, 20, 45, &
|
||||
8, 28, 48, &
|
||||
9, 22, 25, &
|
||||
10, 24, 36, &
|
||||
11, 12, 37, &
|
||||
13, 43, 44, &
|
||||
15, 18, 46, &
|
||||
16, 17, 47, &
|
||||
21, 32, 33, &
|
||||
23, 30, 31, &
|
||||
26, 27, 42, &
|
||||
1, 12, 46, &
|
||||
2, 36, 38, &
|
||||
3, 5, 10, &
|
||||
4, 9, 23, &
|
||||
6, 13, 39, &
|
||||
7, 15, 17, &
|
||||
8, 18, 27, &
|
||||
11, 33, 40, &
|
||||
14, 28, 44, &
|
||||
16, 29, 31, &
|
||||
19, 20, 22, &
|
||||
21, 30, 42, &
|
||||
24, 26, 47, &
|
||||
25, 37, 48, &
|
||||
32, 34, 45, &
|
||||
8, 35, 41, &
|
||||
12, 31, 43, &
|
||||
1, 19, 21, &
|
||||
2, 43, 45, &
|
||||
3, 4, 11, &
|
||||
5, 18, 33, &
|
||||
6, 25, 47, &
|
||||
7, 28, 30, &
|
||||
9, 14, 34, &
|
||||
10, 35, 42, &
|
||||
13, 15, 22, &
|
||||
16, 37, 38, &
|
||||
17, 41, 44, &
|
||||
20, 24, 29, &
|
||||
18, 23, 39, &
|
||||
12, 26, 32, &
|
||||
27, 38, 40, &
|
||||
15, 36, 48, &
|
||||
2, 30, 46, &
|
||||
1, 4, 13, &
|
||||
3, 28, 32, &
|
||||
5, 43, 47, &
|
||||
6, 34, 46, &
|
||||
7, 9, 40, &
|
||||
8, 11, 45, &
|
||||
10, 17, 23, &
|
||||
14, 31, 35, &
|
||||
16, 22, 42, &
|
||||
19, 37, 44, &
|
||||
20, 33, 48, &
|
||||
21, 24, 41, &
|
||||
25, 27, 29, &
|
||||
26, 39, 48, &
|
||||
19, 31, 36, &
|
||||
1, 5, 7, &
|
||||
2, 29, 39, &
|
||||
3, 16, 46, &
|
||||
4, 26, 37, &
|
||||
6, 28, 45, &
|
||||
8, 22, 33, &
|
||||
9, 21, 43, &
|
||||
10, 25, 38, &
|
||||
11, 14, 24, &
|
||||
12, 17, 40, &
|
||||
13, 27, 30, &
|
||||
15, 32, 35, &
|
||||
18, 44, 47, &
|
||||
20, 23, 36, &
|
||||
34, 41, 42, &
|
||||
1, 32, 48, &
|
||||
2, 3, 33, &
|
||||
4, 29, 42, &
|
||||
5, 14, 37, &
|
||||
6, 7, 36, &
|
||||
8, 9, 39, &
|
||||
10, 13, 19, &
|
||||
11, 18, 30, &
|
||||
12, 16, 20, &
|
||||
15, 29, 44, &
|
||||
17, 34, 38, &
|
||||
6, 21, 22, &
|
||||
23, 32, 40, &
|
||||
24, 27, 46, &
|
||||
25, 41, 45, &
|
||||
7, 26, 43, &
|
||||
28, 31, 47, &
|
||||
20, 35, 38, &
|
||||
1, 33, 41, &
|
||||
2, 42, 44, &
|
||||
3, 23, 48, &
|
||||
4, 31, 45, &
|
||||
5, 8, 30, &
|
||||
9, 16, 36, &
|
||||
10, 40, 47, &
|
||||
11, 17, 46, &
|
||||
12, 21, 34, &
|
||||
13, 24, 28, &
|
||||
14, 18, 43, &
|
||||
15, 25, 26, &
|
||||
19, 27, 35, &
|
||||
22, 37, 39, &
|
||||
1, 16, 18, &
|
||||
2, 6, 20, &
|
||||
3, 30, 43, &
|
||||
4, 28, 33, &
|
||||
5, 22, 23, &
|
||||
7, 39, 42, &
|
||||
8, 12, 38, &
|
||||
9, 35, 46, &
|
||||
10, 27, 32, &
|
||||
11, 15, 34, &
|
||||
13, 36, 37, &
|
||||
14, 41, 47, &
|
||||
17, 21, 25, &
|
||||
19, 29, 45, &
|
||||
24, 31, 48, &
|
||||
26, 40, 44/
|
||||
|
||||
data Nm/ &
|
||||
1, 17, 34, 51, 66, 81, 99, 113, &
|
||||
2, 18, 35, 50, 67, 82, 100, 114, &
|
||||
3, 19, 36, 52, 68, 82, 101, 115, &
|
||||
2, 20, 36, 51, 69, 83, 102, 116, &
|
||||
4, 19, 37, 53, 66, 84, 103, 117, &
|
||||
5, 21, 38, 54, 70, 85, 92, 114, &
|
||||
6, 22, 39, 55, 66, 85, 96, 118, &
|
||||
7, 23, 32, 56, 71, 86, 103, 119, &
|
||||
8, 20, 40, 55, 72, 86, 104, 120, &
|
||||
9, 19, 41, 57, 73, 87, 105, 121, &
|
||||
10, 24, 36, 56, 74, 88, 106, 122, &
|
||||
10, 17, 33, 47, 75, 89, 107, 119, &
|
||||
11, 21, 42, 51, 76, 87, 108, 123, &
|
||||
1, 25, 40, 58, 74, 84, 109, 124, &
|
||||
12, 22, 42, 49, 77, 90, 110, 122, &
|
||||
13, 26, 43, 59, 68, 89, 104, 113, &
|
||||
13, 22, 44, 57, 75, 91, 106, 125, &
|
||||
12, 23, 37, 46, 78, 88, 109, 113, &
|
||||
3, 27, 34, 60, 65, 87, 111, 126, &
|
||||
6, 27, 45, 61, 79, 89, 98, 114, &
|
||||
14, 28, 34, 62, 72, 92, 107, 125, &
|
||||
8, 27, 42, 59, 71, 92, 112, 117, &
|
||||
15, 20, 46, 57, 79, 93, 101, 117, &
|
||||
9, 29, 45, 62, 74, 94, 108, 127, &
|
||||
8, 30, 38, 63, 73, 95, 110, 125, &
|
||||
16, 29, 47, 64, 69, 96, 110, 128, &
|
||||
16, 23, 48, 63, 76, 94, 111, 121, &
|
||||
7, 25, 39, 52, 70, 97, 108, 116, &
|
||||
4, 26, 45, 63, 67, 83, 90, 126, &
|
||||
15, 28, 39, 50, 76, 88, 103, 115, &
|
||||
15, 26, 33, 58, 65, 97, 102, 127, &
|
||||
14, 31, 47, 52, 77, 81, 93, 121, &
|
||||
14, 24, 37, 61, 71, 82, 99, 116, &
|
||||
4, 31, 40, 54, 80, 91, 107, 122, &
|
||||
5, 32, 41, 58, 77, 98, 111, 120, &
|
||||
9, 18, 49, 65, 79, 85, 104, 123, &
|
||||
10, 30, 43, 60, 69, 84, 112, 123, &
|
||||
1, 18, 43, 48, 73, 91, 98, 119, &
|
||||
3, 21, 46, 64, 67, 86, 112, 118, &
|
||||
5, 24, 48, 55, 75, 93, 105, 128, &
|
||||
2, 32, 44, 62, 80, 95, 99, 124, &
|
||||
16, 28, 41, 59, 80, 83, 100, 118, &
|
||||
11, 33, 35, 53, 72, 96, 109, 115, &
|
||||
11, 25, 44, 60, 78, 90, 100, 128, &
|
||||
6, 31, 35, 56, 70, 95, 102, 126, &
|
||||
12, 17, 50, 54, 68, 94, 106, 120, &
|
||||
13, 29, 38, 53, 78, 97, 105, 124, &
|
||||
7, 30, 49, 61, 64, 81, 101, 127/
|
||||
|
||||
nrw=8
|
||||
ncw=3
|
||||
|
||||
toc=0
|
||||
tov=0
|
||||
tanhtoc=0
|
||||
|
||||
! initial messages to checks
|
||||
do j=1,M
|
||||
do i=1,nrw
|
||||
toc(i,j)=llr((Nm(i,j)))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
ncnt=0
|
||||
|
||||
do iter=0,maxiterations
|
||||
|
||||
! Update bit log likelihood ratios
|
||||
do i=1,N
|
||||
zn(i)=llr(i)+sum(tov(1:ncw,i))
|
||||
enddo
|
||||
|
||||
! Check to see if we have a codeword
|
||||
cw=0
|
||||
where( zn .gt. 0. ) cw=1
|
||||
ncheck=0
|
||||
do i=1,M
|
||||
synd(i)=sum(cw(Nm(:,i)))
|
||||
if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1
|
||||
enddo
|
||||
|
||||
if( ncheck .eq. 0 ) then ! we have a codeword
|
||||
niterations=iter
|
||||
codeword=cw(colorder+1)
|
||||
decoded=codeword(M+1:N)
|
||||
return
|
||||
endif
|
||||
|
||||
if( iter.gt.0 ) 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. 3 .and. iter .ge. 5 .and. ncheck .gt. 10) then
|
||||
niterations=-1
|
||||
return
|
||||
endif
|
||||
endif
|
||||
nclast=ncheck
|
||||
|
||||
! Send messages from bits to check nodes
|
||||
do j=1,M
|
||||
do i=1,nrw
|
||||
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 ! Mn(3,128)
|
||||
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:nrw,i)=tanh(-toc(1:nrw,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(:,ichk),mask=Nm(:,ichk).ne.j)
|
||||
call platanh(-Tmn,y)
|
||||
tov(i,j)=2*y
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
niterations=-1
|
||||
end subroutine bpdecode144
|
||||
@ -1,3 +1,28 @@
|
||||
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.
|
||||
|
||||
59
crc10.c
59
crc10.c
@ -1,59 +0,0 @@
|
||||
#include <stdbool.h>
|
||||
|
||||
static unsigned short table[256] =
|
||||
{
|
||||
0x0000, 0x048f, 0x091e, 0x0d91, 0x123c, 0x16b3, 0x1b22, 0x1fad,
|
||||
0x24f7, 0x2078, 0x2de9, 0x2966, 0x36cb, 0x3244, 0x3fd5, 0x3b5a,
|
||||
0x49ee, 0x4d61, 0x40f0, 0x447f, 0x5bd2, 0x5f5d, 0x52cc, 0x5643,
|
||||
0x6d19, 0x6996, 0x6407, 0x6088, 0x7f25, 0x7baa, 0x763b, 0x72b4,
|
||||
0x93dc, 0x9753, 0x9ac2, 0x9e4d, 0x81e0, 0x856f, 0x88fe, 0x8c71,
|
||||
0xb72b, 0xb3a4, 0xbe35, 0xbaba, 0xa517, 0xa198, 0xac09, 0xa886,
|
||||
0xda32, 0xdebd, 0xd32c, 0xd7a3, 0xc80e, 0xcc81, 0xc110, 0xc59f,
|
||||
0xfec5, 0xfa4a, 0xf7db, 0xf354, 0xecf9, 0xe876, 0xe5e7, 0xe168,
|
||||
0x2737, 0x23b8, 0x2e29, 0x2aa6, 0x350b, 0x3184, 0x3c15, 0x389a,
|
||||
0x03c0, 0x074f, 0x0ade, 0x0e51, 0x11fc, 0x1573, 0x18e2, 0x1c6d,
|
||||
0x6ed9, 0x6a56, 0x67c7, 0x6348, 0x7ce5, 0x786a, 0x75fb, 0x7174,
|
||||
0x4a2e, 0x4ea1, 0x4330, 0x47bf, 0x5812, 0x5c9d, 0x510c, 0x5583,
|
||||
0xb4eb, 0xb064, 0xbdf5, 0xb97a, 0xa6d7, 0xa258, 0xafc9, 0xab46,
|
||||
0x901c, 0x9493, 0x9902, 0x9d8d, 0x8220, 0x86af, 0x8b3e, 0x8fb1,
|
||||
0xfd05, 0xf98a, 0xf41b, 0xf094, 0xef39, 0xebb6, 0xe627, 0xe2a8,
|
||||
0xd9f2, 0xdd7d, 0xd0ec, 0xd463, 0xcbce, 0xcf41, 0xc2d0, 0xc65f,
|
||||
0x4ee1, 0x4a6e, 0x47ff, 0x4370, 0x5cdd, 0x5852, 0x55c3, 0x514c,
|
||||
0x6a16, 0x6e99, 0x6308, 0x6787, 0x782a, 0x7ca5, 0x7134, 0x75bb,
|
||||
0x070f, 0x0380, 0x0e11, 0x0a9e, 0x1533, 0x11bc, 0x1c2d, 0x18a2,
|
||||
0x23f8, 0x2777, 0x2ae6, 0x2e69, 0x31c4, 0x354b, 0x38da, 0x3c55,
|
||||
0xdd3d, 0xd9b2, 0xd423, 0xd0ac, 0xcf01, 0xcb8e, 0xc61f, 0xc290,
|
||||
0xf9ca, 0xfd45, 0xf0d4, 0xf45b, 0xebf6, 0xef79, 0xe2e8, 0xe667,
|
||||
0x94d3, 0x905c, 0x9dcd, 0x9942, 0x86ef, 0x8260, 0x8ff1, 0x8b7e,
|
||||
0xb024, 0xb4ab, 0xb93a, 0xbdb5, 0xa218, 0xa697, 0xab06, 0xaf89,
|
||||
0x69d6, 0x6d59, 0x60c8, 0x6447, 0x7bea, 0x7f65, 0x72f4, 0x767b,
|
||||
0x4d21, 0x49ae, 0x443f, 0x40b0, 0x5f1d, 0x5b92, 0x5603, 0x528c,
|
||||
0x2038, 0x24b7, 0x2926, 0x2da9, 0x3204, 0x368b, 0x3b1a, 0x3f95,
|
||||
0x04cf, 0x0040, 0x0dd1, 0x095e, 0x16f3, 0x127c, 0x1fed, 0x1b62,
|
||||
0xfa0a, 0xfe85, 0xf314, 0xf79b, 0xe836, 0xecb9, 0xe128, 0xe5a7,
|
||||
0xdefd, 0xda72, 0xd7e3, 0xd36c, 0xccc1, 0xc84e, 0xc5df, 0xc150,
|
||||
0xb3e4, 0xb76b, 0xbafa, 0xbe75, 0xa1d8, 0xa557, 0xa8c6, 0xac49,
|
||||
0x9713, 0x939c, 0x9e0d, 0x9a82, 0x852f, 0x81a0, 0x8c31, 0x88be
|
||||
};
|
||||
|
||||
short crc10(unsigned char const *data, int length)
|
||||
{
|
||||
unsigned short remainder = 0;
|
||||
unsigned char index;
|
||||
int i;
|
||||
|
||||
for(i = 0; i < length; ++i)
|
||||
{
|
||||
index = remainder >> 2;
|
||||
remainder <<= 8;
|
||||
remainder |= data[i];
|
||||
remainder ^= table[index];
|
||||
}
|
||||
|
||||
return remainder & 0x03ff;
|
||||
}
|
||||
|
||||
bool crc10_check(unsigned char const *data, int length)
|
||||
{
|
||||
return !crc10(data, length);
|
||||
}
|
||||
@ -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
|
||||
@ -1,13 +1,14 @@
|
||||
subroutine extractmessage174(decoded,msgreceived,ncrcflag)
|
||||
subroutine extractmessage174(decoded,lhasgrid,msgcall,msggrid,ncrcflag)
|
||||
use iso_c_binding, only: c_loc,c_size_t
|
||||
use crc
|
||||
use packjt
|
||||
|
||||
character*22 msgreceived
|
||||
character msgcall*12, msggrid*4
|
||||
character*87 cbits
|
||||
integer*1 decoded(87)
|
||||
integer*1, target:: i1Dec8BitBytes(11)
|
||||
integer*4 i4Dec6BitWords(12)
|
||||
logical lhasgrid
|
||||
|
||||
! Write decoded bits into cbits: 75-bit message plus 12-bit CRC
|
||||
write(cbits,1000) decoded
|
||||
@ -30,10 +31,11 @@ subroutine extractmessage174(decoded,msgreceived,ncrcflag)
|
||||
enddo
|
||||
i4Dec6BitWords(ibyte)=itmp
|
||||
enddo
|
||||
call unpackmsg(i4Dec6BitWords,msgreceived,.false.,' ')
|
||||
call unpackmsg(i4Dec6BitWords,lhasgrid,msgcall,msggrid)
|
||||
ncrcflag=1
|
||||
else
|
||||
msgreceived=' '
|
||||
msgcall=' '
|
||||
msggrid=' '
|
||||
ncrcflag=-1
|
||||
endif
|
||||
return
|
||||
|
||||
@ -1,32 +0,0 @@
|
||||
subroutine fix_contest_msg(mygrid,msg)
|
||||
|
||||
! If distance from mygrid to grid1 is more thsn 10000 km, change "grid1"
|
||||
! to "R grid2" where grid2 is the antipodes of grid1.
|
||||
|
||||
character*6 mygrid
|
||||
character*22 msg
|
||||
character*6 g1,g2
|
||||
logical isgrid
|
||||
|
||||
isgrid(g1)=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. &
|
||||
g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. &
|
||||
g1(4:4).ge.'0' .and. g1(4:4).le.'9' .and. g1(1:4).ne.'RR73'
|
||||
|
||||
n=len(trim(msg))
|
||||
if(n.lt.4) return
|
||||
|
||||
g1=msg(n-3:n)//' '
|
||||
if(isgrid(g1)) then
|
||||
call azdist(mygrid,g1,0.d0,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter)
|
||||
if(ndkm.gt.10000) then
|
||||
call grid2deg(g1,dlong,dlat)
|
||||
dlong=dlong+180.0
|
||||
if(dlong.gt.180.0) dlong=dlong-360.0
|
||||
dlat=-dlat
|
||||
call deg2grid(dlong,dlat,g2)
|
||||
msg=msg(1:n-4)//'R '//g2(1:4)
|
||||
endif
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine fix_contest_msg
|
||||
21
fmtmsg.f90
21
fmtmsg.f90
@ -1,21 +0,0 @@
|
||||
subroutine fmtmsg(msg,iz)
|
||||
|
||||
character*22 msg
|
||||
|
||||
! Convert all letters to upper case
|
||||
iz=22
|
||||
do i=1,22
|
||||
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
|
||||
ib2=index(msg(1:iz),' ')
|
||||
if(ib2.lt.1) go to 100
|
||||
msg=msg(1:ib2)//msg(ib2+2:)
|
||||
iz=iz-1
|
||||
enddo
|
||||
|
||||
100 return
|
||||
end subroutine fmtmsg
|
||||
72
ft8b.f90
72
ft8b.f90
@ -1,25 +1,18 @@
|
||||
subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
|
||||
napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,hiscall12,bcontest, &
|
||||
sync0,f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr)
|
||||
subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
|
||||
napwid,nagain,iaptype,f1,xdt,xbase,apsym,nharderrors,dmin, &
|
||||
nbadcrc,ipass,lhasgrid,msgcall,msggrid,xsnr)
|
||||
|
||||
use crc
|
||||
use timer_module, only: timer
|
||||
include 'ft8_params.f90'
|
||||
parameter(NP2=2812)
|
||||
character*37 msg37
|
||||
character message*22,msgsent*22
|
||||
character*12 mycall12,hiscall12
|
||||
character*6 mycall6,mygrid6,hiscall6,c1,c2
|
||||
character*87 cbits
|
||||
logical bcontest
|
||||
character msgcall*12,msggrid*4,message*22
|
||||
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
|
||||
complex dd0(NMAX)
|
||||
integer*1 decoded(KK),decoded0(KK),apmask(3*ND),cw(3*ND)
|
||||
integer*1 msgbits(KK)
|
||||
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 itone(NN)
|
||||
@ -27,11 +20,10 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
|
||||
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
|
||||
integer*1, target:: i1hiscall(12)
|
||||
complex cd0(3200)
|
||||
complex ctwk(32)
|
||||
complex csymb(32)
|
||||
logical first,newdat,lsubtract,lapon,lapcqonly,nagain
|
||||
logical first,newdat,lapon,lapcqonly,nagain,lhasgrid
|
||||
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/
|
||||
@ -82,9 +74,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
|
||||
delfbest=0.
|
||||
ibest=0
|
||||
|
||||
call timer('ft8_down',0)
|
||||
call ft8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample
|
||||
call timer('ft8_down',1)
|
||||
|
||||
i0=nint((xdt+0.5)*fs2) !Initial guess for start of signal
|
||||
smax=0.0
|
||||
@ -340,10 +330,8 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
|
||||
endif
|
||||
|
||||
cw=0
|
||||
call timer('bpd174 ',0)
|
||||
call bpdecode174(llrap,apmask,max_iterations,decoded,cw,nharderrors, &
|
||||
niterations)
|
||||
call timer('bpd174 ',1)
|
||||
dmin=0.0
|
||||
if(ndepth.eq.3 .and. nharderrors.lt.0) then
|
||||
ndeep=3
|
||||
@ -355,9 +343,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
|
||||
endif
|
||||
endif
|
||||
if(nagain) ndeep=5
|
||||
call timer('osd174 ',0)
|
||||
call osd174(llrap,apmask,ndeep,decoded,cw,nharderrors,dmin)
|
||||
call timer('osd174 ',1)
|
||||
endif
|
||||
nbadcrc=1
|
||||
message=' '
|
||||
@ -373,16 +359,8 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
|
||||
nharderrors=-1
|
||||
cycle
|
||||
endif
|
||||
i3bit=4*decoded(73) + 2*decoded(74) + decoded(75)
|
||||
iFreeText=decoded(57)
|
||||
if(nbadcrc.eq.0) then
|
||||
decoded0=decoded
|
||||
if(i3bit.eq.1) decoded(57:)=0
|
||||
call extractmessage174(decoded,message,ncrcflag)
|
||||
decoded=decoded0
|
||||
! This needs fixing for messages with i3bit=1:
|
||||
call genft8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
|
||||
if(lsubtract) call subtractft8(dd0,itone,f1,xdt2)
|
||||
call extractmessage174(decoded,lhasgrid,msgcall,msggrid,ncrcflag)
|
||||
xsig=0.0
|
||||
xnoi=0.0
|
||||
do i=1,79
|
||||
@ -396,42 +374,6 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
|
||||
xsnr2=db(xsig/xbase - 1.0) - 32.0
|
||||
if(.not.nagain) xsnr=xsnr2
|
||||
if(xsnr .lt. -24.0) xsnr=-24.0
|
||||
|
||||
if(i3bit.eq.1) then
|
||||
do i=1,12
|
||||
i1hiscall(i)=ichar(hiscall12(i:i))
|
||||
enddo
|
||||
icrc10=crc10(c_loc(i1hiscall),12)
|
||||
write(cbits,1001) decoded
|
||||
1001 format(87i1)
|
||||
read(cbits,1002) ncrc10,nrpt
|
||||
1002 format(56x,b10,b6)
|
||||
irpt=nrpt-30
|
||||
i1=index(message,' ')
|
||||
i2=index(message(i1+1:),' ') + i1
|
||||
c1=message(1:i1)//' '
|
||||
c2=message(i1+1:i2)//' '
|
||||
|
||||
if(ncrc10.eq.icrc10) msg37=c1//' RR73; '//c2//' <'// &
|
||||
trim(hiscall12)//'> '
|
||||
if(ncrc10.ne.icrc10) msg37=c1//' RR73; '//c2//' <...> '
|
||||
|
||||
! msg37=c1//' RR73; '//c2//' <...> '
|
||||
write(msg37(35:37),1010) irpt
|
||||
1010 format(i3.2)
|
||||
if(msg37(35:35).ne.'-') msg37(35:35)='+'
|
||||
|
||||
iz=len(trim(msg37))
|
||||
do iter=1,10 !Collapse multiple blanks
|
||||
ib2=index(msg37(1:iz),' ')
|
||||
if(ib2.lt.1) exit
|
||||
msg37=msg37(1:ib2)//msg37(ib2+2:)
|
||||
iz=iz-1
|
||||
enddo
|
||||
else
|
||||
msg37=message//' '
|
||||
endif
|
||||
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
|
||||
79
ft8d.f90
79
ft8d.f90
@ -4,17 +4,14 @@ program ft8d
|
||||
|
||||
include 'ft8_params.f90'
|
||||
character infile*80,datetime*13,message*22,msg37*37
|
||||
character*22 allmessages(100)
|
||||
character*12 mycall12,hiscall12
|
||||
character*6 mygrid6,hisgrid6
|
||||
character msgcall*12, msggrid*4
|
||||
real s(NFFT1,NHSYM)
|
||||
real sbase(NFFT1)
|
||||
real candidate(3,200)
|
||||
real*8 dialfreq
|
||||
complex dd(NMAX,4)
|
||||
logical newdat,lsubtract,ldupe,bcontest
|
||||
logical newdat,lhasgrid
|
||||
integer apsym(KK)
|
||||
integer allsnrs(100)
|
||||
|
||||
nargs=iargc()
|
||||
if(nargs.ne.1) then
|
||||
@ -42,59 +39,29 @@ program ft8d
|
||||
datetime=infile(j2-13:j2-1)
|
||||
do ipart=1,4
|
||||
ndecodes=0
|
||||
allmessages=' '
|
||||
allsnrs=0
|
||||
ndepth=1
|
||||
npass=1
|
||||
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.
|
||||
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, &
|
||||
lhasgrid,msgcall,msggrid,xsnr)
|
||||
message=msg37(1:22)
|
||||
nsnr=nint(xsnr)
|
||||
xdt=xdt-0.5
|
||||
hd=nharderrors+dmin
|
||||
if(nbadcrc.eq.0 .and. lhasgrid) then
|
||||
write(*,1004) nutc+15*(ipart-1),min(sync,999.0),nint(xsnr), &
|
||||
xdt,nint(f1-2000+dialfreq),msggrid,msgcall
|
||||
1004 format(i6.6,f6.1,i4,f6.2,i9,1x,a4,1x,a12)
|
||||
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, &
|
||||
iaptype,mycall12,mygrid6,hiscall12,bcontest,sync,f1,xdt, &
|
||||
xbase,apsym,nharderrors,dmin,nbadcrc,iappass,iera,msg37,xsnr)
|
||||
message=msg37(1:22)
|
||||
nsnr=nint(xsnr)
|
||||
xdt=xdt-0.5
|
||||
hd=nharderrors+dmin
|
||||
if(nbadcrc.eq.0) then
|
||||
if(bcontest) then
|
||||
call fix_contest_msg(mygrid6,message)
|
||||
msg37(1:22)=message
|
||||
endif
|
||||
ldupe=.false.
|
||||
do id=1,ndecodes
|
||||
if(message.eq.allmessages(id).and.nsnr.le.allsnrs(id)) ldupe=.true.
|
||||
enddo
|
||||
if(.not.ldupe) then
|
||||
ndecodes=ndecodes+1
|
||||
allmessages(ndecodes)=message
|
||||
allsnrs(ndecodes)=nsnr
|
||||
endif
|
||||
write(*,1004) nutc+15*(ipart-1),ipass,iaptype,iappass, &
|
||||
nharderrors,dmin,hd,min(sync,999.0),nint(xsnr), &
|
||||
xdt,nint(f1-2000+dialfreq),message
|
||||
1004 format(i6.6,3i2,i3,3f6.1,i4,f6.2,i9,1x,a22)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
enddo ! ipart loop
|
||||
|
||||
|
||||
56
genft8.f90
56
genft8.f90
@ -1,56 +0,0 @@
|
||||
subroutine genft8(msg,mygrid,bcontest,i3bit,msgsent,msgbits,itone)
|
||||
|
||||
! Encode an FT8 message, producing array itone().
|
||||
|
||||
use crc
|
||||
use packjt
|
||||
include 'ft8_params.f90'
|
||||
character*22 msg,msgsent
|
||||
character*6 mygrid
|
||||
character*87 cbits
|
||||
logical bcontest,checksumok
|
||||
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)
|
||||
integer icos7(0:6)
|
||||
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
|
||||
|
||||
call packmsg(msg,i4Msg6BitWords,itype,bcontest) !Pack into 12 6-bit bytes
|
||||
call unpackmsg(i4Msg6BitWords,msgsent,bcontest,mygrid) !Unpack to get msgsent
|
||||
|
||||
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)
|
||||
|
||||
! For reference, here's how to check the CRC
|
||||
! i1Msg8BitBytes(10)=icrc12/256
|
||||
! i1Msg8BitBytes(11)=iand (icrc12,255)
|
||||
! checksumok = crc12_check(c_loc (i1Msg8BitBytes), 11)
|
||||
! if( checksumok ) write(*,*) 'Good checksum'
|
||||
|
||||
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
|
||||
|
||||
! Message structure: S7 D29 S7 D29 S7
|
||||
itone(1:7)=icos7
|
||||
itone(36+1:36+7)=icos7
|
||||
itone(NN-6:NN)=icos7
|
||||
k=7
|
||||
do j=1,ND
|
||||
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)
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine genft8
|
||||
@ -1,22 +0,0 @@
|
||||
subroutine genft8refsig(itone,cref,f0)
|
||||
complex cref(79*640)
|
||||
integer itone(79)
|
||||
real*8 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
|
||||
105
geodist.f90
105
geodist.f90
@ -1,105 +0,0 @@
|
||||
subroutine geodist(Eplat,Eplon,Stlat,Stlon,Az,Baz,Dist)
|
||||
implicit none
|
||||
real eplat, eplon, stlat, stlon, az, baz, dist
|
||||
|
||||
! JHT: In actual fact, I use the first two arguments for "My Location",
|
||||
! the second two for "His location"; West longitude is positive.
|
||||
|
||||
! Taken directly from:
|
||||
! Thomas, P.D., 1970, Spheroidal geodesics, reference systems,
|
||||
! & local geometry, U.S. Naval Oceanographi!Office SP-138,
|
||||
! 165 pp.
|
||||
! assumes North Latitude and East Longitude are positive
|
||||
|
||||
! EpLat, EpLon = End point Lat/Long
|
||||
! Stlat, Stlon = Start point lat/long
|
||||
! Az, BAz = direct & reverse azimuith
|
||||
! Dist = Dist (km); Deg = central angle, discarded
|
||||
|
||||
real BOA, F, P1R, P2R, L1R, L2R, DLR, T1R, T2R, TM, &
|
||||
DTM, STM, CTM, SDTM,CDTM, KL, KK, SDLMR, L, &
|
||||
CD, DL, SD, T, U, V, D, X, E, Y, A, FF64, TDLPM, &
|
||||
HAPBR, HAMBR, A1M2, A2M1
|
||||
|
||||
real AL,BL,D2R,Pi2
|
||||
|
||||
data AL/6378206.4/ ! Clarke 1866 ellipsoid
|
||||
data BL/6356583.8/
|
||||
! real pi /3.14159265359/
|
||||
data D2R/0.01745329251994/ ! degrees to radians conversion factor
|
||||
data Pi2/6.28318530718/
|
||||
|
||||
if(abs(Eplat-Stlat).lt.0.02 .and. abs(Eplon-Stlon).lt.0.02) then
|
||||
Az=0.
|
||||
Baz=180.0
|
||||
Dist=0
|
||||
go to 999
|
||||
endif
|
||||
|
||||
BOA = BL/AL
|
||||
F = 1.0 - BOA
|
||||
! Convert st/end pts to radians
|
||||
P1R = Eplat * D2R
|
||||
P2R = Stlat * D2R
|
||||
L1R = Eplon * D2R
|
||||
L2R = StLon * D2R
|
||||
DLR = L2R - L1R ! DLR = Delta Long in Rads
|
||||
T1R = ATan(BOA * Tan(P1R))
|
||||
T2R = ATan(BOA * Tan(P2R))
|
||||
TM = (T1R + T2R) / 2.0
|
||||
DTM = (T2R - T1R) / 2.0
|
||||
STM = Sin(TM)
|
||||
CTM = Cos(TM)
|
||||
SDTM = Sin(DTM)
|
||||
CDTM = Cos(DTM)
|
||||
KL = STM * CDTM
|
||||
KK = SDTM * CTM
|
||||
SDLMR = Sin(DLR/2.0)
|
||||
L = SDTM * SDTM + SDLMR * SDLMR * (CDTM * CDTM - STM * STM)
|
||||
CD = 1.0 - 2.0 * L
|
||||
DL = ACos(CD)
|
||||
SD = Sin(DL)
|
||||
T = DL/SD
|
||||
U = 2.0 * KL * KL / (1.0 - L)
|
||||
V = 2.0 * KK * KK / L
|
||||
D = 4.0 * T * T
|
||||
X = U + V
|
||||
E = -2.0 * CD
|
||||
Y = U - V
|
||||
A = -D * E
|
||||
FF64 = F * F / 64.0
|
||||
Dist = AL*SD*(T -(F/4.0)*(T*X-Y)+FF64*(X*(A+(T-(A+E) &
|
||||
/2.0)*X)+Y*(-2.0*D+E*Y)+D*X*Y))/1000.0
|
||||
TDLPM = Tan((DLR+(-((E*(4.0-X)+2.0*Y)*((F/2.0)*T+FF64* &
|
||||
(32.0*T+(A-20.0*T)*X-2.0*(D+2.0)*Y))/4.0)*Tan(DLR)))/2.0)
|
||||
HAPBR = ATan2(SDTM,(CTM*TDLPM))
|
||||
HAMBR = Atan2(CDTM,(STM*TDLPM))
|
||||
A1M2 = Pi2 + HAMBR - HAPBR
|
||||
A2M1 = Pi2 - HAMBR - HAPBR
|
||||
|
||||
1 If ((A1M2 .ge. 0.0) .AND. (A1M2 .lt. Pi2)) GOTO 5
|
||||
If (A1M2 .lt. Pi2) GOTO 4
|
||||
A1M2 = A1M2 - Pi2
|
||||
GOTO 1
|
||||
4 A1M2 = A1M2 + Pi2
|
||||
GOTO 1
|
||||
|
||||
! All of this gens the proper az, baz (forward and back azimuth)
|
||||
|
||||
5 If ((A2M1 .ge. 0.0) .AND. (A2M1 .lt. Pi2)) GOTO 9
|
||||
If (A2M1 .lt. Pi2) GOTO 8
|
||||
A2M1 = A2M1 - Pi2
|
||||
GOTO 5
|
||||
8 A2M1 = A2M1 + Pi2
|
||||
GOTO 5
|
||||
|
||||
9 Az = A1M2 / D2R
|
||||
BAZ = A2M1 / D2R
|
||||
|
||||
!Fix the mirrored coords here.
|
||||
|
||||
az = 360.0 - az
|
||||
baz = 360.0 - baz
|
||||
|
||||
999 return
|
||||
end subroutine geodist
|
||||
38
grid2deg.f90
38
grid2deg.f90
@ -1,38 +0,0 @@
|
||||
subroutine grid2deg(grid0,dlong,dlat)
|
||||
|
||||
! Converts Maidenhead grid locator to degrees of West longitude
|
||||
! and North latitude.
|
||||
|
||||
character*6 grid0,grid
|
||||
character*1 g1,g2,g3,g4,g5,g6
|
||||
|
||||
grid=grid0
|
||||
i=ichar(grid(5:5))
|
||||
if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm'
|
||||
|
||||
if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)= &
|
||||
char(ichar(grid(1:1))+ichar('A')-ichar('a'))
|
||||
if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)= &
|
||||
char(ichar(grid(2:2))+ichar('A')-ichar('a'))
|
||||
if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)= &
|
||||
char(ichar(grid(5:5))-ichar('A')+ichar('a'))
|
||||
if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)= &
|
||||
char(ichar(grid(6:6))-ichar('A')+ichar('a'))
|
||||
|
||||
g1=grid(1:1)
|
||||
g2=grid(2:2)
|
||||
g3=grid(3:3)
|
||||
g4=grid(4:4)
|
||||
g5=grid(5:5)
|
||||
g6=grid(6:6)
|
||||
|
||||
nlong = 180 - 20*(ichar(g1)-ichar('A'))
|
||||
n20d = 2*(ichar(g3)-ichar('0'))
|
||||
xminlong = 5*(ichar(g5)-ichar('a')+0.5)
|
||||
dlong = nlong - n20d - xminlong/60.0
|
||||
nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0')
|
||||
xminlat = 2.5*(ichar(g6)-ichar('a')+0.5)
|
||||
dlat = nlat + xminlat/60.0
|
||||
|
||||
return
|
||||
end subroutine grid2deg
|
||||
833
packjt.f90
833
packjt.f90
@ -6,28 +6,6 @@ module packjt
|
||||
|
||||
contains
|
||||
|
||||
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.
|
||||
@ -51,90 +29,6 @@ subroutine packbits(dbits,nsymd,m0,sym)
|
||||
return
|
||||
end subroutine unpackbits
|
||||
|
||||
subroutine packcall(callsign,ncall,text)
|
||||
|
||||
! Pack a valid callsign into a 28-bit integer.
|
||||
|
||||
parameter (NBASE=37*36*10*27*27*27)
|
||||
character callsign*6,c*1,tmp*6
|
||||
logical text
|
||||
|
||||
text=.false.
|
||||
|
||||
! Work-around for Swaziland prefix:
|
||||
if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6)
|
||||
|
||||
! Work-around for Guinea prefixes:
|
||||
if(callsign(1:2).eq.'3X' .and. callsign(3:3).ge.'A' .and. &
|
||||
callsign(3:3).le.'Z') callsign='Q'//callsign(3:6)
|
||||
|
||||
if(callsign(1:3).eq.'CQ ') then
|
||||
ncall=NBASE + 1
|
||||
if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and. &
|
||||
callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and. &
|
||||
callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
|
||||
read(callsign(4:6),*) nfreq
|
||||
ncall=NBASE + 3 + nfreq
|
||||
endif
|
||||
return
|
||||
else if(callsign(1:4).eq.'QRZ ') then
|
||||
ncall=NBASE + 2
|
||||
return
|
||||
else if(callsign(1:3).eq.'DE ') then
|
||||
ncall=267796945
|
||||
return
|
||||
endif
|
||||
|
||||
tmp=' '
|
||||
if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then
|
||||
tmp=callsign
|
||||
else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then
|
||||
if(callsign(6:6).ne.' ') then
|
||||
text=.true.
|
||||
return
|
||||
endif
|
||||
tmp=' '//callsign(:5)
|
||||
else
|
||||
text=.true.
|
||||
return
|
||||
endif
|
||||
|
||||
do i=1,6
|
||||
c=tmp(i:i)
|
||||
if(c.ge.'a' .and. c.le.'z') &
|
||||
tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A'))
|
||||
enddo
|
||||
|
||||
n1=0
|
||||
if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1
|
||||
if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1
|
||||
n2=0
|
||||
if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1
|
||||
if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1
|
||||
n3=0
|
||||
if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1
|
||||
n4=0
|
||||
if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1
|
||||
n5=0
|
||||
if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1
|
||||
n6=0
|
||||
if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1
|
||||
|
||||
if(n1+n2+n3+n4+n5+n6 .ne. 6) then
|
||||
text=.true.
|
||||
return
|
||||
endif
|
||||
|
||||
ncall=nchar(tmp(1:1))
|
||||
ncall=36*ncall+nchar(tmp(2:2))
|
||||
ncall=10*ncall+nchar(tmp(3:3))
|
||||
ncall=27*ncall+nchar(tmp(4:4))-10
|
||||
ncall=27*ncall+nchar(tmp(5:5))-10
|
||||
ncall=27*ncall+nchar(tmp(6:6))-10
|
||||
|
||||
return
|
||||
end subroutine packcall
|
||||
|
||||
subroutine unpackcall(ncall,word,iv2,psfx)
|
||||
|
||||
parameter (NBASE=37*36*10*27*27*27)
|
||||
@ -276,277 +170,14 @@ subroutine packbits(dbits,nsymd,m0,sym)
|
||||
return
|
||||
end subroutine unpackcall
|
||||
|
||||
subroutine packgrid(grid,ng,text)
|
||||
|
||||
parameter (NGBASE=180*180)
|
||||
character*4 grid
|
||||
character*1 c1
|
||||
logical text
|
||||
|
||||
text=.false.
|
||||
if(grid.eq.' ') go to 90 !Blank grid is OK
|
||||
|
||||
! First, handle signal reports in the original range, -01 to -30 dB
|
||||
if(grid(1:1).eq.'-') then
|
||||
read(grid(2:3),*,err=800,end=800) n
|
||||
if(n.ge.1 .and. n.le.30) then
|
||||
ng=NGBASE+1+n
|
||||
go to 900
|
||||
endif
|
||||
go to 10
|
||||
else if(grid(1:2).eq.'R-') then
|
||||
read(grid(3:4),*,err=800,end=800) n
|
||||
if(n.ge.1 .and. n.le.30) then
|
||||
ng=NGBASE+31+n
|
||||
go to 900
|
||||
endif
|
||||
go to 10
|
||||
! Now check for RO, RRR, or 73 in the message field normally used for grid
|
||||
else if(grid(1:4).eq.'RO ') then
|
||||
ng=NGBASE+62
|
||||
go to 900
|
||||
else if(grid(1:4).eq.'RRR ') then
|
||||
ng=NGBASE+63
|
||||
go to 900
|
||||
else if(grid(1:4).eq.'73 ') then
|
||||
ng=NGBASE+64
|
||||
go to 900
|
||||
endif
|
||||
|
||||
! Now check for extended-range signal reports: -50 to -31, and 0 to +49.
|
||||
10 n=99
|
||||
c1=grid(1:1)
|
||||
read(grid,*,err=20,end=20) n
|
||||
go to 30
|
||||
20 read(grid(2:4),*,err=30,end=30) n
|
||||
30 if(n.ge.-50 .and. n.le.49) then
|
||||
if(c1.eq.'R') then
|
||||
write(grid,1002) n+50
|
||||
1002 format('LA',i2.2)
|
||||
else
|
||||
write(grid,1003) n+50
|
||||
1003 format('KA',i2.2)
|
||||
endif
|
||||
go to 40
|
||||
endif
|
||||
|
||||
! Maybe it's free text ?
|
||||
if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true.
|
||||
if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true.
|
||||
if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true.
|
||||
if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true.
|
||||
if(text) go to 900
|
||||
|
||||
! OK, we have a properly formatted grid locator
|
||||
40 call grid2deg(grid//'mm',dlong,dlat)
|
||||
long=int(dlong)
|
||||
lat=int(dlat+ 90.0)
|
||||
ng=((long+180)/2)*180 + lat
|
||||
go to 900
|
||||
|
||||
90 ng=NGBASE + 1
|
||||
go to 900
|
||||
|
||||
800 text=.true.
|
||||
900 continue
|
||||
|
||||
return
|
||||
end subroutine packgrid
|
||||
|
||||
subroutine unpackgrid(ng,grid)
|
||||
|
||||
parameter (NGBASE=180*180)
|
||||
character grid*4,grid6*6
|
||||
|
||||
grid=' '
|
||||
if(ng.ge.32400) go to 10
|
||||
dlat=mod(ng,180)-90
|
||||
dlong=(ng/180)*2 - 180 + 2
|
||||
call deg2grid(dlong,dlat,grid6)
|
||||
grid=grid6(:4)
|
||||
if(grid(1:2).eq.'KA') then
|
||||
read(grid(3:4),*) n
|
||||
n=n-50
|
||||
write(grid,1001) n
|
||||
1001 format(i3.2)
|
||||
if(grid(1:1).eq.' ') grid(1:1)='+'
|
||||
else if(grid(1:2).eq.'LA') then
|
||||
read(grid(3:4),*) n
|
||||
n=n-50
|
||||
write(grid,1002) n
|
||||
1002 format('R',i3.2)
|
||||
if(grid(2:2).eq.' ') grid(2:2)='+'
|
||||
endif
|
||||
go to 900
|
||||
|
||||
10 n=ng-NGBASE-1
|
||||
if(n.ge.1 .and.n.le.30) then
|
||||
write(grid,1012) -n
|
||||
1012 format(i3.2)
|
||||
else if(n.ge.31 .and.n.le.60) then
|
||||
n=n-30
|
||||
write(grid,1022) -n
|
||||
1022 format('R',i3.2)
|
||||
else if(n.eq.61) then
|
||||
grid='RO'
|
||||
else if(n.eq.62) then
|
||||
grid='RRR'
|
||||
else if(n.eq.63) then
|
||||
grid='73'
|
||||
endif
|
||||
|
||||
900 return
|
||||
end subroutine unpackgrid
|
||||
|
||||
subroutine packmsg(msg0,dat,itype,bcontest)
|
||||
|
||||
! Packs a JT4/JT9/JT65 message into twelve 6-bit symbols
|
||||
|
||||
! itype Message Type
|
||||
!--------------------
|
||||
! 1 Standardd message
|
||||
! 2 Type 1 prefix
|
||||
! 3 Type 1 suffix
|
||||
! 4 Type 2 prefix
|
||||
! 5 Type 2 suffix
|
||||
! 6 Free text
|
||||
! -1 Does not decode correctly
|
||||
|
||||
parameter (NBASE=37*36*10*27*27*27)
|
||||
parameter (NBASE2=262178562)
|
||||
character*22 msg0,msg
|
||||
integer dat(:)
|
||||
character*12 c1,c2
|
||||
character*4 c3
|
||||
character*6 grid6
|
||||
logical text1,text2,text3,bcontest
|
||||
|
||||
itype=1
|
||||
if(bcontest) then
|
||||
call to_contest_msg(msg0,msg)
|
||||
else
|
||||
msg=msg0
|
||||
end if
|
||||
|
||||
call fmtmsg(msg,iz)
|
||||
if(msg(1:3).eq.'CQ ' .and. msg(4:4).ge.'0' .and. msg(4:4).le.'9' &
|
||||
.and. msg(5:5).eq.' ') msg='CQ 00'//msg(4:)
|
||||
|
||||
if(msg(1:6).eq.'CQ DX ') msg(3:3)='9'
|
||||
if(msg(1:3).eq.'CQ ' .and. &
|
||||
msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and. &
|
||||
msg(5:5).ge.'A' .and. msg(5:5).le.'Z' .and. &
|
||||
msg(6:6).eq.' ') msg='E9'//msg(4:)
|
||||
|
||||
! See if it's a CQ message
|
||||
if(msg(1:3).eq.'CQ ') then
|
||||
i=3
|
||||
! ... and if so, does it have a reply frequency?
|
||||
if(msg(4:4).ge.'0' .and. msg(4:4).le.'9' .and. &
|
||||
msg(5:5).ge.'0' .and. msg(5:5).le.'9' .and. &
|
||||
msg(6:6).ge.'0' .and. msg(6:6).le.'9') i=7
|
||||
go to 1
|
||||
endif
|
||||
|
||||
do i=1,22
|
||||
if(msg(i:i).eq.' ') go to 1 !Get 1st blank
|
||||
enddo
|
||||
go to 10 !Consider msg as plain text
|
||||
|
||||
1 ia=i
|
||||
c1=msg(1:ia-1)
|
||||
do i=ia+1,22
|
||||
if(msg(i:i).eq.' ') go to 2 !Get 2nd blank
|
||||
enddo
|
||||
go to 10 !Consider msg as plain text
|
||||
|
||||
2 ib=i
|
||||
c2=msg(ia+1:ib-1)
|
||||
|
||||
do i=ib+1,22
|
||||
if(msg(i:i).eq.' ') go to 3 !Get 3rd blank
|
||||
enddo
|
||||
go to 10 !Consider msg as plain text
|
||||
|
||||
3 ic=i
|
||||
c3=' '
|
||||
if(ic.ge.ib+1) c3=msg(ib+1:ic)
|
||||
if(c3.eq.'OOO ') c3=' ' !Strip out the OOO flag
|
||||
call getpfx1(c1,k1,nv2a)
|
||||
if(nv2a.ge.4) go to 10
|
||||
call packcall(c1,nc1,text1)
|
||||
if(text1) go to 10
|
||||
call getpfx1(c2,k2,nv2b)
|
||||
call packcall(c2,nc2,text2)
|
||||
if(text2) go to 10
|
||||
if(nv2a.eq.2 .or. nv2a.eq.3 .or. nv2b.eq.2 .or. nv2b.eq.3) then
|
||||
if(k1.lt.0 .or. k2.lt.0 .or. k1*k2.ne.0) go to 10
|
||||
if(k2.gt.0) k2=k2+450
|
||||
k=max(k1,k2)
|
||||
if(k.gt.0) then
|
||||
call k2grid(k,grid6)
|
||||
c3=grid6(:4)
|
||||
endif
|
||||
endif
|
||||
call packgrid(c3,ng,text3)
|
||||
|
||||
if(nv2a.lt.4 .and. nv2b.lt.4 .and. (.not.text1) .and. (.not.text2) .and. &
|
||||
(.not.text3)) go to 20
|
||||
|
||||
nc1=0
|
||||
if(nv2b.eq.4) then
|
||||
if(c1(1:3).eq.'CQ ' .and. (.not.text3)) nc1=262178563 + k2
|
||||
if(c1(1:4).eq.'QRZ ' .and. (.not.text3)) nc1=264002072 + k2
|
||||
if(c1(1:3).eq.'DE ' .and. (.not.text3)) nc1=265825581 + k2
|
||||
else if(nv2b.eq.5) then
|
||||
if(c1(1:3).eq.'CQ ' .and. (.not.text3)) nc1=267649090 + k2
|
||||
if(c1(1:4).eq.'QRZ ' .and. (.not.text3)) nc1=267698375 + k2
|
||||
if(c1(1:3).eq.'DE ' .and. (.not.text3)) nc1=267747660 + k2
|
||||
endif
|
||||
if(nc1.ne.0) go to 20
|
||||
|
||||
! The message will be treated as plain text.
|
||||
10 itype=6
|
||||
call packtext(msg,nc1,nc2,ng)
|
||||
ng=ng+32768
|
||||
|
||||
! Encode data into 6-bit words
|
||||
20 continue
|
||||
if(itype.ne.6) itype=max(nv2a,nv2b)
|
||||
jt_itype=itype
|
||||
jt_c1=c1(1:6)
|
||||
jt_c2=c2(1:6)
|
||||
jt_c3=c3
|
||||
jt_k1=k1
|
||||
jt_k2=k2
|
||||
jt_nc1=nc1
|
||||
jt_nc2=nc2
|
||||
jt_ng=ng
|
||||
dat(1)=iand(ishft(nc1,-22),63) !6 bits
|
||||
dat(2)=iand(ishft(nc1,-16),63) !6 bits
|
||||
dat(3)=iand(ishft(nc1,-10),63) !6 bits
|
||||
dat(4)=iand(ishft(nc1, -4),63) !6 bits
|
||||
dat(5)=4*iand(nc1,15)+iand(ishft(nc2,-26),3) !4+2 bits
|
||||
dat(6)=iand(ishft(nc2,-20),63) !6 bits
|
||||
dat(7)=iand(ishft(nc2,-14),63) !6 bits
|
||||
dat(8)=iand(ishft(nc2, -8),63) !6 bits
|
||||
dat(9)=iand(ishft(nc2, -2),63) !6 bits
|
||||
dat(10)=16*iand(nc2,3)+iand(ishft(ng,-12),15) !2+4 bits
|
||||
dat(11)=iand(ishft(ng,-6),63)
|
||||
dat(12)=iand(ng,63)
|
||||
|
||||
return
|
||||
end subroutine packmsg
|
||||
|
||||
subroutine unpackmsg(dat,msg,bcontest,mygrid)
|
||||
subroutine unpackmsg(dat,lhasgrid,msgcall,msggrid)
|
||||
|
||||
parameter (NBASE=37*36*10*27*27*27)
|
||||
parameter (NGBASE=180*180)
|
||||
integer dat(:)
|
||||
character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4,mygrid*6
|
||||
logical cqnnn,bcontest
|
||||
character msgcall*12,msggrid*4,grid6*6,junk2*4
|
||||
logical lhasgrid
|
||||
|
||||
cqnnn=.false.
|
||||
nc1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+ &
|
||||
ishft(dat(4),4) + iand(ishft(dat(5),-2),15)
|
||||
|
||||
@ -556,374 +187,20 @@ subroutine packbits(dbits,nsymd,m0,sym)
|
||||
|
||||
ng=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12)
|
||||
|
||||
if(ng.ge.32768) then
|
||||
call unpacktext(nc1,nc2,ng,msg)
|
||||
go to 100
|
||||
lhasgrid=.false.
|
||||
msggrid=' '
|
||||
if(ng.lt.32400 .and. ng.ne.533) then
|
||||
call unpackcall(nc2,msgcall,junk1,junk2)
|
||||
dlat=mod(ng,180)-90
|
||||
dlong=(ng/180)*2 - 180 + 2
|
||||
call deg2grid(dlong,dlat,grid6)
|
||||
msggrid=grid6(:4)
|
||||
lhasgrid=msggrid(1:2).ne.'KA' .and. msggrid(1:2).ne.'KA'
|
||||
endif
|
||||
|
||||
call unpackcall(nc1,c1,iv2,psfx)
|
||||
if(iv2.eq.0) then
|
||||
! This is an "original JT65" message
|
||||
if(nc1.eq.NBASE+1) c1='CQ '
|
||||
if(nc1.eq.NBASE+2) c1='QRZ '
|
||||
nfreq=nc1-NBASE-3
|
||||
if(nfreq.ge.0 .and. nfreq.le.999) then
|
||||
write(c1,1002) nfreq
|
||||
1002 format('CQ ',i3.3)
|
||||
cqnnn=.true.
|
||||
endif
|
||||
endif
|
||||
|
||||
call unpackcall(nc2,c2,junk1,junk2)
|
||||
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)
|
||||
if(k.ge.451 .and. k.le.900) call getpfx2(k,c2)
|
||||
|
||||
i=index(c1,char(0))
|
||||
if(i.ge.3) c1=c1(1:i-1)//' '
|
||||
i=index(c2,char(0))
|
||||
if(i.ge.3) c2=c2(1:i-1)//' '
|
||||
|
||||
msg=' '
|
||||
j=0
|
||||
if(cqnnn) then
|
||||
msg=c1//' '
|
||||
j=7 !### ??? ###
|
||||
go to 10
|
||||
endif
|
||||
|
||||
do i=1,12
|
||||
j=j+1
|
||||
msg(j:j)=c1(i:i)
|
||||
if(c1(i:i).eq.' ') go to 10
|
||||
enddo
|
||||
j=j+1
|
||||
msg(j:j)=' '
|
||||
|
||||
10 do i=1,12
|
||||
if(j.le.21) j=j+1
|
||||
msg(j:j)=c2(i:i)
|
||||
if(c2(i:i).eq.' ') go to 20
|
||||
enddo
|
||||
if(j.le.21) j=j+1
|
||||
msg(j:j)=' '
|
||||
|
||||
20 if(k.eq.0) then
|
||||
do i=1,4
|
||||
if(j.le.21) j=j+1
|
||||
msg(j:j)=grid(i:i)
|
||||
enddo
|
||||
if(j.le.21) j=j+1
|
||||
msg(j:j)=' '
|
||||
endif
|
||||
|
||||
100 continue
|
||||
if(msg(1:6).eq.'CQ9DX ') msg(3:3)=' '
|
||||
if(msg(1:2).eq.'E9' .and. &
|
||||
msg(3:3).ge.'A' .and. msg(3:3).le.'Z' .and. &
|
||||
msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and. &
|
||||
msg(5:5).eq.' ') msg='CQ '//msg(3:)
|
||||
|
||||
if(bcontest) call fix_contest_msg(mygrid,msg)
|
||||
|
||||
if(msg(1:5).eq.'CQ 00' .and. msg(6:6).ge.'0' .and. &
|
||||
msg(6:6).le.'9') msg='CQ '//msg(6:)
|
||||
|
||||
return
|
||||
end subroutine unpackmsg
|
||||
|
||||
subroutine packtext(msg,nc1,nc2,nc3)
|
||||
|
||||
parameter (MASK28=2**28 - 1)
|
||||
character*22 msg
|
||||
character*42 c
|
||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
||||
|
||||
nc1=0
|
||||
nc2=0
|
||||
nc3=0
|
||||
|
||||
do i=1,5 !First 5 characters in nc1
|
||||
do j=1,42 !Get character code
|
||||
if(msg(i:i).eq.c(j:j)) go to 10
|
||||
enddo
|
||||
j=37
|
||||
10 j=j-1 !Codes should start at zero
|
||||
nc1=42*nc1 + j
|
||||
enddo
|
||||
|
||||
do i=6,10 !Characters 6-10 in nc2
|
||||
do j=1,42 !Get character code
|
||||
if(msg(i:i).eq.c(j:j)) go to 20
|
||||
enddo
|
||||
j=37
|
||||
20 j=j-1 !Codes should start at zero
|
||||
nc2=42*nc2 + j
|
||||
enddo
|
||||
|
||||
do i=11,13 !Characters 11-13 in nc3
|
||||
do j=1,42 !Get character code
|
||||
if(msg(i:i).eq.c(j:j)) go to 30
|
||||
enddo
|
||||
j=37
|
||||
30 j=j-1 !Codes should start at zero
|
||||
nc3=42*nc3 + j
|
||||
enddo
|
||||
|
||||
! We now have used 17 bits in nc3. Must move one each to nc1 and nc2.
|
||||
nc1=nc1+nc1
|
||||
if(iand(nc3,32768).ne.0) nc1=nc1+1
|
||||
nc2=nc2+nc2
|
||||
if(iand(nc3,65536).ne.0) nc2=nc2+1
|
||||
nc3=iand(nc3,32767)
|
||||
|
||||
return
|
||||
end subroutine packtext
|
||||
|
||||
subroutine unpacktext(nc1,nc2,nc3,msg)
|
||||
|
||||
character*22 msg
|
||||
character*44 c
|
||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
||||
|
||||
nc3=iand(nc3,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
|
||||
nc2=nc2/2
|
||||
|
||||
do i=5,1,-1
|
||||
j=mod(nc1,42)+1
|
||||
msg(i:i)=c(j:j)
|
||||
nc1=nc1/42
|
||||
enddo
|
||||
|
||||
do i=10,6,-1
|
||||
j=mod(nc2,42)+1
|
||||
msg(i:i)=c(j:j)
|
||||
nc2=nc2/42
|
||||
enddo
|
||||
|
||||
do i=13,11,-1
|
||||
j=mod(nc3,42)+1
|
||||
msg(i:i)=c(j:j)
|
||||
nc3=nc3/42
|
||||
enddo
|
||||
msg(14:22) = ' '
|
||||
|
||||
return
|
||||
end subroutine unpacktext
|
||||
|
||||
subroutine getpfx1(callsign,k,nv2)
|
||||
|
||||
character*12 callsign0,callsign,lof,rof
|
||||
character*8 c
|
||||
character addpfx*8,tpfx*4,tsfx*3
|
||||
logical ispfx,issfx,invalid
|
||||
common/pfxcom/addpfx
|
||||
include 'pfx.f90'
|
||||
|
||||
callsign0=callsign
|
||||
nv2=1
|
||||
iz=index(callsign,' ') - 1
|
||||
if(iz.lt.0) iz=12
|
||||
islash=index(callsign(1:iz),'/')
|
||||
k=0
|
||||
! if(k.eq.0) go to 10 !Tnx to DL9RDZ for reminder:this was for tests only!
|
||||
c=' '
|
||||
if(islash.gt.0 .and. islash.le.(iz-4)) then
|
||||
! Add-on prefix
|
||||
c=callsign(1:islash-1)
|
||||
callsign=callsign(islash+1:iz)
|
||||
do i=1,NZ
|
||||
if(pfx(i)(1:4).eq.c) then
|
||||
k=i
|
||||
nv2=2
|
||||
go to 10
|
||||
endif
|
||||
enddo
|
||||
if(addpfx.eq.c) then
|
||||
k=449
|
||||
nv2=2
|
||||
go to 10
|
||||
endif
|
||||
|
||||
else if(islash.eq.(iz-1)) then
|
||||
! Add-on suffix
|
||||
c=callsign(islash+1:iz)
|
||||
callsign=callsign(1:islash-1)
|
||||
do i=1,NZ2
|
||||
if(sfx(i).eq.c(1:1)) then
|
||||
k=400+i
|
||||
nv2=3
|
||||
go to 10
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
|
||||
10 if(islash.ne.0 .and.k.eq.0) then
|
||||
! Original JT65 would force this compound callsign to be treated as
|
||||
! plain text. In JT65v2, we will encode the prefix or suffix into nc1.
|
||||
! The task here is to compute the proper value of k.
|
||||
lof=callsign0(:islash-1)
|
||||
rof=callsign0(islash+1:)
|
||||
llof=len_trim(lof)
|
||||
lrof=len_trim(rof)
|
||||
ispfx=(llof.gt.0 .and. llof.le.4)
|
||||
issfx=(lrof.gt.0 .and. lrof.le.3)
|
||||
invalid=.not.(ispfx.or.issfx)
|
||||
if(ispfx.and.issfx) then
|
||||
if(llof.lt.3) issfx=.false.
|
||||
if(lrof.lt.3) ispfx=.false.
|
||||
if(ispfx.and.issfx) then
|
||||
i=ichar(callsign0(islash-1:islash-1))
|
||||
if(i.ge.ichar('0') .and. i.le.ichar('9')) then
|
||||
issfx=.false.
|
||||
else
|
||||
ispfx=.false.
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
||||
if(invalid) then
|
||||
k=-1
|
||||
else
|
||||
if(ispfx) then
|
||||
tpfx=lof(1:4)
|
||||
k=nchar(tpfx(1:1))
|
||||
k=37*k + nchar(tpfx(2:2))
|
||||
k=37*k + nchar(tpfx(3:3))
|
||||
k=37*k + nchar(tpfx(4:4))
|
||||
nv2=4
|
||||
i=index(callsign0,'/')
|
||||
callsign=callsign0(:i-1)
|
||||
callsign=callsign0(i+1:)
|
||||
endif
|
||||
if(issfx) then
|
||||
tsfx=rof(1:3)
|
||||
k=nchar(tsfx(1:1))
|
||||
k=37*k + nchar(tsfx(2:2))
|
||||
k=37*k + nchar(tsfx(3:3))
|
||||
nv2=5
|
||||
i=index(callsign0,'/')
|
||||
callsign=callsign0(:i-1)
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine getpfx1
|
||||
|
||||
subroutine getpfx2(k0,callsign)
|
||||
|
||||
character callsign*12
|
||||
include 'pfx.f90'
|
||||
character addpfx*8
|
||||
common/pfxcom/addpfx
|
||||
|
||||
k=k0
|
||||
if(k.gt.450) k=k-450
|
||||
if(k.ge.1 .and. k.le.NZ) then
|
||||
iz=index(pfx(k),' ') - 1
|
||||
callsign=pfx(k)(1:iz)//'/'//callsign
|
||||
else if(k.ge.401 .and. k.le.400+NZ2) then
|
||||
iz=index(callsign,' ') - 1
|
||||
callsign=callsign(1:iz)//'/'//sfx(k-400)
|
||||
else if(k.eq.449) then
|
||||
iz=index(addpfx,' ') - 1
|
||||
if(iz.lt.1) iz=8
|
||||
callsign=addpfx(1:iz)//'/'//callsign
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine getpfx2
|
||||
|
||||
subroutine grid2k(grid,k)
|
||||
|
||||
character*6 grid
|
||||
|
||||
call grid2deg(grid,xlong,xlat)
|
||||
nlong=nint(xlong)
|
||||
nlat=nint(xlat)
|
||||
k=0
|
||||
if(nlat.ge.85) k=5*(nlong+179)/2 + nlat-84
|
||||
|
||||
return
|
||||
end subroutine grid2k
|
||||
|
||||
subroutine k2grid(k,grid)
|
||||
character grid*6
|
||||
|
||||
nlong=2*mod((k-1)/5,90)-179
|
||||
if(k.gt.450) nlong=nlong+180
|
||||
nlat=mod(k-1,5)+ 85
|
||||
dlat=nlat
|
||||
dlong=nlong
|
||||
call deg2grid(dlong,dlat,grid)
|
||||
|
||||
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.
|
||||
@ -948,90 +225,4 @@ subroutine packbits(dbits,nsymd,m0,sym)
|
||||
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
|
||||
|
||||
50
pfx.f90
50
pfx.f90
@ -1,50 +0,0 @@
|
||||
parameter (NZ=339) !Total number of prefixes
|
||||
parameter (NZ2=12) !Total number of suffixes
|
||||
character*1 sfx(NZ2)
|
||||
character*5 pfx(NZ)
|
||||
|
||||
data sfx/'P','0','1','2','3','4','5','6','7','8','9','A'/
|
||||
data pfx/ &
|
||||
'1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ', &
|
||||
'3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ', &
|
||||
'3YB ','3YP ','4J ','4L ','4S ','4U1I ','4U1U ','4W ', &
|
||||
'4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ', &
|
||||
'5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ', &
|
||||
'7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ', &
|
||||
'9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ', &
|
||||
'9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ', &
|
||||
'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ', &
|
||||
'C3 ','C5 ','C6 ','C9 ','CE ','CE0X ','CE0Y ','CE0Z ', &
|
||||
'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ', &
|
||||
'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ', &
|
||||
'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ', &
|
||||
'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ', &
|
||||
'F ','FG ','FH ','FJ ','FK ','FKC ','FM ','FO ', &
|
||||
'FOA ','FOC ','FOM ','FP ','FR ','FRG ','FRJ ','FRT ', &
|
||||
'FT5W ','FT5X ','FT5Z ','FW ','FY ','M ','MD ','MI ', &
|
||||
'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ', &
|
||||
'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0 ', &
|
||||
'HK0M ','HL ','HM ','HP ','HR ','HS ','HV ','HZ ', &
|
||||
'I ','IS ','IS0 ', 'J2 ','J3 ','J5 ','J6 ', &
|
||||
'J7 ','J8 ','JA ','JDM ','JDO ','JT ','JW ', &
|
||||
'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ', &
|
||||
'KH4 ','KH5 ','KH5K ','KH6 ','KH7 ','KH8 ','KH9 ','KL ', &
|
||||
'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ', &
|
||||
'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ', &
|
||||
'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ', &
|
||||
'PJ2 ','PJ7 ','PY ','PY0F ','PT0S ','PY0T ','PZ ','R1F ', &
|
||||
'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ', &
|
||||
'ST ','SU ','SV ','SVA ','SV5 ','SV9 ','T2 ','T30 ', &
|
||||
'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ', &
|
||||
'TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ', &
|
||||
'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ', &
|
||||
'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ', &
|
||||
'V6 ','V7 ','V8 ','VE ','VK ','VK0H ','VK0M ','VK9C ', &
|
||||
'VK9L ','VK9M ','VK9N ','VK9W ','VK9X ','VP2E ','VP2M ','VP2V ', &
|
||||
'VP5 ','VP6 ','VP6D ','VP8 ','VP8G ','VP8H ','VP8O ','VP8S ', &
|
||||
'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ', &
|
||||
'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ', &
|
||||
'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ', &
|
||||
'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ', &
|
||||
'ZD9 ','ZF ','ZK1N ','ZK1S ','ZK2 ','ZK3 ','ZL ','ZL7 ', &
|
||||
'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 ','KC4 ','E5 '/
|
||||
@ -1,67 +0,0 @@
|
||||
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}
|
||||
|
||||
use timer_module, only: timer
|
||||
|
||||
parameter (NMAX=15*4000,NFRAME=640*79)
|
||||
parameter (NFFT=NMAX,NFILT=700)
|
||||
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
|
||||
|
||||
@ -1,24 +0,0 @@
|
||||
module timer_module
|
||||
implicit none
|
||||
|
||||
abstract interface
|
||||
subroutine timer_callback (dname, k)
|
||||
character(len=8), intent(in) :: dname
|
||||
integer, intent(in) :: k
|
||||
end subroutine timer_callback
|
||||
end interface
|
||||
|
||||
public :: null_timer
|
||||
procedure(timer_callback), pointer :: timer => null_timer
|
||||
|
||||
contains
|
||||
!
|
||||
! default Fortran implementation which does nothing
|
||||
!
|
||||
subroutine null_timer (dname, k)
|
||||
implicit none
|
||||
character(len=8), intent(in) :: dname
|
||||
integer, intent(in) :: k
|
||||
if(dname.eq.'99999999' .and. k.eq.9999) stop !Silence compiler warnings
|
||||
end subroutine null_timer
|
||||
end module timer_module
|
||||
@ -1,27 +0,0 @@
|
||||
subroutine to_contest_msg(msg0,msg)
|
||||
|
||||
! If the message has "R grid4" istead of "grid4", remove the "R "
|
||||
! and substitute the diametrically opposite grid.
|
||||
|
||||
character*6 g1,g2
|
||||
character*22 msg0,msg
|
||||
logical isgrid
|
||||
isgrid(g1)=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. &
|
||||
g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. &
|
||||
g1(4:4).ge.'0' .and. g1(4:4).le.'9' .and. g1(1:4).ne.'RR73'
|
||||
|
||||
i0=index(msg0,' R ') + 3 !Check for ' R ' in message
|
||||
g1=msg0(i0:i0+3)//' '
|
||||
if(isgrid(g1)) then !Check for ' R grid'
|
||||
call grid2deg(g1,dlong,dlat)
|
||||
dlong=dlong+180.0
|
||||
if(dlong.gt.180.0) dlong=dlong-360.0
|
||||
dlat=-dlat
|
||||
call deg2grid(dlong,dlat,g2) !g2=antipodes grid
|
||||
msg=msg0(1:i0-3)//g2(1:4) !Send message with g2
|
||||
else
|
||||
msg=msg0
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine to_contest_msg
|
||||
Loading…
Reference in New Issue
Block a user