From cccb38dbefd2dd1317759442a59ca3e18dd974c0 Mon Sep 17 00:00:00 2001 From: Bill Somerville Date: Fri, 17 Jul 2020 19:09:21 +0100 Subject: [PATCH] Pass hints to fst240sim, genfst240, and packjt77::pack77 on WSPR msgs Due to an ambiguity with message encodings between 77-bit QSO modes and 50-bit beacon modes with message types 13.n3 4.0 and 0.6 a hint needs to be passed to ensure the right encoding is emitted. The hint only effects ambiguous messages, others will be encoded strictly according to the message content. --- lib/77bit/packjt77.f90 | 73 ++++++++++++++++++++++++++++++---------- lib/fst240/fst240sim.f90 | 24 +++++++++---- lib/fst240/genfst240.f90 | 7 +++- widgets/mainwindow.cpp | 1 + 4 files changed, 80 insertions(+), 25 deletions(-) diff --git a/lib/77bit/packjt77.f90 b/lib/77bit/packjt77.f90 index 5fc335393..a2499625c 100644 --- a/lib/77bit/packjt77.f90 +++ b/lib/77bit/packjt77.f90 @@ -124,12 +124,14 @@ subroutine pack77(msg0,i3,n3,c77) integer ntel(3) msg=msg0 - if(i3.eq.0 .and. n3.eq.5) go to 5 + i3_hint=i3 + n3_hint=n3 + i3=-1 + n3=-1 + if(i3_hint.eq.0 .and. n3_hint.eq.5) go to 5 ! Convert msg to upper case; collapse multiple blanks; parse into words. call split77(msg,nwords,nw,w) - i3=-1 - n3=-1 if(msg(1:3).eq.'CQ ' .or. msg(1:3).eq.'DE ' .or. msg(1:4).eq.'QRZ ') go to 100 ! Check 0.1 (DXpedition mode) @@ -160,7 +162,7 @@ subroutine pack77(msg0,i3,n3,c77) go to 900 endif -100 call pack77_06(nwords,w,i3,n3,c77) +100 call pack77_06(nwords,w,i3,n3,c77,i3_hint,n3_hint) if(i3.ge.0) go to 900 ! Check Type 1 (Standard 77-bit message) or Type 2, with optional "/P" @@ -414,7 +416,7 @@ subroutine unpack77(c77,nrx,msg,unpk77_success) n28=n22+2063592 call unpack28(n28,call_1,unpk28_success) if(.not.unpk28_success) unpk77_success=.false. - call to_grid6(igrid6,grid6) + call to_grid(igrid6,grid6) msg=trim(call_1)//' '//grid6 @@ -938,7 +940,7 @@ subroutine pack77_03(nwords,w,i3,n3,c77) end subroutine pack77_03 -subroutine pack77_06(nwords,w,i3,n3,c77) +subroutine pack77_06(nwords,w,i3,n3,c77,i3_hint,n3_hint) character*13 w(19) character*77 c77 @@ -955,13 +957,14 @@ subroutine pack77_06(nwords,w,i3,n3,c77) grid4(3:3).ge.'0' .and. grid4(3:3).le.'9' .and. & grid4(4:4).ge.'0' .and. grid4(4:4).le.'9' - is_grid6(grid6)=len(trim(grid6)).eq.6 .and. & + is_grid6(grid6)=(len(trim(grid6)).eq.6.or.len(trim(grid6)).eq.4).and. & grid6(1:1).ge.'A' .and. grid6(1:1).le.'R' .and. & grid6(2:2).ge.'A' .and. grid6(2:2).le.'R' .and. & grid6(3:3).ge.'0' .and. grid6(3:3).le.'9' .and. & grid6(4:4).ge.'0' .and. grid6(4:4).le.'9' .and. & - grid6(5:5).ge.'A' .and. grid6(5:5).le.'X' .and. & - grid6(6:6).ge.'A' .and. grid6(6:6).le.'X' + (len(trim(grid6)).eq.4.or. & + (grid6(5:5).ge.'A' .and. grid6(5:5).le.'X' .and. & + grid6(6:6).ge.'A' .and. grid6(6:6).le.'X')) is_digit(c)=c.ge.'0' .and. c.le.'9' @@ -1033,8 +1036,13 @@ subroutine pack77_06(nwords,w,i3,n3,c77) go to 900 endif - if(nwords.eq.2 .and. m1.ge.5 .and. m1.le.12 .and. m2.le.6) then + if(i3_hint.eq.0.and.n3_hint.eq.6.and.nwords.eq.2 .and. m1.ge.5 & + .and. m1.le.12 .and. m2.le.6) then ! WSPR Type 3 + + !n3_hint=6 and i3_hint=0 is a hint that the caller wanted a + !50-bit encoding rather than the possible alternative n3=4 77-bit + !encoding if(index(w(1),'<').lt.1 .or. index(w(1),'>').lt.1) go to 900 grid6=w(2)(1:6) if(.not.is_grid6(grid6)) go to 900 @@ -1042,13 +1050,17 @@ subroutine pack77_06(nwords,w,i3,n3,c77) n3=6 call pack28(w(1),n28) n22=n28-2063592 - k1=(ichar(grid6(1:1))-ichar('A'))*18*10*10*24*24 - k2=(ichar(grid6(2:2))-ichar('A'))*10*10*24*24 - k3=(ichar(grid6(3:3))-ichar('0'))*10*24*24 - k4=(ichar(grid6(4:4))-ichar('0'))*24*24 - k5=(ichar(grid6(5:5))-ichar('A'))*24 - k6=(ichar(grid6(6:6))-ichar('A')) - igrid6=k1+k2+k3+k4+k5+k6 + k1=(ichar(grid6(1:1))-ichar('A'))*18*10*10*25*25 + k2=(ichar(grid6(2:2))-ichar('A'))*10*10*25*25 + k3=(ichar(grid6(3:3))-ichar('0'))*10*25*25 + k4=(ichar(grid6(4:4))-ichar('0'))*25*25 + if (grid6(5:6).eq.' ') then + igrid6=k1+k2+k3+k4+24*25+24 + else + k5=(ichar(grid6(5:5))-ichar('A'))*25 + k6=(ichar(grid6(6:6))-ichar('A')) + igrid6=k1+k2+k3+k4+k5+k6 + endif write(c77,1030) n22,igrid6,2,0,n3,i3 1030 format(b22.22,b25.25,b3.3,b21.21,2b3.3) endif @@ -1523,4 +1535,31 @@ subroutine to_grid6(n,grid6) return end subroutine to_grid6 +subroutine to_grid(n,grid6) + ! 4-, or 6-character grid + character*6 grid6 + + j1=n/(18*10*10*25*25) + n=n-j1*18*10*10*25*25 + j2=n/(10*10*25*25) + n=n-j2*10*10*25*25 + j3=n/(10*25*25) + n=n-j3*10*25*25 + j4=n/(25*25) + n=n-j4*25*25 + j5=n/25 + j6=n-j5*25 + grid6='' + grid6(1:1)=char(j1+ichar('A')) + grid6(2:2)=char(j2+ichar('A')) + grid6(3:3)=char(j3+ichar('0')) + grid6(4:4)=char(j4+ichar('0')) + if (j5.ne.24.or.j6.ne.24) then + grid6(5:5)=char(j5+ichar('A')) + grid6(6:6)=char(j6+ichar('A')) + endif + + return +end subroutine to_grid + end module packjt77 diff --git a/lib/fst240/fst240sim.f90 b/lib/fst240/fst240sim.f90 index cdfc4e561..338c7c6ba 100644 --- a/lib/fst240/fst240sim.f90 +++ b/lib/fst240/fst240sim.f90 @@ -6,6 +6,7 @@ program fst240sim use packjt77 include 'fst240_params.f90' !Set various constants type(hdr) h !Header for .wav file + logical*1 wspr_hint character arg*12,fname*17 character msg37*37,msgsent37*37,c77*77 complex, allocatable :: c0(:) @@ -18,10 +19,11 @@ program fst240sim ! Get command-line argument(s) nargs=iargc() - if(nargs.ne.9) then - print*,'Need 9 arguments, got ',nargs - print*,'Usage: fst240sim "message" TRsec f0 DT h fdop del nfiles snr' - print*,'Examples: fst240sim "K1JT K9AN EN50" 60 1500 0.0 1 0.1 1.0 10 -15' + if(nargs.ne.10) then + print*,'Need 10 arguments, got ',nargs + print*,'Usage: fst240sim "message" TRsec f0 DT h fdop del nfiles snr W' + print*,'Examples: fst240sim "K1JT K9AN EN50" 60 1500 0.0 1 0.1 1.0 10 -15 F' + print*,'W (T or F) argument is hint to encoder to use WSPR message when there is abiguity' go to 999 endif call getarg(1,msg37) !Message to be transmitted @@ -41,6 +43,8 @@ program fst240sim read(arg,*) nfiles !Number of files call getarg(9,arg) read(arg,*) snrdb !SNR_2500 + call getarg(10,arg) + read(arg,*) wspr_hint !0:break ties as 77-bit 1:break ties as 50-bit nfiles=abs(nfiles) twopi=8.0*atan(1.0) @@ -72,12 +76,18 @@ program fst240sim sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb) if(snrdb.gt.90.0) sig=1.0 - i3=-1 - n3=-1 + if(wspr_hint) then + i3=0 + n3=6 + else + i3=-1 + n3=-1 + endif call pack77(msg37,i3,n3,c77) + if(i3.eq.0.and.n3.eq.6) iwspr=1 call genfst240(msg37,0,msgsent37,msgbits,itone,iwspr) write(*,*) - write(*,'(a9,a37,a7,i2)') 'Message: ',msgsent37,' iwspr:',iwspr + write(*,'(a9,a37,a3,L2,a7,i2)') 'Message: ',msgsent37,'W:',wspr_hint,' iwspr:',iwspr write(*,1000) f00,xdt,hmod,txt,snrdb 1000 format('f0:',f9.3,' DT:',f6.2,' hmod:',i6,' TxT:',f6.1,' SNR:',f6.1) write(*,*) diff --git a/lib/fst240/genfst240.f90 b/lib/fst240/genfst240.f90 index adb8d20ec..2d4a055ae 100644 --- a/lib/fst240/genfst240.f90 +++ b/lib/fst240/genfst240.f90 @@ -5,7 +5,8 @@ subroutine genfst240(msg0,ichk,msgsent,msgbits,i4tone,iwspr) ! - ichk if ichk=1, return only msgsent ! - msgsent message as it will be decoded ! - i4tone array of audio tone values, {0,1,2,3} -! - iwspr 0: (240,101)/crc24, 1: (240,74)/crc24 +! - iwspr in: 0: FST240 1: FST240W +! out 0: (240,101)/crc24, 1: (240,74)/crc24 ! ! Frame structure: ! s8 d30 s8 d30 s8 d30 s8 d30 s8 @@ -43,6 +44,10 @@ subroutine genfst240(msg0,ichk,msgsent,msgbits,i4tone,iwspr) i3=-1 n3=-1 + if(iwspr.eq.1) then + i3=0 + n3=6 + endif call pack77(message,i3,n3,c77) call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent msgbits=0 diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index 2faf2c0f3..2487e7a46 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -3875,6 +3875,7 @@ void MainWindow::guiUpdate() char fst240msgbits[101]; QString wmsg; if(m_mode=="FST240W") { + iwspr = 1; wmsg=WSPR_message(); ba=wmsg.toLatin1(); ba2msg(ba,message);