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

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

View File

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

View File

@ -1,11 +1,20 @@
program test28 program test28
use packjt77
parameter (NTOKENS=2063592,MAX22=4194304) 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 character*1 cerr
logical unpk28_success
nargs=iargc() 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) write(*,1000)
1000 format('Encoded text Recovered text n28 Err? Type'/60('-')) 1000 format('Encoded text Recovered text n28 Err? Type'/60('-'))
@ -14,30 +23,41 @@ program test28
if(nargs.eq.0) then if(nargs.eq.0) then
read(10,'(a13)',end=999) call_0 read(10,'(a13)',end=999) call_0
else else
call getarg(1,call_0) call_0=arg
endif endif
if(call_0.eq.' ') exit if(call_0.eq.' ') exit
if(call_0(1:3).eq.'CQ ' .and. call_0(4:4).ne.' ') call_0(3:3)='_' if(call_0(1:3).eq.'CQ ' .and. call_0(4:4).ne.' ') call_0(3:3)='_'
call_1=' ' call_1=' '
call pack28(call_0,n28) call_00=call_0
call unpack28(n28,call_1) call pack28(call_00,n28)
call unpack28(n28,call_1,unpk28_success)
cerr=' ' cerr=' '
if(call_0.ne.call_1) 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_0(1:3).eq.'CQ_') call_0(3:3)=' '
if(call_1(1:3).eq.'CQ_') call_1(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 if(n28.lt.NTOKENS) write(*,1010) call_0,call_1,n28,cerr
1010 format(a13,2x,a13,i10,2x,a1,2x,'Special token') 1010 format(a13,2x,a13,i10,2x,a1,2x,'Special token')
if(n28.ge.NTOKENS .and. n28.lt.NTOKENS+MAX22) write(*,1012) call_0, & if(n28.ge.NTOKENS .and. n28.lt.NTOKENS+MAX22) then
call_1,n28,cerr call_00=call_0
1012 format(a13,2x,a13,i10,2x,a1,2x,'22-bit hash') 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 if(n28.ge.NTOKENS+MAX22) write(*,1014) call_0,call_1,n28,cerr
1014 format(a13,2x,a13,i10,2x,a1,2x,'Standard callsign') 1014 format(a13,2x,a13,i10,2x,a1,2x,'Standard callsign')
if(nargs.gt.0) exit if(nargs.gt.0) exit
enddo 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 999 end program test28

View File

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

View File

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

View File

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

View File

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