diff --git a/ft8b.f90 b/ft8b.f90 index 07ed591..2957dd3 100644 --- a/ft8b.f90 +++ b/ft8b.f90 @@ -12,7 +12,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & character*77 c77 real a(5) real s8(0:7,NN) - real s2(0:511),s2l(0:511) + real s2(0:511) real bmeta(174),bmetb(174),bmetc(174) real llra(174),llrb(174),llrc(174),llrd(174) !Soft symbols complex dd0(NMAX) @@ -181,7 +181,6 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & print*,"Error - nsym must be 1, 2, or 3." endif enddo - s2l(0:nt-1)=log(s2(0:nt-1)+1e-32) i32=1+(k-1)*3+(ihalf-1)*87 if(nsym.eq.1) ibmax=2 if(nsym.eq.2) ibmax=5 @@ -383,7 +382,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & if(i3.gt.4 .or. (i3.eq.0.and.n3.gt.5)) then cycle endif - call unpack77(c77,msg37,msgcall,msggrid,unpk77_success) + call unpack77(c77,1,msg37,msgcall,msggrid,unpk77_success) if(.not.unpk77_success) then cycle endif diff --git a/genft8.f90 b/genft8.f90 index 2bfb9cc..c9316d6 100644 --- a/genft8.f90 +++ b/genft8.f90 @@ -17,7 +17,7 @@ subroutine genft8(msg,i3,n3,msgsent,msgbits,itone) i3=-1 n3=-1 call pack77(msg,i3,n3,c77) - call unpack77(c77,msgsent,msgcall,msggrid,unpk77_success) + call unpack77(c77,0,msgsent,msgcall,msggrid,unpk77_success) read(c77,'(77i1)',err=1) msgbits if(unpk77_success) go to 2 1 msgbits=0 diff --git a/packjt77.f90 b/packjt77.f90 index 2a8a811..3193380 100644 --- a/packjt77.f90 +++ b/packjt77.f90 @@ -2,10 +2,15 @@ module packjt77 ! These variables are accessible from outside via "use packjt77": parameter (MAXHASH=1000,MAXRECENT=10) - character*13 callsign(MAXHASH) - integer ihash10(MAXHASH),ihash12(MAXHASH),ihash22(MAXHASH) - integer n28a,n28b,nzhash - character*13 recent_calls(MAXRECENT) + character (len=13), dimension(1:1024) :: calls10='' + character (len=13), dimension(1:4096) :: calls12='' + character (len=13), dimension(1:MAXHASH) :: calls22='' + character (len=13), dimension(1:MAXRECENT) :: recent_calls='' + character (len=13) :: mycall13='' + character (len=13) :: dxcall13='' + integer, dimension(1:MAXHASH) :: ihash22=-1 + integer :: nzhash=0 + integer n28a,n28b contains @@ -14,15 +19,13 @@ subroutine hash10(n10,c13) character*13 c13 c13='<...>' - do i=1,nzhash - if(ihash10(i).eq.n10) then - c13=callsign(i) - c13='<'//trim(c13)//'>'//' ' - go to 900 - endif - enddo + if(n10.lt.1 .or. n10.gt.1024) return + if(len(trim(calls10(n10))).gt.0) then + c13=calls10(n10) + c13='<'//trim(c13)//'>' + endif + return -900 return end subroutine hash10 subroutine hash12(n12,c13) @@ -30,15 +33,13 @@ subroutine hash12(n12,c13) character*13 c13 c13='<...>' - do i=1,nzhash - if(ihash12(i).eq.n12) then - c13=callsign(i) - c13='<'//trim(c13)//'>'//' ' - go to 900 - endif - enddo + if(n12.lt.1 .or. n12.gt.4096) return + if(len(trim(calls12(n12))).gt.0) then + c13=calls12(n12) + c13='<'//trim(c13)//'>' + endif + return -900 return end subroutine hash12 @@ -49,8 +50,8 @@ subroutine hash22(n22,c13) c13='<...>' do i=1,nzhash if(ihash22(i).eq.n22) then - c13=callsign(i) - c13='<'//trim(c13)//'>'//' ' + c13=calls22(i) + c13='<'//trim(c13)//'>' go to 900 endif enddo @@ -79,18 +80,6 @@ end function ihashcall subroutine save_hash_call(c13,n10,n12,n22) character*13 c13,cw - logical first - data first/.true./ - save first - - if(first) then - ihash10=-1 - ihash12=-1 - ihash22=-1 - callsign=' ' - nzhash=0 - first=.false. - endif cw=c13 if(cw(1:1).eq.' ' .or. cw(1:5).eq.'<...>') return @@ -98,27 +87,30 @@ subroutine save_hash_call(c13,n10,n12,n22) i=index(cw,'>') if(i.gt.0) cw(i:)=' ' + if(len(trim(cw)) .lt. 3) return + n10=ihashcall(cw,10) + if(n10.ge.1 .and. n10 .le. 1024 .and. cw.ne.mycall13) calls10(n10)=cw + n12=ihashcall(cw,12) + if(n12.ge.1 .and. n12 .le. 4096 .and. cw.ne.mycall13) calls12(n12)=cw + n22=ihashcall(cw,22) - do i=1,nzhash - if(ihash22(i).eq.n22) go to 900 !This one is already in the table - enddo + if(any(ihash22.eq.n22)) then ! If entry exists, make sure callsign is the most recently received one + where(ihash22.eq.n22) calls22=cw + go to 900 + endif ! New entry: move table down, making room for new one at the top - ihash10(MAXHASH:2:-1)=ihash10(MAXHASH-1:1:-1) - ihash12(MAXHASH:2:-1)=ihash12(MAXHASH-1:1:-1) ihash22(MAXHASH:2:-1)=ihash22(MAXHASH-1:1:-1) ! Add the new entry - callsign(MAXHASH:2:-1)=callsign(MAXHASH-1:1:-1) - ihash10(1)=n10 - ihash12(1)=n12 + calls22(MAXHASH:2:-1)=calls22(MAXHASH-1:1:-1) ihash22(1)=n22 - callsign(1)=cw + calls22(1)=cw if(nzhash.lt.MAXHASH) nzhash=nzhash+1 - -900 return +900 continue + return end subroutine save_hash_call subroutine pack77(msg0,i3,n3,c77) @@ -154,7 +146,7 @@ subroutine pack77(msg0,i3,n3,c77) ! Check 0.5 (telemetry) 5 i0=index(msg,' ') - c18=msg(1:i0-1)//' ' + c18=msg(1:i0-1) c18=adjustr(c18) ntel=-99 read(c18,1005,err=6) ntel @@ -190,8 +182,13 @@ subroutine pack77(msg0,i3,n3,c77) 900 return end subroutine pack77 -subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success) - +subroutine unpack77(c77,nrx,msg,msgcall,msggrid,unpk77_success) +! +! nrx=1 when unpacking a received message +! nrx=0 when unpacking a to-be-transmitted message +! the value of nrx is used to decide when mycall13 or dxcall13 should +! be used in place of a callsign from the hashtable +! parameter (NSEC=84) !Number of ARRL Sections parameter (NUSCAN=65) !Number of US states and Canadian provinces parameter (MAXGRID4=32400) @@ -200,6 +197,7 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success) character*77 c77 character*37 msg character*13 call_1,call_2,call_3,msgcall + character*13 mycall13_0,dxcall13_0 character*11 c11 character*3 crpt,cntx character*3 cmult(NUSCAN) @@ -207,7 +205,9 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success) character*4 grid4,cserial,msggrid character*3 csec(NSEC) character*38 c + integer hashmy10,hashmy12,hashmy22,hashdx10,hashdx12,hashdx22 logical unpk28_success,unpk77_success + logical dxcall13_set,mycall13_set data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/ data csec/ & @@ -228,7 +228,32 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success) "SD ","TN ","TX ","UT ","VT ","VA ","WA ","WV ","WI ","WY ", & "NB ","NS ","QC ","ON ","MB ","SK ","AB ","BC ","NWT","NF ", & "LB ","NU ","YT ","PEI","DC "/ + data dxcall13_set/.false./ + data mycall13_set/.false./ + data mycall13_0/''/ + data dxcall13_0/''/ + save hashmy10,hashmy12,hashmy22,hashdx10,hashdx12,hashdx22 + + if(mycall13.ne.mycall13_0) then + if(len(trim(mycall13)).gt.2) then + mycall13_set=.true. + mycall13_0=mycall13 + call save_hash_call(mycall13,hashmy10,hashmy12,hashmy22) + else + mycall13_set=.false. + endif + endif + + if(dxcall13.ne.dxcall13_0) then + if(len(trim(dxcall13)).gt.2) then + dxcall13_set=.true. + dxcall13_0=dxcall13 + hashdx10=ihashcall(dxcall13,10) + hashdx12=ihashcall(dxcall13,12) + hashdx22=ihashcall(dxcall13,22) + endif + endif unpk77_success=.true. ! Check for bad data @@ -263,13 +288,13 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success) call unpack28(n28b,call_2,unpk28_success) if(.not.unpk28_success .or. n28b.le.2) unpk77_success=.false. call hash10(n10,call_3) - if(call_3(1:1).eq.'<') then - msg=trim(call_1)//' RR73; '//trim(call_2)//' '//trim(call_3)// & - ' '//crpt - else - msg=trim(call_1)//' RR73; '//trim(call_2)//' <'//trim(call_3)// & - '> '//crpt - endif + if(nrx.eq.1 .and. & + dxcall13_set .and. & + hashdx10.eq.n10) call_3='<'//trim(dxcall13)//'>' + if(nrx.eq.0 .and. & + mycall13_set .and. & + n10.eq.hashmy10) call_3='<'//trim(mycall13)//'>' + msg=trim(call_1)//' RR73; '//trim(call_2)//' '//trim(call_3)//' '//crpt else if(i3.eq.0 .and. n3.eq.2) then ! 0.2 PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 70 EU VHF contest read(c77,1020) n28a,ip,ir,irpt,iserial,igrid6 @@ -277,7 +302,7 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success) call unpack28(n28a,call_1,unpk28_success) if(.not.unpk28_success .or. n28a.le.2) unpk77_success=.false. nrs=52+irpt - if(ip.eq.1) call_1=trim(call_1)//'/P'//' ' + if(ip.eq.1) call_1=trim(call_1)//'/P' write(cexch,1022) nrs,iserial 1022 format(i2,i4.4) n=igrid6 @@ -442,14 +467,25 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success) n58=n58/38 enddo call hash12(n12,call_3) - if(iflip.eq.0) then + if(iflip.eq.0) then ! 12 bit hash for TO call call_1=call_3 - call_2=adjustl(c11)//' ' + call_2=adjustl(c11)//' ' call add_call_to_recent_calls(call_2) - else - call_1=adjustl(c11)//' ' + if(nrx.eq.1 .and. & + dxcall13_set .and. mycall13_set .and. & + call_2.eq.dxcall13 .and. & + n12.eq.hashmy12 ) call_1='<'//trim(mycall13)//'>' + if(nrx.eq.1 .and. & + mycall13_set .and. & + index(call_1,'<...>').gt.0 .and. & + n12.eq.hashmy12 ) call_1='<'//trim(mycall13)//'>' + else ! 12 bit hash for DE call + call_1=adjustl(c11) call_2=call_3 call add_call_to_recent_calls(call_1) + if(nrx.eq.0 .and. & + mycall13_set .and. & + n12.eq.hashmy12) call_2='<'//trim(mycall13)//'>' endif if(icq.eq.0) then if(nrpt.eq.0) msg=trim(call_1)//' '//trim(call_2) @@ -528,7 +564,7 @@ subroutine pack28(c13,n28) go to 900 endif if(nlet.ge.1 .and. nlet.le.4 .and. nnum.eq.0) then - c4=c13(4:n)//' ' + c4=c13(4:n) c4=adjustr(c4) m=0 do i=1,4 @@ -546,6 +582,9 @@ subroutine pack28(c13,n28) ! Check for <...> callsign if(c13(1:1).eq.'<')then call save_hash_call(c13,n10,n12,n22) !Save callsign in hash table + i2=index(c13,'>') + c13=c13(2:i2-1) + n22=ihashcall(c13,22) n28=NTOKENS + n22 go to 900 endif @@ -571,6 +610,7 @@ subroutine pack28(c13,n28) npdig.ge.iarea-1 .or. nslet.gt.3) then ! Treat this as a nonstandard callsign: compute its 22-bit hash call save_hash_call(c13,n10,n12,n22) !Save callsign in hash table + n22=ihashcall(c13,n22) n28=NTOKENS + n22 go to 900 endif @@ -658,7 +698,7 @@ subroutine unpack28(n28_0,c13,success) i5=n/27 i6=n-27*i5 c13=c1(i1+1:i1+1)//c2(i2+1:i2+1)//c3(i3+1:i3+1)//c4(i4+1:i4+1)// & - c4(i5+1:i5+1)//c4(i6+1:i6+1)//' ' + c4(i5+1:i5+1)//c4(i6+1:i6+1) c13=adjustl(c13) 900 i0=index(c13,' ') @@ -723,7 +763,7 @@ subroutine pack77_01(nwords,w,i3,n3,c77) ! Pack a Type 0.1 message: DXpedition mode ! Example message: "K1ABC RR73; W9XYZ -11" 28 28 10 5 - character*13 w(19) + character*13 w(19),c13 character*77 c77 character*6 bcall_1,bcall_2 logical ok1,ok2 @@ -749,6 +789,9 @@ subroutine pack77_01(nwords,w,i3,n3,c77) call pack28(w(1),n28a) call pack28(w(3),n28b) call save_hash_call(w(4),n10,n12,n22) + i2=index(w(4),'>') + c13=w(4)(2:i2-1) + n10=ihashcall(c13,10) write(c77,1010) n28a,n28b,n10,n5,n3,i3 1010 format(2b28.28,b10.10,b5.5,2b3.3) @@ -782,13 +825,14 @@ subroutine pack77_02(nwords,w,i3,n3,c77) ! Type 0.2: PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 70 EU VHF contest i3=0 n3=2 - ip=0 - c13=w(1) - i=index(w(1),'/P') + i=index(w(1)//' ','/P ') if(i.ge.4) then ip=1 - c13=w(1)(1:i-1)//' ' - endif + c13=w(1)(1:i-1) + else + ip=0 + c13=w(1) + end if call pack28(c13,n28a) ir=0 if(w(2)(1:2).eq.'R ') ir=1 @@ -929,22 +973,24 @@ subroutine pack77_1(nwords,w,i3,n3,c77) ! 1 WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 Standard msg ! 2 PA3XYZ/P GM4ABC/P R JO22 28 1 28 1 1 15 74 EU VHF contest -10 if(nwords.eq.2 .or. nwords.eq.3 .or. (nwords.eq.4 .and. & - w(3)(1:2).eq.'R ')) then +10 i1psuffix=index(w(1)//' ' ,'/P ') + i2psuffix=index(w(2)//' ','/P ') + if(nwords.eq.2 .or. nwords.eq.3 .or. (nwords.eq.4 .and. & + w(3)(1:2).eq.'R ')) then n3=0 i3=1 !Type 1: Standard message, possibly with "/R" - if(index(w(1),'/P').ge.4 .or. index(w(2),'/P').ge.4) i3=2 !Type 2, with "/P" + if (i1psuffix.ge.4.or.i2psuffix.ge.4) i3=2 !Type 2, with "/P" endif - c13=bcall_1//' ' + c13=bcall_1 if(c13(1:3).eq.'CQ_' .or. w(1)(1:1).eq.'<') c13=w(1) call pack28(c13,n28a) - c13=bcall_2//' ' + c13=bcall_2 if(w(2)(1:1).eq.'<') c13=w(2) call pack28(c13,n28b) ipa=0 ipb=0 - if(index(w(1),'/P').ge.4 .or. index(w(1),'/R').ge.4) ipa=1 - if(index(w(2),'/P').ge.4 .or. index(w(2),'/R').ge.4) ipb=1 + if(i1psuffix.ge.4.or.index(w(1)//' ','/R ').ge.4) ipa=1 + if(i2psuffix.ge.4.or.index(w(2)//' ','/R ').ge.4) ipb=1 grid4=w(nwords)(1:4) if(is_grid4(grid4)) then @@ -1205,6 +1251,7 @@ subroutine add_call_to_recent_calls(callsign) character*13 callsign logical ladd + ! only add if the callsign is not already on the list ladd=.true. do i=1,MAXRECENT-1 ! if callsign is at the end of the list add it again