chris/js8call
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Squashed commit of the following:

Browse Source 
commit 0d6833b23da2519155ee93b98b4144240b356730
Author: Jordan Sherer <jordan@widefido.com>
Date:   Thu Sep 5 14:06:47 2019 -0400

    Bump version

commit 17705fcff6a22529f3dec45aa95cad90feb78c63
Author: Jordan Sherer <jordan@widefido.com>
Date:   Thu Sep 5 10:36:03 2019 -0400

    Updated configration labeling for idle timeout

commit a9f8aa9549c1c6b62201a6c102d91649ee17b9a5
Author: Jordan Sherer <jordan@widefido.com>
Date:   Thu Sep 5 10:07:11 2019 -0400

    Decoder params tests

commit 94e524741020fd8b3925233a189cedf0a8a282cc
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Sep 4 21:24:23 2019 -0400

    Fixed decoder bug that crashed the software

commit 4fdbfc8d9082e0f52513a5c215489b13558972f9
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Sep 4 21:02:52 2019 -0400

    Decoder params tweak

commit 1e25ac41d442372f09b254d957e0d9e31773254e
Merge: 97a0fb5 552cd7f
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Sep 4 18:17:40 2019 -0400

    Merge branch 'fortran-cleanup' of bitbucket.org:widefido/js8call-private into fortran-cleanup

commit 97a0fb51b37c24e2638400dc5694fc4e988ae4f2
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Sep 4 18:15:25 2019 -0400

    Heartbeat as a mode does not work if slow mode does not work. Tabling this idea for now.

commit 552cd7fe5fc81c712b57b5f3ea79599177e53f69
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 23:35:14 2019 +0000

    js8_params.f90 edited online with Bitbucket

commit 7c9e960b863148a4ecbca4f61584536471623ea2
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 16:28:52 2019 -0400

    Do not randomize offset at startup

commit cff7b90dbb9aada2944e668a9bcf078470af4608
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 16:20:19 2019 -0400

    Slow label for button

commit 977145dee89ccd7da4d43ce0bc2f9b79243aa200
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 16:17:36 2019 -0400

    Experimental slow mode

commit 27c128e0b327e1c077a9b49e11750bef2f3c26eb
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 15:26:01 2019 -0400

    HBs are Normal

commit 89792f91abf22dcd7c512bf7362f5e2e1cb36374
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 14:16:27 2019 -0400

    Update heartbeat UI for more clarity

commit f5cebbcdabe37d90b75ca7e8d1675a553e107c83
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 11:58:53 2019 -0400

    Optimize decode params

commit b14003bb34d93f9e93d7d4ad4241d619963c3a65
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 11:30:00 2019 -0400

    Shrink speed column for Joe ;)

commit 35f4446146efc9fd7044af3b56b0b93664238b24
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 10:54:28 2019 -0400

    Fixed fast mode decoder for directed messages

commit 64212acc30dd360348a72b354899a5b0de28aa83
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 10:05:11 2019 -0400

    Simplified decoder callbacks

commit a026766517d282a3fda0258356f6f22fee2a916f
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Sep 3 09:50:33 2019 -0400

    Commentary

commit 9d28b1ff5bd5cda7a04028218a01639e3902bf7b
Author: Jordan Sherer <jordan@widefido.com>
Date:   Mon Sep 2 23:33:22 2019 -0400

    Let's experiment with a new UI for HB

commit a013d66d8b8d16cc941a14eb76af2ce23b7bb6d5
Author: Jordan Sherer <jordan@widefido.com>
Date:   Mon Sep 2 21:44:26 2019 -0400

    31.25 baud experiment

commit 0671458bf588dd94710c5ba34f20695e13a28d31
Author: Jordan Sherer <jordan@widefido.com>
Date:   Mon Sep 2 15:31:43 2019 -0400

    Added basic foundation for slow mode, coming soon.

commit 8b9aed6e29b093e8fb736ebdbdf0fbe12a820e8e
Author: Jordan Sherer <jordan@widefido.com>
Date:   Mon Sep 2 09:59:08 2019 -0400

    Display SPEED+AUTO

commit 5f5af250c1c5b610e8969b32c01654d3467f0973
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sun Sep 1 09:45:39 2019 -0400

    Added mode speed option to the activity tables

commit 82fa0335fdd41f0a578149e0211d6307293c739d
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 31 23:14:07 2019 -0400

    Remember mode speed setting

commit 79ec805b223099bb4d552dc612a6c97a8982525e
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 31 21:14:04 2019 -0400

    Remove unused sync vars

commit fc52dfcc320e59f6c7ca58ba277cb70469419587
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 31 21:12:11 2019 -0400

    Timing delta max

commit 62b8fc5054d3611d40d7441d57d695df594b8446
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 31 17:14:08 2019 -0400

    Fast modes optionally can use huff encoding for data... we'll see which is best

commit 44c357aff3e1c6687e93fb843917bd420888b397
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 31 17:03:21 2019 -0400

    Added ability to use a different message packing algorithm for fast modes

commit e075a078eb75509ef690e6c78c0e797ada569b94
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 31 16:18:14 2019 -0400

    Fixed symbol offset in sync code for turbo mode

commit a130b5d4a594e9bceece003be0ba72abb05a9f90
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 31 16:09:27 2019 -0400

    Added WPM to menu

commit 98cacab7bfc243492b6dec703d216d378cc3d34d
Author: Jordan Sherer <jordan@widefido.com>
Date:   Fri Aug 30 23:18:58 2019 -0400

    Key eater

commit eef58e2c88d010c7f3917a111243eae744a425c3
Author: Jordan Sherer <jordan@widefido.com>
Date:   Fri Aug 30 16:07:31 2019 -0400

    Reorganizing js8dec for better understanding and less confusion between it and JS8b

commit 08c14f966e1cda836ca90a8bd1ccd5ae68ec8dd7
Author: Jordan Sherer <jordan@widefido.com>
Date:   Fri Aug 30 14:20:52 2019 -0400

    Do no expose relay and messaging to fast and turbo modes

commit c605a31c266866f78eb043812af837ead6442ede
Author: Jordan Sherer <jordan@widefido.com>
Date:   Fri Aug 30 12:02:41 2019 -0400

    Do not allow mode speed changes if transmitting

commit add062e657a5215f9a4a1ae3ee82063aa85cf0e4
Author: Jordan Sherer <jordan@widefido.com>
Date:   Thu Aug 29 23:02:31 2019 -0400

    Fixed bug where tones were not generated with the correct costas arrays...causing really poor synchronization and failed decodes. I'm surprised it worked at all :P

commit cd492b5dd9fd62b5518a5711a1ef8ec522ea08fe
Author: Jordan Sherer <jordan@widefido.com>
Date:   Thu Aug 29 21:56:45 2019 -0400

    Back to 20 baud. It has the best decodability, imho

commit a2266cd00b8bd14c77bdbc8fc18818689e969858
Author: Jordan Sherer <jordan@widefido.com>
Date:   Thu Aug 29 14:27:29 2019 -0400

    Back to 20 baud with some decoder optimizations

commit 86413042e75873585bcb40236da67f2d64870859
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 28 23:04:47 2019 -0400

    Try 24 baud

commit a6704162b37d1c0704f43a64ab6b8a0a6e3c1cba
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 28 17:09:12 2019 -0400

    Fixed legacy compiler issue with mode text

commit 2fdbcc12e5f0c8cc8062c745af0930db4472cd9c
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 28 10:17:23 2019 -0400

    Function for determining current mode

commit 82e70345baa665418a51307f0309f2b7dcb3d3b7
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 28 09:59:26 2019 -0400

    Don't write the log

commit d3380e01676537f4bab9a05932cb5a59de3cf45f
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 28 09:59:03 2019 -0400

    Fixed issues with turbo decode with partial sync code

commit c2a8ebb8f305e67fcb2597d25e062663722a0d73
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 28 03:30:02 2019 -0400

    Working through better decoding of fast modes

commit 7ca93f8c6a7970559577c9dfd833eb92a1b91a0c
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Aug 27 23:23:34 2019 -0400

    Trying for better TX/RX delays

commit b99271b4feaa7e41c7b88219cb3c7d43dbe7b48d
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Aug 27 22:57:02 2019 -0400

    Added flags to easily enable/disable the faster modes

commit 32d913a7f7d3deb6a8d66651d51673ec451d2500
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Aug 27 22:43:20 2019 -0400

    Added mode button

commit c7cc90548591638bfc5a4a8895036dd67b155aaa
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Aug 27 22:17:42 2019 -0400

    Updated start delay for the modes

commit b91dc63f92101cd8b6adbf9de588c4ffd10bfc10
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Aug 27 21:55:57 2019 -0400

    Late threshold for turbo mode is 1/2 the delay

commit 09ec95fab1307e65aa9bd462d60525afd2a770fe
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Aug 27 21:52:55 2019 -0400

    Renamed mode menu items

commit a4e5a9ed9bce66c625e4df1182cd3c91a6ba44dd
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Aug 27 21:50:45 2019 -0400

    Only enable networking and autoreply for normal JS8

commit fc558d5823c46fc5d3dc651610b7af43e7519165
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Aug 27 21:14:12 2019 -0400

    Fixed spot button tooltip

commit 9a9965d543540a2d215bcbfff34934846afe507a
Author: Jordan Sherer <jordan@widefido.com>
Date:   Tue Aug 27 10:04:31 2019 -0400

    Working selectable decoder

commit 4a9cdbc52dae1d857c102d8777f1aded4fac87bb
Author: Jordan Sherer <jordan@widefido.com>
Date:   Mon Aug 26 20:53:30 2019 -0400

    Mode menu selection of the submodes. Turbo decoder disabled right now. Naming to be determined

commit a3acbf7c243f7aa740c229ae178fffa528e68933
Merge: 8ea554d daa8cc2
Author: Jordan Sherer <jordan@widefido.com>
Date:   Mon Aug 26 13:29:14 2019 -0400

    Merge branch 'ft8call-develop' into fortran-cleanup

commit 8ea554d79904c9b2f3ccf1027bf4d41fb25e6fe3
Author: Jordan Sherer <jordan@widefido.com>
Date:   Mon Aug 26 09:53:21 2019 -0400

    Use indx variable instead of computed

commit 067e65500328133f921b172e515babbcc0df831b
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sun Aug 25 22:41:00 2019 -0400

    Make it easier to flip between modes

commit a544a7635201072f3ea20483353edf2e79dc813d
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sun Aug 25 21:18:46 2019 -0400

    Fixed sync issues with multi costas. Added log statements for future debugging

commit a8f3ead932017ae7d98fdb9a779bf3bb44bd395d
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sun Aug 25 15:54:59 2019 -0400

    Playing around with different costas arrays

commit fa89fe11a15d26abadd5102c8980620cfeffccd9
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sun Aug 25 15:51:45 2019 -0400

    Added reference to 7x7 costas arrays

commit 2417ebed6139534214f76ce94bdf1f54a966760a
Merge: 6011f1e 32fcabd
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 24 23:41:39 2019 -0400

    Merge branch 'ft8call-develop' into fortran-cleanup

commit 6011f1e807b1814399477d3c172db46831a090c6
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 24 23:35:42 2019 -0400

    Back to 10 baud. Update late threshold to be computed to 3/4 dead air time.

commit 41d3995861226f7208b2773430010a48abc125c1
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 24 15:36:12 2019 -0400

    Trying out 20 baud

commit a8d77e9e5b98f3f0bf19f68b53199b5952e8aaad
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 24 15:23:36 2019 -0400

    Fixed up sync quarter symbol constant

commit 7050722436b9c629ea00649e6b3c81d7af7be82a
Author: Jordan Sherer <jordan@widefido.com>
Date:   Sat Aug 24 14:43:48 2019 -0400

    Computed symbol stop

commit f130fe87abdccbabd2e71f2771b789c7f46d57ca
Author: Jordan Sherer <jordan@widefido.com>
Date:   Fri Aug 23 20:56:59 2019 -0400

    Added reference to 7x7 costas arrays

commit 53e91858f5a4e9ce78c38ef65c77e87f1903c058
Author: Jordan Sherer <jordan@widefido.com>
Date:   Fri Aug 23 16:34:51 2019 -0400

    Back to 10 baud

commit 1ae79d566ebd9a40ad3cf4a07977ef0e09615d91
Author: Jordan Sherer <jordan@widefido.com>
Date:   Fri Aug 23 15:14:41 2019 -0400

    Testing 31.25 baud

commit 7e033c28ae090d6c3f5a63fa651ee51c3243d61c
Author: Jordan Sherer <jordan@widefido.com>
Date:   Fri Aug 23 15:14:17 2019 -0400

    Experimenting with a few different baudrates

commit 050e24ad3a040924ded6d641004ae63da47e4251
Author: Jordan Sherer <jordan@widefido.com>
Date:   Fri Aug 23 12:25:50 2019 -0400

    Added ldpcsim for js8

commit d309a75d860e39737dec732560432a191290b258
Author: Jordan Sherer <jordan@widefido.com>
Date:   Thu Aug 22 22:42:11 2019 -0400

    Experimental submode switching

commit 74f72bb24a22631b8b69942ea0633bb0564b8aa3
Author: Jordan Sherer <jordan@widefido.com>
Date:   Thu Aug 22 22:41:53 2019 -0400

    Allow switching decoders based on submode

commit f8740a23b27e80fa53350e140d4638a27cd6e975
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 21 23:43:18 2019 -0400

    Initial spike of js8 fortran code

commit 31625316639f79246b4a2e3d0cea4507bf0547f9
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 21 23:09:00 2019 -0400

    Remove fix contest message

commit c0e0862afa8ae2d47e9577562399b8c9bc929c6a
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 21 21:05:05 2019 -0400

    Cleanup unused text files and batch files

commit 1b3aa55869f0c310e6c911a7cbb3fe269bc7421a
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 21 21:00:38 2019 -0400

    Removed fast_decode and dx

commit 49e5cabff25c13620a9d2c6fc6ddd4988f1be217
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 21 20:54:39 2019 -0400

    Cleaning up msk stuff

commit 8bde6f391f4b23d2a2e9d55685d96bc647a462f6
Author: Jordan Sherer <jordan@widefido.com>
Date:   Wed Aug 21 20:44:39 2019 -0400

    Initial cleanup pass of qra, ftrsd, and wsprd
This commit is contained in:
Jordan Sherer
2019-09-05 14:07:24 -04:00
parent daa8cc2c3e
commit c24e931f09
206 changed files with 3792 additions and 22217 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/js8/baselinejs8.f90
+51
View File
@@ -0,0 +1,51 @@
subroutine baselinejs8(s,nfa,nfb,sbase)
! Fit baseline to spectrum (for FT8)
! Input: s(npts) Linear scale in power
! Output: sbase(npts) Baseline
implicit real*8 (a-h,o-z)
!include 'js8_params.f90'
real*4 s(NSPS)
real*4 sbase(NSPS)
real*4 base
real*8 x(1000),y(1000),a(5)
data nseg/10/,npct/10/
df=12000.0/(NSPS*2.0d0) !3.125 Hz
ia=max(1,nint(nfa/df))
ib=nint(nfb/df)
do i=ia,ib
s(i)=10.0*log10(s(i)) !Convert to dB scale
enddo
nterms=5
nlen=(ib-ia+1)/nseg !Length of test segment
i0=(ib-ia+1)/2 !Midpoint
k=0
do n=1,nseg !Loop over all segments
ja=ia + (n-1)*nlen
jb=ja+nlen-1
call pctile(s(ja),nlen,npct,base) !Find lowest npct of points
do i=ja,jb
if(s(i).le.base) then
if (k.lt.1000) k=k+1 !Save all "lower envelope" points
x(k)=i-i0
y(k)=s(i)
endif
enddo
enddo
kz=k
a=0.
call polyfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial
do i=ia,ib
t=i-i0
sbase(i)=a(1)+t*(a(2)+t*(a(3)+t*(a(4)+t*(a(5))))) + 0.65
! write(51,3051) i*df,s(i),sbase(i)
!3051 format(3f12.3)
enddo
return
end subroutine baselinejs8
lib/js8/costas/Costas_essense_N=7.txt
+30
View File
@@ -0,0 +1,30 @@
0 1 5 3 6 2 4
0 1 6 3 5 4 2
0 1 6 4 3 5 2
0 2 5 1 6 3 4
0 2 5 1 6 4 3
0 2 6 5 3 4 1
0 3 4 2 6 5 1
0 3 4 6 1 5 2
0 3 5 4 2 6 1
0 4 2 5 6 1 3
0 4 6 5 2 3 1
0 5 4 6 2 3 1
0 6 2 3 5 4 1
1 0 4 6 2 5 3
1 0 5 3 6 2 4
1 2 4 0 6 5 3
1 3 2 5 6 0 4
1 3 4 0 6 5 2
1 3 6 2 0 5 4
1 4 0 5 6 3 2
1 4 0 6 5 2 3
1 4 5 0 2 6 3
1 4 5 3 0 6 2
1 4 6 0 5 2 3
1 4 6 0 5 3 2
1 5 0 2 3 6 4
1 5 6 0 3 2 4
2 1 4 6 0 5 3
2 3 0 6 5 1 4
2 5 0 6 4 1 3
lib/js8/costas/Costas_symmetrical_N=7.txt
+10
View File
@@ -0,0 +1,10 @@
0 1 5 3 6 2 4
0 1 6 3 5 4 2
0 1 6 4 3 5 2
0 6 2 3 5 4 1
1 0 4 6 2 5 3
1 0 5 3 6 2 4
1 4 5 0 2 6 3
1 4 5 3 0 6 2
1 5 0 2 3 6 4
2 5 0 6 4 1 3
lib/js8/costas/Sorted_Costas_arrays_N=7.txt
+201
View File
@@ -0,0 +1,201 @@
7 200
0 1 5 3 6 2 4
0 1 6 3 5 4 2
0 1 6 4 3 5 2
0 2 5 1 6 3 4
0 2 5 1 6 4 3
0 2 6 5 3 4 1
0 3 1 5 6 2 4
0 3 1 6 5 2 4
0 3 4 2 6 5 1
0 3 4 6 1 5 2
0 3 5 4 2 6 1
0 4 2 5 6 1 3
0 4 6 1 2 5 3
0 4 6 5 2 3 1
0 5 2 6 1 3 4
0 5 4 6 2 3 1
0 6 1 4 5 3 2
0 6 2 3 5 4 1
0 6 3 1 2 5 4
0 6 4 1 3 2 5
0 6 4 5 1 3 2
0 6 4 5 2 1 3
1 0 4 6 2 5 3
1 0 5 3 6 2 4
1 2 4 0 6 5 3
1 3 2 5 6 0 4
1 3 2 5 6 4 0
1 3 2 6 4 5 0
1 3 4 0 6 5 2
1 3 6 2 0 5 4
1 4 0 5 6 3 2
1 4 0 6 5 2 3
1 4 3 5 2 0 6
1 4 3 5 6 2 0
1 4 5 0 2 6 3
1 4 5 3 0 6 2
1 4 5 3 2 6 0
1 4 6 0 5 2 3
1 4 6 0 5 3 2
1 5 0 2 3 6 4
1 5 6 0 3 2 4
1 5 6 2 4 3 0
1 6 2 4 5 3 0
1 6 4 5 0 3 2
2 0 3 4 6 1 5
2 0 5 6 1 4 3
2 0 6 5 1 3 4
2 1 4 0 5 6 3
2 1 4 5 0 6 3
2 1 4 5 3 0 6
2 1 4 6 0 5 3
2 1 6 4 0 3 5
2 1 6 4 5 0 3
2 3 0 5 1 4 6
2 3 0 5 4 6 1
2 3 0 6 5 1 4
2 3 1 5 4 6 0
2 3 5 0 4 1 6
2 3 5 0 6 4 1
2 3 5 1 0 6 4
2 3 5 4 1 6 0
2 3 6 5 0 4 1
2 4 0 1 5 3 6
2 4 0 3 1 5 6
2 4 0 3 1 6 5
2 4 1 0 5 3 6
2 4 1 5 6 0 3
2 4 1 6 5 0 3
2 4 3 6 0 1 5
2 4 5 3 6 1 0
2 5 0 1 6 4 3
2 5 0 6 4 1 3
2 5 1 0 6 3 4
2 5 1 6 4 3 0
2 5 3 4 6 1 0
2 5 6 0 4 1 3
2 5 6 0 4 3 1
2 5 6 1 3 0 4
2 6 0 1 4 3 5
2 6 0 3 5 4 1
2 6 3 5 0 1 4
3 0 1 6 2 5 4
3 0 4 6 1 2 5
3 0 5 4 6 1 2
3 0 5 6 1 4 2
3 0 6 1 2 5 4
3 0 6 5 1 4 2
3 1 0 6 2 4 5
3 1 2 5 4 6 0
3 1 4 0 2 6 5
3 1 4 0 6 5 2
3 1 4 5 0 2 6
3 1 4 6 0 5 2
3 1 6 0 2 5 4
3 1 6 5 2 4 0
3 2 0 5 1 4 6
3 2 0 5 6 1 4
3 2 5 0 1 6 4
3 2 5 0 6 4 1
3 2 5 6 0 4 1
3 4 1 0 6 2 5
3 4 1 6 0 2 5
3 4 1 6 5 0 2
3 4 6 1 0 5 2
3 4 6 1 5 2 0
3 5 0 1 4 2 6
3 5 0 6 4 1 2
3 5 2 0 6 1 4
3 5 2 1 6 4 0
3 5 2 6 0 1 4
3 5 2 6 4 0 1
3 5 4 1 2 0 6
3 5 6 0 4 2 1
3 6 0 1 5 2 4
3 6 0 5 4 1 2
3 6 1 0 5 2 4
3 6 1 2 0 5 4
3 6 2 0 5 4 1
3 6 5 0 4 1 2
4 0 3 1 6 5 2
4 0 6 3 1 2 5
4 0 6 5 2 3 1
4 1 0 5 3 6 2
4 1 0 6 2 3 5
4 1 0 6 2 5 3
4 1 3 2 0 5 6
4 1 5 0 2 3 6
4 1 5 6 0 3 2
4 1 6 0 2 5 3
4 1 6 5 0 2 3
4 2 1 3 0 5 6
4 2 3 0 6 5 1
4 2 5 0 1 6 3
4 2 5 1 0 6 3
4 2 5 6 1 3 0
4 2 6 3 5 0 1
4 2 6 3 5 1 0
4 2 6 5 1 3 0
4 3 0 1 6 2 5
4 3 1 2 5 0 6
4 3 1 5 6 0 2
4 3 1 6 0 2 5
4 3 1 6 2 5 0
4 3 5 1 2 0 6
4 3 6 0 1 5 2
4 3 6 1 2 0 5
4 3 6 1 5 2 0
4 5 0 2 1 6 3
4 5 0 2 6 3 1
4 5 2 0 6 1 3
4 5 2 1 3 6 0
4 5 2 1 6 0 3
4 5 2 6 1 0 3
4 6 0 1 5 3 2
4 6 1 0 5 2 3
4 6 3 2 0 5 1
5 0 2 1 6 3 4
5 0 4 2 1 3 6
5 1 0 4 2 3 6
5 1 0 6 3 4 2
5 1 6 4 3 0 2
5 2 0 6 1 3 4
5 2 0 6 1 4 3
5 2 1 3 4 0 6
5 2 1 3 6 0 4
5 2 1 6 4 0 3
5 2 3 1 0 4 6
5 2 3 1 4 6 0
5 2 6 0 1 4 3
5 2 6 1 0 3 4
5 3 0 4 6 1 2
5 3 2 6 0 1 4
5 3 4 0 2 1 6
5 3 4 1 0 2 6
5 3 4 1 0 6 2
5 4 2 6 0 1 3
5 6 1 3 0 4 2
5 6 2 0 4 1 3
6 0 2 1 4 5 3
6 0 2 1 5 3 4
6 0 2 5 3 4 1
6 0 3 5 4 1 2
6 0 4 3 1 2 5
6 0 5 2 1 3 4
6 1 2 0 4 3 5
6 1 4 0 5 3 2
6 2 0 1 4 3 5
6 2 0 5 4 1 3
6 2 4 1 0 5 3
6 3 1 2 4 0 5
6 3 2 0 5 1 4
6 3 2 4 0 1 5
6 3 5 0 1 4 2
6 3 5 1 0 4 2
6 4 0 1 3 2 5
6 4 1 5 0 2 3
6 4 1 5 0 3 2
6 5 0 2 3 1 4
6 5 0 3 1 2 4
6 5 1 3 0 4 2
lib/js8/genjs8.f90
+93
View File
@@ -0,0 +1,93 @@
subroutine genjs8(msg,mygrid,bcontest,i3bit,msgsent,msgbits,itone)
! Encode an FT8 message, producing array itone().
use crc
use packjt
include 'js8_params.f90'
parameter (KK=87) !Information bits (75 + CRC12)
parameter (ND=58) !Data symbols
parameter (NS=21) !Sync symbols (3 @ Costas 7x7)
parameter (NN=NS+ND) !Total channel symbols (79)
character*68 alphabet
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 icos7a(0:6), icos7b(0:6), icos7c(0:6)
if(NCOSTAS.eq.1) then
icos7a = (/4,2,5,6,1,3,0/) !Beginning Costas 7x7 tone pattern
icos7b = (/4,2,5,6,1,3,0/) !Middle Costas 7x7 tone pattern
icos7c = (/4,2,5,6,1,3,0/) !End Costas 7x7 tone pattern
else
icos7a = (/0,6,2,3,5,4,1/) !Beginning Costas 7x7 tone pattern
icos7b = (/1,5,0,2,3,6,4/) !Middle Costas 7x7 tone pattern
icos7c = (/2,5,0,6,4,1,3/) !End Costas 7x7 tone pattern
endif
alphabet='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-+/?.'
itype=6
do i=1,12
v=index(alphabet, msg(i:i))
if(v.eq.0) exit
i4Msg6BitWords(i)=v - 1
enddo
msgsent=' '
msgsent(1:12)=msg(1:12)
! 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),transfer(128+64+32,0_1))
i1Msg8BitBytes(11)=0
icrc12=crc12(c_loc(i1Msg8BitBytes),11)
icrc12=xor(icrc12, 42) ! TODO: jsherer - could change the crc here
! 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)=icos7a
itone(36+1:36+7)=icos7b
itone(NN-6:NN)=icos7c
k=7
do j=1,ND
i=3*j -2
k=k+1
if(j.eq.30) k=k+7
indx=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2)
itone(k)=indx
enddo
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) 'tones', itone
write(99,*) '...', icos7a, '--->', NCOSTAS
close(99)
endif
return
end subroutine genjs8
lib/js8/genjs8refsig.f90
+24
View File
@@ -0,0 +1,24 @@
subroutine genjs8refsig(itone,cref,f0)
!include 'js8_params.f90'
complex cref(NN*NSPS)
integer itone(NN)
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=NSPS*1.0d0
dt=1.d0/12000.d0
phi=0.d0
k=1
do i=1,NN
dphi=twopi*(f0*dt+itone(i)/xnsps)
do is=1,NSPS
cref(k)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
k=k+1
enddo
enddo
return
end subroutine genjs8refsig
lib/js8/js8_downsample.f90
+54
View File
@@ -0,0 +1,54 @@
subroutine js8_downsample(dd,newdat,f0,c1)
! Downconvert to complex data sampled at 200 Hz ==> 32 samples/symbol
!include 'js8_params.f90'
parameter (NDFFT1=NSPS*NDD, NDFFT2=NDFFT1/NDOWN) ! Downconverted FFT Size - 192000/60 = 3200
logical newdat,first
complex c1(0:NDFFT2-1)
complex cx(0:NDFFT1/2)
real dd(NMAX),x(NDFFT1),taper(0:NDD)
equivalence (x,cx)
data first/.true./
save cx,first,taper
if(first) then
pi=4.0*atan(1.0)
do i=0,NDD
taper(i)=0.5*(1.0+cos(i*pi/NDD))
enddo
first=.false.
endif
if(newdat) then
! Data in dd have changed, recompute the long FFT
x(1:NMAX)=dd
x(NMAX+1:NDFFT1)=0. !Zero-pad the x array
call four2a(cx,NDFFT1,1,-1,0) !r2c FFT to freq domain
newdat=.false.
endif
df=12000.0/NDFFT1
baud=12000.0/NSPS
i0=nint(f0/df)
ft=f0+8.5*baud
it=min(nint(ft/df),NDFFT1/2)
fb=f0-1.5*baud
ib=max(1,nint(fb/df))
k=0
c1=0.
do i=ib,it
c1(k)=cx(i)
k=k+1
enddo
c1(0:NDD)=c1(0:NDD)*taper(NDD:0:-1)
c1(k-1-NDD:k-1)=c1(k-1-NDD:k-1)*taper
c1=cshift(c1,i0-ib)
call four2a(c1,NDFFT2,1,1,1) !c2c FFT back to time domain
fac=1.0/sqrt(float(NDFFT1)*NDFFT2)
c1=fac*c1
return
end subroutine js8_downsample
lib/js8/js8_params.f90
+2
View File
@@ -0,0 +1,2 @@
parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas)
parameter (NWRITELOG=0) !Write log file?
lib/js8/js8b_params.f90
+36
View File
@@ -0,0 +1,36 @@
!parameter (NSPS=480) !Samples per symbol at 12000 S/s
!parameter (NTXDUR=5) !TX Duration in Seconds
!parameter (NDOWNSPS=16) !Downsampled samples per symbol
!parameter (AZ=6.0) !Near dupe sync spacing
!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins
!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ?
! parameter (NSPS=384, NTXDUR=4, NDOWNSPS=16, NDD=150, JZ=116) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=16, NDD=160, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=16, NDD=136, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s
! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120, JZ=116) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s
! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s
! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s
! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s
parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=172) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s
! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s
! parameter (NSPS=4000, NTXDUR=30, NDOWNSPS=20, NDD=90, JZ=62) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s
parameter (AZ=12000.0/(1.0*NSPS)*0.64d0) !Dedupe overlap in Hz
parameter (ASTART=0.2) !Start delay in seconds
parameter (ASYNCMIN=1.5) !Minimum Sync
parameter (KK=87) !Information bits (75 + CRC12)
parameter (ND=58) !Data symbols
parameter (NS=21) !Sync symbols (3 @ Costas 7x7)
parameter (NN=NS+ND) !Total channel symbols (79)
parameter (NZ=NSPS*NN) !Samples in full 15 s waveform (151,680)
parameter (NMAX=NTXDUR*12000) !Samples in iwave (180,000)
parameter (NFFT1=2*NSPS, NH1=NFFT1/2) !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=NSPS/NDOWNSPS) !Downsample factor to 32 samples per symbol
parameter (NQSYMBOL=NDOWNSPS/4) !Downsample factor of a quarter symbol
lib/js8/js8c_params.f90
+36
View File
@@ -0,0 +1,36 @@
!parameter (NSPS=480) !Samples per symbol at 12000 S/s
!parameter (NTXDUR=5) !TX Duration in Seconds
!parameter (NDOWNSPS=16) !Downsampled samples per symbol
!parameter (AZ=6.0) !Near dupe sync spacing
!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins
!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ?
! parameter (NSPS=384, NTXDUR=4, NDOWNSPS=16, NDD=150, JZ=116) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=16, NDD=160, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=16, NDD=136, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s
parameter (NSPS=600, NTXDUR=6, NDOWNSPS=12, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s
! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s
! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s
! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s
! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=116) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s
! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s
! parameter (NSPS=4000, NTXDUR=30, NDOWNSPS=20, NDD=90, JZ=62) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s
parameter (AZ=12000.0/(1.0*NSPS)*0.64d0) !Dedupe overlap in Hz
parameter (ASTART=0.1) !Start delay in seconds
parameter (ASYNCMIN=1.5) !Minimum Sync
parameter (KK=87) !Information bits (75 + CRC12)
parameter (ND=58) !Data symbols
parameter (NS=21) !Sync symbols (3 @ Costas 7x7)
parameter (NN=NS+ND) !Total channel symbols (79)
parameter (NZ=NSPS*NN) !Samples in full 15 s waveform (151,680)
parameter (NMAX=NTXDUR*12000) !Samples in iwave (180,000)
parameter (NFFT1=2*NSPS, NH1=NFFT1/2) !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=NSPS/NDOWNSPS) !Downsample factor to 32 samples per symbol
parameter (NQSYMBOL=NDOWNSPS/4) !Downsample factor of a quarter symbol
lib/js8/js8d_params.f90
+36
View File
@@ -0,0 +1,36 @@
!parameter (NSPS=480) !Samples per symbol at 12000 S/s
!parameter (NTXDUR=5) !TX Duration in Seconds
!parameter (NDOWNSPS=16) !Downsampled samples per symbol
!parameter (AZ=6.0) !Near dupe sync spacing
!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins
!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ?
parameter (NSPS=384, NTXDUR=4, NDOWNSPS=12, NDD=125, JZ=250) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s
! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s
! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s
! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s
! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s
! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=116) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s
! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s
! parameter (NSPS=4000, NTXDUR=30, NDOWNSPS=40, NDD=90, JZ=116) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s
parameter (AZ=12000.0/(1.0*NSPS)*0.64d0) !Dedupe overlap in Hz
parameter (ASTART=0.1) !Start delay in seconds
parameter (ASYNCMIN=1.5) !Minimum Sync
parameter (KK=87) !Information bits (75 + CRC12)
parameter (ND=58) !Data symbols
parameter (NS=21) !Sync symbols (3 @ Costas 7x7)
parameter (NN=NS+ND) !Total channel symbols (79)
parameter (NZ=NSPS*NN) !Samples in full 15 s waveform (151,680)
parameter (NMAX=NTXDUR*12000) !Samples in iwave (180,000)
parameter (NFFT1=2*NSPS, NH1=NFFT1/2) !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=NSPS/NDOWNSPS) !Downsample factor to 32 samples per symbol
parameter (NQSYMBOL=NDOWNSPS/4) !Downsample factor of a quarter symbol
lib/js8/js8dec.f90
+486
View File
@@ -0,0 +1,486 @@
subroutine js8dec(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)
use crc
use timer_module, only: timer
!include 'js8_params.f90'
parameter(NP=3200) ! why 3200? not sure...
parameter(NP2=2812)
character*37 msg37
character message*22,msgsent*22,origmsg*22
character*12 mycall12,hiscall12
character*6 mycall6,mygrid6,hiscall6,c1,c2
character*87 cbits
logical bcontest
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 dd0(NMAX)
integer*1 decoded(KK),decoded0(KK),apmask(3*ND),cw(3*ND)
integer*1 msgbits(KK)
integer apsym(KK)
integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16)
integer itone(NN)
integer indxs1(8*ND)
integer 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(0:NP-1)
complex ctwk(4*NSPS/NDOWN)
complex csymb(NDOWNSPS)
logical first,newdat,lsubtract,lapon,lapcqonly,nagain
equivalence (s1,s1sort)
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/
data first/.true./
save nappasses,naptypes
integer icos7a(0:6), icos7b(0:6), icos7c(0:6)
if(NCOSTAS.eq.1) then
icos7a = (/4,2,5,6,1,3,0/) !Beginning Costas 7x7 tone pattern
icos7b = (/4,2,5,6,1,3,0/) !Middle Costas 7x7 tone pattern
icos7c = (/4,2,5,6,1,3,0/) !End Costas 7x7 tone pattern
else
icos7a = (/0,6,2,3,5,4,1/) !Beginning Costas 7x7 tone pattern
icos7b = (/1,5,0,2,3,6,4/) !Middle Costas 7x7 tone pattern
icos7c = (/2,5,0,6,4,1,3/) !End Costas 7x7 tone pattern
endif
if(first) then
mcq=2*mcq-1
mde=2*mde-1
mrrr=2*mrrr-1
m73=2*m73-1
mrr73=2*mrr73-1
nappasses(0)=2
nappasses(1)=2
nappasses(2)=2
nappasses(3)=4
nappasses(4)=4
nappasses(5)=3
! iaptype
!------------------------
! 1 CQ ??? ???
! 2 MyCall ??? ???
! 3 MyCall DxCall ???
! 4 MyCall DxCall RRR
! 5 MyCall DxCall 73
! 6 MyCall DxCall RR73
! 7 ??? DxCall ???
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/)
first=.false.
endif
max_iterations=30
nharderrors=-1
fs2=12000.0/NDOWN
dt2=1.0/fs2
twopi=8.0*atan(1.0)
delfbest=0.
ibest=0
call timer('js8_down',0)
call js8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample
call timer('js8_down',1)
xdt=xdt+ASTART
i0=nint(xdt*fs2) !Initial guess for start of signal
smax=0.0
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) 'initial dt guess', i0, xdt
close(99)
endif
do idt=i0-NQSYMBOL,i0+NQSYMBOL !Search over +/- one quarter symbol
call syncjs8d(cd0,idt,ctwk,0,sync)
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) 'idt', idt, 'sync', sync
close(99)
endif
if(sync.gt.smax) then
smax=sync
ibest=idt
endif
enddo
xdt2=ibest*dt2 !Improved estimate for DT
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) 'xdt2', xdt2, ibest
close(99)
endif
! Now peak up in frequency
i0=nint(xdt2*fs2)
smax=0.0
do ifr=-5,5 !Search over +/- 2.5 Hz
delf=ifr*0.5
dphi=twopi*delf*dt2
phi=0.0
do i=1,NDOWNSPS
ctwk(i)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
enddo
call syncjs8d(cd0,i0,ctwk,1,sync)
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) 'df', delf, 'sync', sync
close(99)
endif
if( sync .gt. smax ) then
smax=sync
delfbest=delf
endif
enddo
a=0.0
a(1)=-delfbest
call twkfreq1(cd0,NP2,fs2,a,cd0)
xdt=xdt2
f1=f1+delfbest !Improved estimate of DF
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) 'twk', xdt, f1, smax
close(99)
endif
call syncjs8d(cd0,i0,ctwk,2,sync)
j=0
do k=1,NN
i1=ibest+(k-1)*NDOWNSPS
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+(NDOWNSPS-1) .le. NP2-1 ) csymb=cd0(i1:i1+(NDOWNSPS-1))
call four2a(csymb,NDOWNSPS,1,-1,1)
s2(0:7,k)=abs(csymb(1:8))/1e3
enddo
! sync quality check
is1=0
is2=0
is3=0
do k=1,7
ip=maxloc(s2(:,k))
if(icos7a(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s2(:,k+36))
if(icos7b(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s2(:,k+72))
if(icos7c(k-1).eq.(ip(1)-1)) is3=is3+1
enddo
! hard sync sum - max is 21
nsync=is1+is2+is3
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) 'sync', ibest, nsync
close(99)
endif
if(nsync .le. 6) then ! bail out
call timer('badnsync', 0)
nbadcrc=1
call timer('badnsync', 1)
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)
enddo
call indexx(s1sort,8*ND,indxs1)
xmeds1=s1sort(indxs1(nint(0.5*8*ND)))
s1=s1/xmeds1
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
! 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)
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))
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 timer('bpd174 ',0)
call bpdecode174(llrap,apmask,max_iterations,decoded,cw,nharderrors, &
niterations)
call timer('bpd174 ',1)
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) '> bpd174 ', ipass, nharderrors, dmin
close(99)
endif
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
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=' '
xsnr=-99.0
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) '> osd174', ipass, nharderrors, dmin, nharderrors + dmin, sync
close(99)
endif
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)
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) '> crc', decoded
if(nbadcrc.eq.1) then
write(99,*) '> crc failed'
endif
close(99)
endif
else
nharderrors=-1
cycle
endif
i3bit=4*decoded(73) + 2*decoded(74) + decoded(75)
if(nbadcrc.eq.0) then
decoded0=decoded
call extractmessage174(decoded,origmsg,ncrcflag)
decoded=decoded0
message(1:12)=origmsg(1:12)
call genjs8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
if(lsubtract) call subtractjs8(dd0,itone,f1,xdt2)
xsig=0.0
xnoi=0.0
do i=1,NN
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
msg37=origmsg//' '
msg37(22:22) = char(48 + i3bit)
return
endif
enddo
return
end subroutine js8dec
lib/js8/ldpcsim174js8b.f90
+238
View File
@@ -0,0 +1,238 @@
program ldpcsim174js8
! End to end test of the (174,75)/crc12 encoder and decoder.
use crc
use packjt
include 'js8_params.f90'
include 'js8b_params.f90'
character*22 msg,msgsent,msgreceived
character*8 arg
character*6 grid
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(11)
integer*1 msgbits(87)
integer*1 apmask(174), cw(174)
integer*2 checksum
integer*4 i4Msg6BitWords(13)
integer colorder(174)
integer nerrtot(174),nerrdec(174),nmpcbad(87)
logical checksumok,fsk,bpsk
real*8, allocatable :: rxdata(:)
real, allocatable :: llr(:)
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/
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.4) then
print*,'Usage: ldpcsim niter ndepth #trials s '
print*,'eg: ldpcsim 10 2 1000 0.84'
print*,'belief propagation iterations: niter, ordered-statistics depth: ndepth'
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndepth
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
fsk=.false.
bpsk=.true.
! don't count crc bits as data bits
N=174
K=87
! scale Eb/No for a (174,87) code
rate=real(K)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," s= ",s
allocate ( codeword(N), decoded(K), message(K) )
allocate ( rxdata(N), llr(N) )
msg="0123456789012"
! msg="G4WJS K9AN EN50"
call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent,.false.,grid) !Unpack to get msgsent
write(*,*) "message sent ",msgsent
i4=0
ik=0
im=0
do i=1,12
nna=i4Msg6BitWords(i)
do j=1, 6
ik=ik+1
i4=i4+i4+iand(1,ishft(nna,j-6))
i4=iand(i4,255)
if(ik.eq.8) then
im=im+1
! if(i4.gt.127) i4=i4-256
i1Msg8BitBytes(im)=i4
ik=0
endif
enddo
enddo
i1Msg8BitBytes(10:11)=0
checksum = crc12 (c_loc (i1Msg8BitBytes), 11)
checksum = xor(checksum, 42) ! TODO: jsherer - could change the crc here
! For reference, the next 3 lines show how to check the CRC
i1Msg8BitBytes(10)=checksum/256
i1Msg8BitBytes(11)=iand(checksum,transfer(255,0_2))
checksumok = crc12_check(c_loc (i1Msg8BitBytes), 11)
if( checksumok ) write(*,*) 'Good checksum'
! K=87, For now:
! msgbits(1:72) JT message bits
! msgbits(73:75) 3 free message bits (set to 0)
! msgbits(76:87) CRC12
mbit=0
do i=1, 9
i1=i1Msg8BitBytes(i)
do ibit=1,8
mbit=mbit+1
msgbits(mbit)=iand(1,ishft(i1,ibit-8))
enddo
enddo
msgbits(73:75)=0 ! the three extra message bits go here
i1=i1Msg8BitBytes(10) ! First 4 bits of crc12 are LSB of this byte
do ibit=1,4
msgbits(75+ibit)=iand(1,ishft(i1,ibit-4))
enddo
i1=i1Msg8BitBytes(11) ! Now shift in last 8 bits of the CRC
do ibit=1,8
msgbits(79+ibit)=iand(1,ishft(i1,ibit-8))
enddo
write(*,*) 'message'
write(*,'(11(8i1,1x))') msgbits
call encode174(msgbits,codeword)
call init_random_seed()
! call sgran()
write(*,*) 'codeword'
write(*,'(22(8i1,1x))') codeword
write(*,*) "Es/N0 SNR2500 ngood nundetected nbadcrc sigma"
do idb = 20,-10,-1
!do idb = -3,-3,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*(10**(db/10.0)) )
ngood=0
nue=0
nbadcrc=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
if( bpsk ) then
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
elseif( fsk ) then
if( codeword(i) .eq. 1 ) then
r1=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r2=(sigma*gran())**2 + (sigma*gran())**2
elseif( codeword(i) .eq. 0 ) then
r2=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r1=(sigma*gran())**2 + (sigma*gran())**2
endif
! rxdata(i)=0.35*(sqrt(r1)-sqrt(r2))
! rxdata(i)=0.35*(exp(r1)-exp(r2))
rxdata(i)=0.12*(log(r1)-log(r2))
endif
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
if(nerr.ge.1) nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
! Correct signal normalization is important for this decoder.
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
! magnitude in UER
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
nap=0 ! number of AP bits
llr(colorder(174-87+1:174-87+nap)+1)=5*(2.0*msgbits(1:nap)-1.0)
apmask=0
apmask(colorder(174-87+1:174-87+nap)+1)=1
! max_iterations is max number of belief propagation iterations
call bpdecode174(llr, apmask, max_iterations, decoded, cw, nharderrors,niterations)
if( ndepth .ge. 0 .and. nharderrors .lt. 0 ) call osd174(llr, apmask, ndepth, decoded, cw, nharderrors, dmin)
! If the decoder finds a valid codeword, nharderrors will be .ge. 0.
if( nharderrors .ge. 0 ) then
call extractmessage174(decoded,msgreceived,ncrcflag)
if( ncrcflag .ne. 1 ) then
nbadcrc=nbadcrc+1
endif
nueflag=0
nerrmpc=0
do i=1,K ! find number of errors in message+crc part of codeword
if( msgbits(i) .ne. decoded(i) ) then
nueflag=1
nerrmpc=nerrmpc+1
endif
enddo
if(nerrmpc.ge.1) nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1
if( ncrcflag .eq. 1 ) then
if( nueflag .eq. 0 ) then
ngood=ngood+1
if(nerr.ge.1) nerrdec(nerr)=nerrdec(nerr)+1
else if( nueflag .eq. 1 ) then
nue=nue+1;
endif
endif
endif
enddo
baud=12000.0/NSPS
snr2500=db+10.0*log10((baud/2500.0))
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,174
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
open(unit=25,file='nmpcbad.dat',status='unknown')
do i=1,87
write(25,'(i4,2x,i10)') i,nmpcbad(i)
enddo
close(25)
end program ldpcsim174js8
lib/js8/ldpcsim174js8c.f90
+238
View File
@@ -0,0 +1,238 @@
program ldpcsim174js8
! End to end test of the (174,75)/crc12 encoder and decoder.
use crc
use packjt
include 'js8_params.f90'
include 'js8c_params.f90'
character*22 msg,msgsent,msgreceived
character*8 arg
character*6 grid
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(11)
integer*1 msgbits(87)
integer*1 apmask(174), cw(174)
integer*2 checksum
integer*4 i4Msg6BitWords(13)
integer colorder(174)
integer nerrtot(174),nerrdec(174),nmpcbad(87)
logical checksumok,fsk,bpsk
real*8, allocatable :: rxdata(:)
real, allocatable :: llr(:)
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/
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.4) then
print*,'Usage: ldpcsim niter ndepth #trials s '
print*,'eg: ldpcsim 10 2 1000 0.84'
print*,'belief propagation iterations: niter, ordered-statistics depth: ndepth'
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndepth
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
fsk=.false.
bpsk=.true.
! don't count crc bits as data bits
N=174
K=87
! scale Eb/No for a (174,87) code
rate=real(K)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," s= ",s
allocate ( codeword(N), decoded(K), message(K) )
allocate ( rxdata(N), llr(N) )
msg="0123456789012"
! msg="G4WJS K9AN EN50"
call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent,.false.,grid) !Unpack to get msgsent
write(*,*) "message sent ",msgsent
i4=0
ik=0
im=0
do i=1,12
nna=i4Msg6BitWords(i)
do j=1, 6
ik=ik+1
i4=i4+i4+iand(1,ishft(nna,j-6))
i4=iand(i4,255)
if(ik.eq.8) then
im=im+1
! if(i4.gt.127) i4=i4-256
i1Msg8BitBytes(im)=i4
ik=0
endif
enddo
enddo
i1Msg8BitBytes(10:11)=0
checksum = crc12 (c_loc (i1Msg8BitBytes), 11)
checksum = xor(checksum, 42) ! TODO: jsherer - could change the crc here
! For reference, the next 3 lines show how to check the CRC
i1Msg8BitBytes(10)=checksum/256
i1Msg8BitBytes(11)=iand(checksum,transfer(255,0_2))
checksumok = crc12_check(c_loc (i1Msg8BitBytes), 11)
if( checksumok ) write(*,*) 'Good checksum'
! K=87, For now:
! msgbits(1:72) JT message bits
! msgbits(73:75) 3 free message bits (set to 0)
! msgbits(76:87) CRC12
mbit=0
do i=1, 9
i1=i1Msg8BitBytes(i)
do ibit=1,8
mbit=mbit+1
msgbits(mbit)=iand(1,ishft(i1,ibit-8))
enddo
enddo
msgbits(73:75)=0 ! the three extra message bits go here
i1=i1Msg8BitBytes(10) ! First 4 bits of crc12 are LSB of this byte
do ibit=1,4
msgbits(75+ibit)=iand(1,ishft(i1,ibit-4))
enddo
i1=i1Msg8BitBytes(11) ! Now shift in last 8 bits of the CRC
do ibit=1,8
msgbits(79+ibit)=iand(1,ishft(i1,ibit-8))
enddo
write(*,*) 'message'
write(*,'(11(8i1,1x))') msgbits
call encode174(msgbits,codeword)
call init_random_seed()
! call sgran()
write(*,*) 'codeword'
write(*,'(22(8i1,1x))') codeword
write(*,*) "Es/N0 SNR2500 ngood nundetected nbadcrc sigma"
do idb = 20,-10,-1
!do idb = -3,-3,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*(10**(db/10.0)) )
ngood=0
nue=0
nbadcrc=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
if( bpsk ) then
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
elseif( fsk ) then
if( codeword(i) .eq. 1 ) then
r1=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r2=(sigma*gran())**2 + (sigma*gran())**2
elseif( codeword(i) .eq. 0 ) then
r2=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r1=(sigma*gran())**2 + (sigma*gran())**2
endif
! rxdata(i)=0.35*(sqrt(r1)-sqrt(r2))
! rxdata(i)=0.35*(exp(r1)-exp(r2))
rxdata(i)=0.12*(log(r1)-log(r2))
endif
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
if(nerr.ge.1) nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
! Correct signal normalization is important for this decoder.
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
! magnitude in UER
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
nap=0 ! number of AP bits
llr(colorder(174-87+1:174-87+nap)+1)=5*(2.0*msgbits(1:nap)-1.0)
apmask=0
apmask(colorder(174-87+1:174-87+nap)+1)=1
! max_iterations is max number of belief propagation iterations
call bpdecode174(llr, apmask, max_iterations, decoded, cw, nharderrors,niterations)
if( ndepth .ge. 0 .and. nharderrors .lt. 0 ) call osd174(llr, apmask, ndepth, decoded, cw, nharderrors, dmin)
! If the decoder finds a valid codeword, nharderrors will be .ge. 0.
if( nharderrors .ge. 0 ) then
call extractmessage174(decoded,msgreceived,ncrcflag)
if( ncrcflag .ne. 1 ) then
nbadcrc=nbadcrc+1
endif
nueflag=0
nerrmpc=0
do i=1,K ! find number of errors in message+crc part of codeword
if( msgbits(i) .ne. decoded(i) ) then
nueflag=1
nerrmpc=nerrmpc+1
endif
enddo
if(nerrmpc.ge.1) nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1
if( ncrcflag .eq. 1 ) then
if( nueflag .eq. 0 ) then
ngood=ngood+1
if(nerr.ge.1) nerrdec(nerr)=nerrdec(nerr)+1
else if( nueflag .eq. 1 ) then
nue=nue+1;
endif
endif
endif
enddo
baud=12000.0/NSPS
snr2500=db+10.0*log10((baud/2500.0))
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,174
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
open(unit=25,file='nmpcbad.dat',status='unknown')
do i=1,87
write(25,'(i4,2x,i10)') i,nmpcbad(i)
enddo
close(25)
end program ldpcsim174js8
lib/js8/ldpcsim174js8d.f90
+238
View File
@@ -0,0 +1,238 @@
program ldpcsim174js8
! End to end test of the (174,75)/crc12 encoder and decoder.
use crc
use packjt
include 'js8_params.f90'
include 'js8d_params.f90'
character*22 msg,msgsent,msgreceived
character*8 arg
character*6 grid
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(11)
integer*1 msgbits(87)
integer*1 apmask(174), cw(174)
integer*2 checksum
integer*4 i4Msg6BitWords(13)
integer colorder(174)
integer nerrtot(174),nerrdec(174),nmpcbad(87)
logical checksumok,fsk,bpsk
real*8, allocatable :: rxdata(:)
real, allocatable :: llr(:)
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/
nerrtot=0
nerrdec=0
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
nargs=iargc()
if(nargs.ne.4) then
print*,'Usage: ldpcsim niter ndepth #trials s '
print*,'eg: ldpcsim 10 2 1000 0.84'
print*,'belief propagation iterations: niter, ordered-statistics depth: ndepth'
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) ndepth
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
fsk=.false.
bpsk=.true.
! don't count crc bits as data bits
N=174
K=87
! scale Eb/No for a (174,87) code
rate=real(K)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," s= ",s
allocate ( codeword(N), decoded(K), message(K) )
allocate ( rxdata(N), llr(N) )
msg="0123456789012"
! msg="G4WJS K9AN EN50"
call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent,.false.,grid) !Unpack to get msgsent
write(*,*) "message sent ",msgsent
i4=0
ik=0
im=0
do i=1,12
nna=i4Msg6BitWords(i)
do j=1, 6
ik=ik+1
i4=i4+i4+iand(1,ishft(nna,j-6))
i4=iand(i4,255)
if(ik.eq.8) then
im=im+1
! if(i4.gt.127) i4=i4-256
i1Msg8BitBytes(im)=i4
ik=0
endif
enddo
enddo
i1Msg8BitBytes(10:11)=0
checksum = crc12 (c_loc (i1Msg8BitBytes), 11)
checksum = xor(checksum, 42) ! TODO: jsherer - could change the crc here
! For reference, the next 3 lines show how to check the CRC
i1Msg8BitBytes(10)=checksum/256
i1Msg8BitBytes(11)=iand(checksum,transfer(255,0_2))
checksumok = crc12_check(c_loc (i1Msg8BitBytes), 11)
if( checksumok ) write(*,*) 'Good checksum'
! K=87, For now:
! msgbits(1:72) JT message bits
! msgbits(73:75) 3 free message bits (set to 0)
! msgbits(76:87) CRC12
mbit=0
do i=1, 9
i1=i1Msg8BitBytes(i)
do ibit=1,8
mbit=mbit+1
msgbits(mbit)=iand(1,ishft(i1,ibit-8))
enddo
enddo
msgbits(73:75)=0 ! the three extra message bits go here
i1=i1Msg8BitBytes(10) ! First 4 bits of crc12 are LSB of this byte
do ibit=1,4
msgbits(75+ibit)=iand(1,ishft(i1,ibit-4))
enddo
i1=i1Msg8BitBytes(11) ! Now shift in last 8 bits of the CRC
do ibit=1,8
msgbits(79+ibit)=iand(1,ishft(i1,ibit-8))
enddo
write(*,*) 'message'
write(*,'(11(8i1,1x))') msgbits
call encode174(msgbits,codeword)
call init_random_seed()
! call sgran()
write(*,*) 'codeword'
write(*,'(22(8i1,1x))') codeword
write(*,*) "Es/N0 SNR2500 ngood nundetected nbadcrc sigma"
do idb = 20,-10,-1
!do idb = -3,-3,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*(10**(db/10.0)) )
ngood=0
nue=0
nbadcrc=0
nberr=0
do itrial=1, ntrials
! Create a realization of a noisy received word
do i=1,N
if( bpsk ) then
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
elseif( fsk ) then
if( codeword(i) .eq. 1 ) then
r1=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r2=(sigma*gran())**2 + (sigma*gran())**2
elseif( codeword(i) .eq. 0 ) then
r2=(1.0 + sigma*gran())**2 + (sigma*gran())**2
r1=(sigma*gran())**2 + (sigma*gran())**2
endif
! rxdata(i)=0.35*(sqrt(r1)-sqrt(r2))
! rxdata(i)=0.35*(exp(r1)-exp(r2))
rxdata(i)=0.12*(log(r1)-log(r2))
endif
enddo
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
if(nerr.ge.1) nerrtot(nerr)=nerrtot(nerr)+1
nberr=nberr+nerr
! Correct signal normalization is important for this decoder.
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
! magnitude in UER
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
nap=0 ! number of AP bits
llr(colorder(174-87+1:174-87+nap)+1)=5*(2.0*msgbits(1:nap)-1.0)
apmask=0
apmask(colorder(174-87+1:174-87+nap)+1)=1
! max_iterations is max number of belief propagation iterations
call bpdecode174(llr, apmask, max_iterations, decoded, cw, nharderrors,niterations)
if( ndepth .ge. 0 .and. nharderrors .lt. 0 ) call osd174(llr, apmask, ndepth, decoded, cw, nharderrors, dmin)
! If the decoder finds a valid codeword, nharderrors will be .ge. 0.
if( nharderrors .ge. 0 ) then
call extractmessage174(decoded,msgreceived,ncrcflag)
if( ncrcflag .ne. 1 ) then
nbadcrc=nbadcrc+1
endif
nueflag=0
nerrmpc=0
do i=1,K ! find number of errors in message+crc part of codeword
if( msgbits(i) .ne. decoded(i) ) then
nueflag=1
nerrmpc=nerrmpc+1
endif
enddo
if(nerrmpc.ge.1) nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1
if( ncrcflag .eq. 1 ) then
if( nueflag .eq. 0 ) then
ngood=ngood+1
if(nerr.ge.1) nerrdec(nerr)=nerrdec(nerr)+1
else if( nueflag .eq. 1 ) then
nue=nue+1;
endif
endif
endif
enddo
baud=12000.0/NSPS
snr2500=db+10.0*log10((baud/2500.0))
pberr=real(nberr)/(real(ntrials*N))
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,174
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
open(unit=25,file='nmpcbad.dat',status='unknown')
do i=1,87
write(25,'(i4,2x,i10)') i,nmpcbad(i)
enddo
close(25)
end program ldpcsim174js8
lib/js8/subtractjs8.f90
+64
View File
@@ -0,0 +1,64 @@
subroutine subtractjs8(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
!include 'js8_params.f90'
parameter (NFRAME=NSPS*NN)
parameter (NFFT=NMAX, NFILT=1400)
real*4 dd(NMAX), window(-NFILT/2:NFILT/2)
complex cref,camp,cfilt,cw
integer itone(NN)
logical first
data first/.true./
common/heap8/cref(NFRAME),camp(NMAX),cfilt(NMAX),cw(NMAX)
save first
nstart=dt*12000+1
call genjs8refsig(itone,cref,f0)
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)-2*REAL(cfilt(i)*cref(i))
enddo
return
end subroutine subtractjs8
lib/js8/syncjs8.f90
+183
View File
@@ -0,0 +1,183 @@
subroutine syncjs8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
!include 'js8_params.f90'
complex cx(0:NH1)
real s(NH1,NHSYM)
real savg(NH1)
real sbase(NH1)
real x(NFFT1)
real sync2d(NH1,-JZ:JZ)
real red(NH1)
real candidate0(3,200)
real candidate(3,200)
real dd(NMAX)
integer jpeak(NH1)
integer indx(NH1)
integer ii(1)
integer syoff !symbol offset
equivalence (x,cx)
integer icos7a(0:6), icos7b(0:6), icos7c(0:6)
if(NCOSTAS.eq.1) then
icos7a = (/4,2,5,6,1,3,0/) !Beginning Costas 7x7 tone pattern
icos7b = (/4,2,5,6,1,3,0/) !Middle Costas 7x7 tone pattern
icos7c = (/4,2,5,6,1,3,0/) !End Costas 7x7 tone pattern
else
icos7a = (/0,6,2,3,5,4,1/) !Beginning Costas 7x7 tone pattern
icos7b = (/1,5,0,2,3,6,4/) !Middle Costas 7x7 tone pattern
icos7c = (/2,5,0,6,4,1,3/) !End Costas 7x7 tone pattern
endif
! Compute symbol spectra, stepping by NSTEP steps.
savg=0.
tstep=NSTEP/12000.0
df=12000.0/NFFT1
fac=1.0/300.0
do j=1,NHSYM
ia=(j-1)*NSTEP + 1
ib=ia+NSPS-1
x(1:NSPS)=fac*dd(ia:ib)
x(NSPS+1:)=0.
call four2a(x,NFFT1,1,-1,0) !r2c FFT
do i=1,NH1
s(i,j)=real(cx(i))**2 + aimag(cx(i))**2
enddo
savg=savg + s(1:NH1,j) !Average spectrum
enddo
call baselinejs8(savg,nfa,nfb,sbase)
ia=max(1,nint(nfa/df)) ! min freq
ib=nint(nfb/df) ! max freq
nssy=NSPS/NSTEP ! steps per symbol
nfos=NFFT1/NSPS ! frequency bin oversampling factor
jstrt=ASTART/tstep ! the symbol step that we are starting at (NHSYM)
candidate0=0.
k=0
do i=ia,ib
do j=-JZ,+JZ
ta=0.
tb=0.
tc=0.
t0a=0.
t0b=0.
t0c=0.
do n=0,6
k=j+jstrt+nssy*n
syoff=k
if(syoff.ge.1.and.syoff.le.NHSYM) then
ta=ta + s(i+nfos*icos7a(n),syoff)
t0a=t0a + sum(s(i:i+nfos*6:nfos,syoff))
endif
syoff=k+nssy*36
if(syoff.ge.1.and.syoff.le.NHSYM) then
tb=tb + s(i+nfos*icos7b(n),syoff)
t0b=t0b + sum(s(i:i+nfos*6:nfos,syoff))
endif
syoff=k+nssy*72
if(syoff.ge.1.and.syoff.le.NHSYM) then
tc=tc + s(i+nfos*icos7c(n),syoff)
t0c=t0c + sum(s(i:i+nfos*6:nfos,syoff))
endif
enddo
t=ta+tb+tc
t0=t0a+t0b+t0c
t0=(t0-t)/6.0
sync_abc=t/t0
t=ta+tb
t0=t0a+t0b
t0=(t0-t)/6.0
sync_ab=t/t0
t=ta+tc
t0=t0a+t0c
t0=(t0-t)/6.0
sync_ac=t/t0
t=tb+tc
t0=t0b+t0c
t0=(t0-t)/6.0
sync_bc=t/t0
!sync2d(i,j)=max(max(max(sync_abc, sync_ab), sync_ac), sync_bc)
sync2d(i,j)=max(sync_abc, sync_ab, sync_bc)
enddo
enddo
red=0.
do i=ia,ib
ii=maxloc(sync2d(i,-JZ:JZ)) - 1 - JZ
j0=ii(1)
jpeak(i)=j0
red(i)=sync2d(i,j0)
enddo
iz=ib-ia+1
call indexx(red(ia:ib),iz,indx)
ibase=indx(nint(0.40*iz)) - 1 + ia
if(ibase.lt.1) ibase=1
if(ibase.gt.nh1) ibase=nh1
base=red(ibase)
red=red/base
k=0
do i=1,min(200,iz)
if(k.ge.200) exit
n=ia + indx(iz+1-i) - 1
if(red(n).lt.syncmin.or.isnan(red(n))) exit
if(NWRITELOG.eq.1) then
open(99, file="./js8.log", status="old", position="append", action="write")
write(99,*) 'red candidate', red(n), n*df, (jpeak(n)-1)*tstep
close(99)
endif
k=k+1
candidate0(1,k)=n*df
candidate0(2,k)=(jpeak(n)-1)*tstep
candidate0(3,k)=red(n)
enddo
ncand=k
! Put nfqso at top of list, and save only the best of near-dupe freqs.
do i=1,ncand
if(abs(candidate0(1,i)-nfqso).lt.10.0) candidate0(1,i)=-candidate0(1,i)
if(i.ge.2) then
do j=1,i-1
fdiff=abs(candidate0(1,i))-abs(candidate0(1,j))
if(abs(fdiff).lt.AZ) then ! note: this dedupe difference is dependent on symbol spacing
if(candidate0(3,i).ge.candidate0(3,j)) candidate0(3,j)=0.
if(candidate0(3,i).lt.candidate0(3,j)) candidate0(3,i)=0.
endif
enddo
endif
enddo
fac=20.0/maxval(s)
s=fac*s
! Sort by sync
! call indexx(candidate0(3,1:ncand),ncand,indx)
! Sort by frequency
call indexx(candidate0(1,1:ncand),ncand,indx)
k=1
! do i=ncand,1,-1
do i=1,ncand
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(1,k)=abs(candidate0(1,j))
candidate(2,k)=candidate0(2,j)
candidate(3,k)=candidate0(3,j)
k=k+1
endif
enddo
ncand=k-1
return
end subroutine syncjs8
lib/js8/syncjs8d.f90
+89
View File
@@ -0,0 +1,89 @@
subroutine syncjs8d(cd0,i0,ctwk,itwk,sync)
! Compute sync power for a complex, downsampled FT8 signal.
!include 'js8_params.f90'
parameter(NP=NMAX/NDOWN,NSS=NSPS/NDOWN)
complex cd0(0:NP-1)
complex csynca(4*NSS),csyncb(4*NSS),csyncc(4*NSS)
complex csync2(4*NSS)
complex ctwk(4*NSS)
complex z1,z2,z3
logical first
data first/.true./
save first,twopi,csynca,csyncb,csyncc
p(z1)=(real(z1)**2 + aimag(z1)**2) !Statement function for power
integer icos7a(0:6), icos7b(0:6), icos7c(0:6)
if(NCOSTAS.eq.1) then
icos7a = (/4,2,5,6,1,3,0/) !Beginning Costas 7x7 tone pattern
icos7b = (/4,2,5,6,1,3,0/) !Middle Costas 7x7 tone pattern
icos7c = (/4,2,5,6,1,3,0/) !End Costas 7x7 tone pattern
else
icos7a = (/0,6,2,3,5,4,1/) !Beginning Costas 7x7 tone pattern
icos7b = (/1,5,0,2,3,6,4/) !Middle Costas 7x7 tone pattern
icos7c = (/2,5,0,6,4,1,3/) !End Costas 7x7 tone pattern
endif
! Set some constants and compute the csync array.
if( first ) then
twopi=8.0*atan(1.0)
k=1
phia=0.0
phib=0.0
phic=0.0
!fs2=12000.0/NDOWN !Sample rate after downsampling
!dt2=1/fs2 !Corresponding sample interval
!taus=NDOWNSPS*dt2 !Symbol duration
!baud=1.0/taus !Keying rate
do i=0,6
dphia=2*twopi*icos7a(i)/real(NSS)
dphib=2*twopi*icos7b(i)/real(NSS)
dphic=2*twopi*icos7c(i)/real(NSS)
do j=1,NSS/2
csynca(k)=cmplx(cos(phia),sin(phia)) !Waveform for Beginning 7x7 Costas array
csyncb(k)=cmplx(cos(phib),sin(phib)) !Waveform for Middle 7x7 Costas array
csyncc(k)=cmplx(cos(phic),sin(phic)) !Waveform for End 7x7 Costas array
phia=mod(phia+dphia,twopi)
phib=mod(phib+dphib,twopi)
phic=mod(phia+dphic,twopi)
k=k+1
enddo
enddo
first=.false.
endif
i1=i0 !four Costas arrays
i2=i0+36*NSS
i3=i0+72*NSS
z1=0.
z2=0.
z3=0.
csync2=csynca
if(itwk.eq.1) csync2=ctwk*csynca !Tweak the frequency
if(i1.ge.0 .and. i1+8*NSS-1.le.NP-1) z1=sum(cd0(i1:i1+8*NSS-1:2)*conjg(csync2))
csync2=csyncb
if(itwk.eq.1) csync2=ctwk*csyncb !Tweak the frequency
if(i2.ge.0 .and. i2+8*NSS-1.le.NP-1) z2=sum(cd0(i2:i2+8*NSS-1:2)*conjg(csync2))
csync2=csyncc
if(itwk.eq.1) csync2=ctwk*csyncc !Tweak the frequency
if(i3.ge.0 .and. i3+8*NSS-1.le.NP-1) z3=sum(cd0(i3:i3+8*NSS-1:2)*conjg(csync2))
sync = p(z1) + p(z2) + p(z3)
return
end subroutine syncjs8d