w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-11-22 04:11:16 -05:00
Code Issues Packages Projects Releases Wiki Activity

Bring test28.f90, ft4_testmsg.f90, ft8_testmsg.f90, ft8code.f90 up to date.

Browse Source
This commit is contained in:
Joe Taylor 2020-01-03 13:34:56 -05:00
parent a8d371641c
commit f069477dbb
6 changed files with 118 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lib/77bit/g8
View File

@ -1,2 +1,3 @@
gfortran -o test28 -fbounds-check -Wall -Wno-conversion test28.f90 pack28.f90 \
unpack28.f90 ihashcall.f90 hash22.f90 save_hash_call.f90
gfortran -c packjt77.f90
gfortran -o test28 -fbounds-check -Wall -Wno-conversion test28.f90 \
../chkcall.f90 packjt77.o

46
lib/77bit/test28.f90
View File

@ -1,11 +1,20 @@
program test28
use packjt77
parameter (NTOKENS=2063592,MAX22=4194304)
character*13 call_0,call_1,bare_call_1
character*13 arg,call_00,call_0,call_1
character*1 cerr
logical unpk28_success
nargs=iargc()
open(10,file='test28.txt',status='old')
n28=-1
if(nargs.eq.1) then
call getarg(1,arg)
read(arg,'(i13)',err=2) n28
endif
if(n28.ge.0) go to 100
2 open(10,file='test28.txt',status='old')
write(*,1000)
1000 format('Encoded text Recovered text n28 Err? Type'/60('-'))
@ -14,30 +23,41 @@ program test28
if(nargs.eq.0) then
read(10,'(a13)',end=999) call_0
else
call getarg(1,call_0)
call_0=arg
endif
if(call_0.eq.' ') exit
if(call_0(1:3).eq.'CQ ' .and. call_0(4:4).ne.' ') call_0(3:3)='_'
call_1=' '
call pack28(call_0,n28)
call unpack28(n28,call_1)
call_00=call_0
call pack28(call_00,n28)
call unpack28(n28,call_1,unpk28_success)
cerr=' '
if(call_0.ne.call_1) cerr='*'
if(call_1(1:1).eq.'<') then
i=index(call_1,'>')
bare_call_1=call_1(2:i-1)//' '
endif
if(call_0.eq.bare_call_1) cerr=' '
if(call_0(1:3).eq.'CQ_') call_0(3:3)=' '
if(call_1(1:3).eq.'CQ_') call_1(3:3)=' '
if(n28.lt.NTOKENS) write(*,1010) call_0,call_1,n28,cerr
1010 format(a13,2x,a13,i10,2x,a1,2x,'Special token')
if(n28.ge.NTOKENS .and. n28.lt.NTOKENS+MAX22) write(*,1012) call_0, &
call_1,n28,cerr
1012 format(a13,2x,a13,i10,2x,a1,2x,'22-bit hash')
if(n28.ge.NTOKENS .and. n28.lt.NTOKENS+MAX22) then
call_00=call_0
call save_hash_call(call_00,n10,n12,n22)
write(*,1012) call_0,call_1,n28,cerr,n22
1012 format(a13,2x,a13,i10,2x,a1,2x,'22-bit hash',i15)
endif
if(n28.ge.NTOKENS+MAX22) write(*,1014) call_0,call_1,n28,cerr
1014 format(a13,2x,a13,i10,2x,a1,2x,'Standard callsign')
if(nargs.gt.0) exit
enddo
go to 999
100 call unpack28(n28,call_1,unpk28_success)
cerr=' '
if(.not.unpk28_success) cerr='*'
if(call_1(1:3).eq.'CQ_') call_1(3:3)=' '
if(n28.lt.NTOKENS) write(*,2010) n28,call_1,cerr
2010 format(i10,2x,a13,2x,a1,2x,'Special token')
if(n28.ge.NTOKENS .and. n28.lt.NTOKENS+MAX22) write(*,2012) n28,call_1,cerr
2012 format(i10,2x,a13,2x,a1,2x,'22-bit hash')
if(n28.ge.NTOKENS+MAX22) write(*,2014) n28,call_1,cerr
2014 format(i10,2x,a13,2x,a1,2x,'Standard callsign')
999 end program test28

23
lib/77bit/test28.txt
View File

@ -12,23 +12,16 @@ CQ_AAA
CQ_ZZZ
CQ_AAAA
CQ_ZZZZ
EI30T
YW18FIFA
KH1/KH7Z
<EI30T>
<YW18FIFA>
<KH1/KH7Z>
ZS9YOTA
YB50ST
00A
99ZZZ
000A
009ZZZ
999ZZZ
HA70BAY
WB2000XYZ
WB2000XYZABCD
ZM90DX
<ZS9YOTA>
<YB50ST>
<HA70BAY>
<WB2000XYZ>
<ZM90DX>
<VP2E/KA1ABC>
HB9GOLD
<HB9GOLD>
A0
A0A
K1ABC

2
lib/ft4/ft4_testmsg.f90
View File

@ -5,7 +5,7 @@
"PA9XYZ 590003 IO91NP", & ! 0.2
"G4ABC/P R 570007 JO22DB", & ! 0.2
"K1ABC W9XYZ 6A WI", & ! 0.3
"W9XYZ K1ABC R 2B EMA", & ! 0.3
"W9XYZ K1ABC R 17B EMA", & ! 0.3
"123456789ABCDEF012", & ! 0.5
"CQ K1ABC FN42", & ! 1.
"K1ABC W9XYZ EN37", & ! 1.

96
lib/ft8/ft8_testmsg.f90
View File

@ -1,51 +1,51 @@
parameter (MAXTEST=75,NTEST=48)
character*37 testmsg(MAXTEST)
data testmsg(1:NTEST)/ &
"CQ K1ABC FN42", &
"K1ABC W9XYZ EN37", &
"W9XYZ K1ABC -11", &
"K1ABC W9XYZ R-09", &
"W9XYZ K1ABC RRR", &
"K1ABC W9XYZ 73", &
"K1ABC W9XYZ RR73", &
"CQ KH1/KH7Z", &
"K1ABC RR73; W9XYZ <KH1/KH7Z> -08", &
"CQ FD K1ABC FN42", &
"K1ABC W9XYZ 6A WI", &
"W9XYZ K1ABC R 2B EMA", &
"CQ TEST K1ABC/R FN42", &
"K1ABC/R W9XYZ EN37", &
"W9XYZ K1ABC/R R FN42", &
"K1ABC/R W9XYZ RR73", &
"CQ TEST K1ABC FN42", &
"K1ABC W9XYZ 579 WI", &
"W9XYZ K1ABC R 589 MA", &
"K1ABC KA0DEF 559 MO", &
"TU; KA0DEF K1ABC R 569 MA", &
"KA1ABC G3AAA 529 0013", &
"TU; G3AAA K1ABC R 559 MA", &
"CQ G4ABC/P IO91", &
"G4ABC/P PA9XYZ JO22", &
"PA9XYZ 590003 IO91NP", &
"G4ABC/P R 570007 JO22DB", &
"PA9XYZ G4ABC/P RR73", &
"CQ PJ4/K1ABC", &
"PJ4/K1ABC <W9XYZ>", &
"W9XYZ <PJ4/K1ABC> -11", &
"<PJ4/K1ABC> W9XYZ R-09", &
"<W9XYZ> PJ4/K1ABC RRR", &
"PJ4/K1ABC <W9XYZ> 73", &
"CQ W9XYZ EN37", &
"<W9XYZ> YW18FIFA", &
"<YW18FIFA> W9XYZ -11", &
"W9XYZ <YW18FIFA> R-09", &
"YW18FIFA <W9XYZ> RRR", &
"<W9XYZ> YW18FIFA 73", &
"TNX BOB 73 GL", &
"CQ YW18FIFA", &
"<YW18FIFA> KA1ABC", &
"KA1ABC <YW18FIFA> -11", &
"<YW18FIFA> KA1ABC R-17", &
"<KA1ABC> YW18FIFA RR73", &
"<YW18FIFA> KA1ABC 73", &
"123456789ABCDEF012"/
"TNX BOB 73 GL", & ! 0.0
"K1ABC RR73; W9XYZ <KH1/KH7Z> -08", & ! 0.1
"PA9XYZ 590003 IO91NP", & ! 0.2
"G4ABC/P R 570007 JO22DB", & ! 0.2
"K1ABC W9XYZ 6A WI", & ! 0.3
"W9XYZ K1ABC R 17B EMA", & ! 0.3
"123456789ABCDEF012", & ! 0.5
"CQ K1ABC FN42", & ! 1.
"K1ABC W9XYZ EN37", & ! 1.
"W9XYZ K1ABC -11", & ! 1.
"K1ABC W9XYZ R-09", & ! 1.
"W9XYZ K1ABC RRR", & ! 1.
"K1ABC W9XYZ 73", & ! 1.
"K1ABC W9XYZ RR73", & ! 1.
"CQ FD K1ABC FN42", & ! 1.
"CQ TEST K1ABC/R FN42", & ! 1.
"K1ABC/R W9XYZ EN37", & ! 1.
"W9XYZ K1ABC/R R FN42", & ! 1.
"K1ABC/R W9XYZ RR73", & ! 1.
"CQ TEST K1ABC FN42", & ! 1.
"W9XYZ <PJ4/K1ABC> -11", & ! 1.
"<PJ4/K1ABC> W9XYZ R-09", & ! 1.
"CQ W9XYZ EN37", & ! 1.
"<YW18FIFA> W9XYZ -11", & ! 1.
"W9XYZ <YW18FIFA> R-09", & ! 1.
"<YW18FIFA> KA1ABC", & ! 1.
"KA1ABC <YW18FIFA> -11", & ! 1.
"<YW18FIFA> KA1ABC R-17", & ! 1.
"<YW18FIFA> KA1ABC 73", & ! 1.
"CQ G4ABC/P IO91", & ! 2.
"G4ABC/P PA9XYZ JO22", & ! 2.
"PA9XYZ G4ABC/P RR73", & ! 2.
"K1ABC W9XYZ 579 WI", & ! 3.
"W9XYZ K1ABC R 589 MA", & ! 3.
"K1ABC KA0DEF 559 MO", & ! 3.
"TU; KA0DEF K1ABC R 569 MA", & ! 3.
"KA1ABC G3AAA 529 0013", & ! 3.
"TU; G3AAA K1ABC R 559 MA", & ! 3.
"CQ KH1/KH7Z", & ! 4.
"CQ PJ4/K1ABC", & ! 4.
"PJ4/K1ABC <W9XYZ>", & ! 4.
"<W9XYZ> PJ4/K1ABC RRR", & ! 4.
"PJ4/K1ABC <W9XYZ> 73", & ! 4.
"<W9XYZ> YW18FIFA", & ! 4.
"YW18FIFA <W9XYZ> RRR", & ! 4.
"<W9XYZ> YW18FIFA 73", & ! 4.
"CQ YW18FIFA", & ! 4.
"<KA1ABC> YW18FIFA RR73"/

32
lib/ft8/ft8code.f90
View File

@ -13,6 +13,7 @@ program ft8code
character bad*1,msgtype*18
integer itone(NN)
integer*1 msgbits(77),codeword(174)
logical short
! Get command-line argument(s)
nargs=iargc()
@ -23,19 +24,22 @@ program ft8code
print*,'bit and symbol ordering, and other details of the FT8 protocol.'
print*
print*,'Usage: ft8code [-c grid] "message" # Results for specified message'
print*,' ft8code -t # Examples of all message types'
print*,' ft8code -T # Examples of all message types'
print*,' ft8code -t # Short format examples'
go to 999
endif
call getarg(1,msg) !Message to be transmitted
if(len(trim(msg)).eq.2 .and. msg(1:2).eq.'-t') then
short=.false.
if(len(trim(msg)).eq.2 .and. (msg(1:2).eq.'-T' .or. msg(1:2).eq.'-t')) then
nmsg=NTEST
short=msg(1:2).eq.'-t'
else
call fmtmsg(msg,iz) !To upper case; collapse multiple blanks
nmsg=1
endif
write(*,1010)
if(.not.short) write(*,1010)
1010 format(4x,'Message',31x,'Decoded',29x,'Err i3.n3'/100('-'))
do imsg=1,nmsg
@ -59,18 +63,28 @@ program ft8code
if(i3.eq.1) msgtype="Standard msg"
if(i3.eq.2) msgtype="EU VHF Contest"
if(i3.eq.3) msgtype="ARRL RTTY Roundup"
if(i3.eq.4) msgtype="Nonstandard calls"
if(i3.ge.5) msgtype="Undefined msg type"
if(i3.eq.4) msgtype="Nonstandard call"
if(i3.ge.5) msgtype="Undefined type"
if(i3.ge.1) n3=-1
bad=" "
comment=' '
if(msg.ne.msgsent) bad="*"
if(short) then
if(n3.ge.0) then
write(*,1020) imsg,msg,msgsent,bad,i3,n3,msgtype,comment
1020 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',i1,1x,a18,1x,a9)
write(*,1020) i3,n3,msg,bad,msgtype
1020 format(i1,'.',i1,2x,a37,1x,a1,1x,a18)
else
write(*,1022) imsg,msg,msgsent,bad,i3,msgtype,comment
1022 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',1x,1x,a18,1x,a9)
write(*,1022) i3,msg,bad,msgtype
1022 format(i1,'.',3x,a37,1x,a1,1x,a18)
endif
else
if(n3.ge.0) then
write(*,1024) imsg,msg,msgsent,bad,i3,n3,msgtype,comment
1024 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',i1,1x,a18,1x,a9)
else
write(*,1026) imsg,msg,msgsent,bad,i3,msgtype,comment
1026 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',1x,1x,a18,1x,a9)
endif
endif
enddo