mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2025-10-31 13:10:19 -04:00
Enhance packjt77 to include 50-bit WSPR-style messages. Build encode77[.exe].
This commit is contained in:
Joe Taylor
parent
33ce9e3355
commit
38f11fee62
@ -1290,6 +1290,10 @@ target_link_libraries (jt9code wsjt_fort wsjt_cxx)
|
||||
|
||||
add_executable (wsprcode lib/wsprcode/wsprcode.f90 lib/wsprcode/nhash.c
|
||||
wsjtx.rc)
|
||||
|
||||
add_executable (encode77 lib/77bit/encode77.f90 wsjtx.rc)
|
||||
target_link_libraries (encode77 wsjt_fort wsjt_cxx)
|
||||
|
||||
target_link_libraries (wsprcode wsjt_fort wsjt_cxx)
|
||||
|
||||
add_executable (wsprsim ${wsprsim_CSRCS})
|
||||
|
||||
@ -6,6 +6,8 @@ program encode77
|
||||
character msg*37,cerr*1
|
||||
character*77 c77
|
||||
character*80 infile
|
||||
character*13 w(19)
|
||||
integer nw(19)
|
||||
logical unpk77_success
|
||||
|
||||
nargs=iargc()
|
||||
@ -15,6 +17,7 @@ program encode77
|
||||
go to 999
|
||||
endif
|
||||
call getarg(1,msg0)
|
||||
call fmtmsg(msg0,iz)
|
||||
if(nargs.eq.2) then
|
||||
call getarg(2,infile)
|
||||
open(10,file=infile,status='old')
|
||||
@ -37,10 +40,18 @@ program encode77
|
||||
call unpack77(c77,1,msg,unpk77_success)
|
||||
cerr=' '
|
||||
if(msg.ne.msg0(1:37)) cerr='*'
|
||||
if(i3.eq.0) write(*,1004) i3,n3,cerr,msg0(1:37),msg
|
||||
1004 format(i2,'.',i1,2x,a1,3x,a37,1x,a37)
|
||||
if(i3.ge.1) write(*,1005) i3,cerr,msg0(1:37),msg
|
||||
1005 format(i2,'.',3x,a1,3x,a37,1x,a37)
|
||||
if(i3.eq.0 .and.n3.ne.6) write(*,1004) i3,n3,cerr,msg0(1:37),msg
|
||||
1004 format(i2,'.',i1,4x,a1,1x,a37,1x,a37)
|
||||
if(i3.eq.0 .and.n3.eq.6) then
|
||||
call split77(msg,nwords,nw,w)
|
||||
j2=0
|
||||
if(nwords.eq.2 .and. len(w(2)).le.2) j2=1
|
||||
if(nwords.eq.2 .and. len(w(2)).eq.6) j2=2
|
||||
write(*,1005) i3,n3,j2,cerr,msg0(1:37),msg
|
||||
1005 format(i2,'.',i1,'.',i1,2x,a1,1x,a37,1x,a37)
|
||||
endif
|
||||
if(i3.ge.1) write(*,1006) i3,cerr,msg0(1:37),msg
|
||||
1006 format(i2,'.',5x,a1,1x,a37,1x,a37)
|
||||
if(nargs.eq.1) exit
|
||||
enddo
|
||||
|
||||
|
||||
@ -93,3 +93,9 @@ KA1ABC <YW18FIFA> -11
|
||||
<KA1ABC> YW18FIFA RR73
|
||||
<YW18FIFA> KA1ABC 73
|
||||
123456789ABCDEF012
|
||||
K1ABC FN42 37
|
||||
PJ4/K1ABC 37
|
||||
K1ABC/VE3 37
|
||||
KA1ABC/VEX 37
|
||||
<PJ4/K1ABC> FK52UD
|
||||
<K1ABC/W4> FK52UD
|
||||
|
||||
@ -160,8 +160,11 @@ subroutine pack77(msg0,i3,n3,c77)
|
||||
go to 900
|
||||
endif
|
||||
|
||||
100 call pack77_06(nwords,w,i3,n3,c77)
|
||||
if(i3.ge.0) go to 900
|
||||
|
||||
! Check Type 1 (Standard 77-bit message) or Type 2, with optional "/P"
|
||||
100 call pack77_1(nwords,w,i3,n3,c77)
|
||||
call pack77_1(nwords,w,i3,n3,c77)
|
||||
if(i3.ge.0) go to 900
|
||||
|
||||
! Check Type 3 (ARRL RTTY contest exchange)
|
||||
@ -203,17 +206,19 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
|
||||
character*13 call_1,call_2,call_3
|
||||
character*13 mycall13_0,dxcall13_0
|
||||
character*11 c11
|
||||
character*3 crpt,cntx
|
||||
character*3 crpt,cntx,cpfx
|
||||
character*3 cmult(NUSCAN)
|
||||
character*6 cexch,grid6
|
||||
character*4 grid4,cserial
|
||||
character*3 csec(NSEC)
|
||||
character*2 cfield
|
||||
character*38 c
|
||||
character*36 a2
|
||||
integer hashmy10,hashmy12,hashmy22,hashdx10,hashdx12,hashdx22
|
||||
logical unpk28_success,unpk77_success
|
||||
logical dxcall13_set,mycall13_set
|
||||
|
||||
data a2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/,nzzz/46656/
|
||||
data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/
|
||||
data csec/ &
|
||||
"AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", &
|
||||
@ -308,23 +313,7 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
|
||||
if(ip.eq.1) call_1=trim(call_1)//'/P'
|
||||
write(cexch,1022) nrs,iserial
|
||||
1022 format(i2,i4.4)
|
||||
n=igrid6
|
||||
j1=n/(18*10*10*24*24)
|
||||
n=n-j1*18*10*10*24*24
|
||||
j2=n/(10*10*24*24)
|
||||
n=n-j2*10*10*24*24
|
||||
j3=n/(10*24*24)
|
||||
n=n-j3*10*24*24
|
||||
j4=n/(24*24)
|
||||
n=n-j4*24*24
|
||||
j5=n/24
|
||||
j6=n-j5*24
|
||||
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'))
|
||||
grid6(5:5)=char(j5+ichar('A'))
|
||||
grid6(6:6)=char(j6+ichar('A'))
|
||||
call to_grid6(igrid6,grid6)
|
||||
msg=trim(call_1)//' '//cexch//' '//grid6
|
||||
if(ir.eq.1) msg=trim(call_1)//' R '//cexch//' '//grid6
|
||||
|
||||
@ -367,6 +356,58 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
|
||||
enddo
|
||||
msg=adjustl(msg)
|
||||
|
||||
else if(i3.eq.0 .and. n3.eq.6) then
|
||||
read(c77(70:71),'(b2)') j2
|
||||
if(j2.eq.0) then
|
||||
read(c77,2010) n28,igrid4,idbm,iap
|
||||
2010 format(b28.28,b15.15,b6.6,b19.19)
|
||||
call unpack28(n28,call_1,unpk28_success)
|
||||
if(.not.unpk28_success) unpk77_success=.false.
|
||||
call to_grid4(igrid4,grid4)
|
||||
write(crpt,'(i3)') idbm
|
||||
msg=trim(call_1)//' '//grid4//' '//trim(adjustl(crpt))
|
||||
|
||||
else if(j2.eq.1) then
|
||||
read(c77,2020) n28,npfx,idbm,iap
|
||||
2020 format(b28.28,b16.16,b6.6,b19.19)
|
||||
call unpack28(n28,call_1,unpk28_success)
|
||||
if(.not.unpk28_success) unpk77_success=.false.
|
||||
write(crpt,'(i3)') idbm
|
||||
if(npfx.lt.nzzz) then
|
||||
! Prefix
|
||||
do i=3,1,-1
|
||||
j=mod(npfx,36)+1
|
||||
cpfx(i:i)=a2(j:j)
|
||||
npfx=npfx/36
|
||||
if(npfx.eq.0) exit
|
||||
enddo
|
||||
msg=trim(adjustl(cpfx))//'/'//trim(call_1)//' '//trim(adjustl(crpt))
|
||||
else
|
||||
! Suffix
|
||||
npfx=npfx-nzzz
|
||||
if(npfx.le.35) then
|
||||
cpfx(1:1)=a2(npfx+1:npfx+1)
|
||||
else if(npfx.gt.35 .and. npfx.le.1295) then
|
||||
cpfx(1:1)=a2(npfx/36+1:npfx/36+1)
|
||||
cpfx(2:2)=a2(mod(npfx,36)+1:mod(npfx,36)+1)
|
||||
else
|
||||
cpfx(1:1)=a2(npfx/360+1:npfx/360+1)
|
||||
cpfx(2:2)=a2(mod(npfx/10,36)+1:mod(npfx/10,36)+1)
|
||||
cpfx(3:3)=a2(mod(npfx,10)+1:mod(npfx,10)+1)
|
||||
endif
|
||||
msg=trim(call_1)//'/'//trim(adjustl(cpfx))//' '//trim(adjustl(crpt))
|
||||
endif
|
||||
|
||||
else if(j2.eq.2) then
|
||||
read(c77,2030) n28,igrid6,iap
|
||||
2030 format(b22.22,b25.25,b19.19)
|
||||
call unpack28(n28,call_1,unpk28_success)
|
||||
if(.not.unpk28_success) unpk77_success=.false.
|
||||
call to_grid6(igrid6,grid6)
|
||||
msg=trim(call_1)//' '//grid6
|
||||
|
||||
endif
|
||||
|
||||
else if(i3.eq.1 .or. i3.eq.2) then
|
||||
! Type 1 (standard message) or Type 2 ("/P" form for EU VHF contest)
|
||||
read(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3
|
||||
@ -389,17 +430,7 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
|
||||
if(i.ge.4) call add_call_to_recent_calls(call_2)
|
||||
endif
|
||||
if(igrid4.le.MAXGRID4) then
|
||||
n=igrid4
|
||||
j1=n/(18*10*10)
|
||||
n=n-j1*18*10*10
|
||||
j2=n/(10*10)
|
||||
n=n-j2*10*10
|
||||
j3=n/10
|
||||
j4=n-j3*10
|
||||
grid4(1:1)=char(j1+ichar('A'))
|
||||
grid4(2:2)=char(j2+ichar('A'))
|
||||
grid4(3:3)=char(j3+ichar('0'))
|
||||
grid4(4:4)=char(j4+ichar('0'))
|
||||
call to_grid4(igrid4,grid4)
|
||||
if(ir.eq.0) msg=trim(call_1)//' '//trim(call_2)//' '//grid4
|
||||
if(ir.eq.1) msg=trim(call_1)//' '//trim(call_2)//' R '//grid4
|
||||
if(msg(1:3).eq.'CQ ' .and. ir.eq.1) unpk77_success=.false.
|
||||
@ -947,6 +978,128 @@ subroutine pack77_03(nwords,w,i3,n3,c77)
|
||||
end subroutine pack77_03
|
||||
|
||||
|
||||
subroutine pack77_06(nwords,w,i3,n3,c77)
|
||||
|
||||
character*13 w(19)
|
||||
character*77 c77
|
||||
character*6 bcall,grid6
|
||||
character*4 grid4
|
||||
character*1 c
|
||||
character*36 a2
|
||||
data a2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/,nzzz/46656/
|
||||
|
||||
logical is_grid4,is_grid6,is_digit,ok
|
||||
is_grid4(grid4)=len(trim(grid4)).eq.4 .and. &
|
||||
grid4(1:1).ge.'A' .and. grid4(1:1).le.'R' .and. &
|
||||
grid4(2:2).ge.'A' .and. grid4(2:2).le.'R' .and. &
|
||||
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. &
|
||||
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'
|
||||
|
||||
is_digit(c)=c.ge.'0' .and. c.le.'9'
|
||||
|
||||
m1=len(trim(w(1)))
|
||||
m2=len(trim(w(2)))
|
||||
m3=len(trim(w(3)))
|
||||
if(nwords.eq.3 .and. m1.ge.3 .and. m1.le.6 .and. m2.eq.4 .and. m3.le.2) then
|
||||
! WSPR Type 1
|
||||
if(.not.is_grid4(w(2)(1:4))) go to 900
|
||||
if(.not.is_digit(w(3)(1:1))) go to 900
|
||||
if(m3.eq.2) then
|
||||
if(.not.is_digit(w(3)(2:2))) go to 900
|
||||
endif
|
||||
i3=0
|
||||
n3=6
|
||||
call pack28(w(1),n28)
|
||||
grid4=w(2)(1:4)
|
||||
j1=(ichar(grid4(1:1))-ichar('A'))*18*10*10
|
||||
j2=(ichar(grid4(2:2))-ichar('A'))*10*10
|
||||
j3=(ichar(grid4(3:3))-ichar('0'))*10
|
||||
j4=(ichar(grid4(4:4))-ichar('0'))
|
||||
igrid4=j1+j2+j3+j4
|
||||
read(w(3),*) idbm
|
||||
if(idbm.lt.0) idbm=0
|
||||
if(idbm.gt.63) idbm=63
|
||||
iap=0
|
||||
j2=0
|
||||
write(c77,1010) n28,igrid4,idbm,iap,0,j2,n3,i3
|
||||
1010 format(b28.28,b15.15,b6.6,b19.19,b1.1,b2.2,2b3.3)
|
||||
go to 900
|
||||
endif
|
||||
if(nwords.eq.2 .and. m1.ge.5 .and. m1.le.10 .and. m2.le.2) then
|
||||
! WSPR Type 2
|
||||
i1=index(w(1),'/')
|
||||
if(i1.lt.2 .or. i1.eq.m1) go to 900
|
||||
if(.not.is_digit(w(2)(1:1))) go to 900
|
||||
if(i1.eq.(m1-3) .and. .not.is_digit(w(1)(m1:m1))) go to 900
|
||||
if(m2.eq.2) then
|
||||
if(.not.is_digit(w(2)(2:2))) go to 900
|
||||
endif
|
||||
call chkcall(w(1),bcall,ok)
|
||||
if(.not.ok) go to 900
|
||||
if(i1.le.4) then
|
||||
! We have a prefix
|
||||
npfx=index(a2,w(1)(1:1))-1
|
||||
if(i1.ge.3) npfx=36*npfx + index(a2,w(1)(2:2))-1
|
||||
if(i1.eq.4) npfx=36*npfx + index(a2,w(1)(3:3))-1
|
||||
else
|
||||
! We have a suffix
|
||||
if((m1-i1).eq.1) npfx=index(a2,w(1)(i1+1:i1+1))-1
|
||||
if((m1-i1).eq.2) npfx=36*(index(a2,w(1)(i1+1:i1+1))-1) + &
|
||||
index(a2,w(1)(i1+2:i1+2))-1
|
||||
if((m1-i1).eq.3) then
|
||||
! Third character of a suffix must be a digit
|
||||
if(.not.is_digit(w(1)(i1+3:i1+3))) go to 900
|
||||
npfx=36*10*(index(a2,w(1)(i1+1:i1+1))-1) + &
|
||||
10*(index(a2,w(1)(i1+2:i1+2))-1) + index(a2,w(1)(i1+3:i1+3))-1
|
||||
endif
|
||||
! print*,'ccc2',npfx
|
||||
npfx=npfx + nzzz
|
||||
! print*,'ccc3',npfx
|
||||
endif
|
||||
i3=0
|
||||
n3=6
|
||||
j2=1
|
||||
call pack28(bcall//' ',n28)
|
||||
read(w(2),*) idbm
|
||||
if(idbm.lt.0) idbm=0
|
||||
if(idbm.gt.63) idbm=63
|
||||
write(c77,1020) n28,npfx,idbm,iap,j2,n3,i3
|
||||
1020 format(b28.28,b16.16,b6.6,b19.19,b2.2,2b3.3)
|
||||
go to 900
|
||||
endif
|
||||
|
||||
if(nwords.eq.2 .and. m1.ge.5 .and. m1.le.12 .and. m2.le.6) then
|
||||
! WSPR Type 3
|
||||
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
|
||||
i3=0
|
||||
n3=6
|
||||
j2=2
|
||||
call pack28(w(1),n28)
|
||||
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
|
||||
write(c77,1030) n28,igrid6,iap,0,j2,n3,i3
|
||||
1030 format(b22.22,b25.25,b19.19,b3.3,b2.2,2b3.3)
|
||||
endif
|
||||
|
||||
900 return
|
||||
end subroutine pack77_06
|
||||
|
||||
|
||||
subroutine pack77_1(nwords,w,i3,n3,c77)
|
||||
|
||||
! Check Type 1 (Standard 77-bit message) and Type 2 (ditto, with a "/P" call)
|
||||
@ -1362,4 +1515,44 @@ subroutine add_call_to_recent_calls(callsign)
|
||||
return
|
||||
end subroutine add_call_to_recent_calls
|
||||
|
||||
subroutine to_grid4(n,grid4)
|
||||
character*4 grid4
|
||||
|
||||
j1=n/(18*10*10)
|
||||
n=n-j1*18*10*10
|
||||
j2=n/(10*10)
|
||||
n=n-j2*10*10
|
||||
j3=n/10
|
||||
j4=n-j3*10
|
||||
grid4(1:1)=char(j1+ichar('A'))
|
||||
grid4(2:2)=char(j2+ichar('A'))
|
||||
grid4(3:3)=char(j3+ichar('0'))
|
||||
grid4(4:4)=char(j4+ichar('0'))
|
||||
|
||||
return
|
||||
end subroutine to_grid4
|
||||
|
||||
subroutine to_grid6(n,grid6)
|
||||
character*6 grid6
|
||||
|
||||
j1=n/(18*10*10*24*24)
|
||||
n=n-j1*18*10*10*24*24
|
||||
j2=n/(10*10*24*24)
|
||||
n=n-j2*10*10*24*24
|
||||
j3=n/(10*24*24)
|
||||
n=n-j3*10*24*24
|
||||
j4=n/(24*24)
|
||||
n=n-j4*24*24
|
||||
j5=n/24
|
||||
j6=n-j5*24
|
||||
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'))
|
||||
grid6(5:5)=char(j5+ichar('A'))
|
||||
grid6(6:6)=char(j6+ichar('A'))
|
||||
|
||||
return
|
||||
end subroutine to_grid6
|
||||
|
||||
end module packjt77
|
||||
|
||||
@ -59,6 +59,7 @@ subroutine wqencode(msg,ntype,data0)
|
||||
n2=128*ih + ntype + 64
|
||||
call pack50(n1,n2,data0)
|
||||
endif
|
||||
|
||||
900 continue
|
||||
|
||||
return
|
||||
end subroutine wqencode
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user