mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-21 19:55:20 -05:00
Test program to exercise features of the "WSPR QSO mode" that was tested briefly in 2008.
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@8446 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor
parent
2fd2e0c7fe
commit
c470611cc9
8
lib/qso50/g0
Normal file
8
lib/qso50/g0
Normal file
@ -0,0 +1,8 @@
|
||||
gfortran -o twq -Wall -Wno-conversion -fbounds-check twq.f90 \
|
||||
../packjt.f90 wqenc.f90 wqdec.f90 packprop.f90 \
|
||||
packname.f90 packtext2.f90 unpackprop.f90 unpackname.f90 \
|
||||
unpacktext2.f90 unpackpfx.f90 pack50.f90 unpack50.f90 \
|
||||
../hash.f90 ../deg2grid.f90 ../grid2deg.f90 \
|
||||
../fix_contest_msg.f90 ../to_contest_msg.f90 \
|
||||
../fmtmsg.f90 ../azdist.f90 ../geodist.f90 ../wsprd/nhash.c
|
||||
|
||||
26
lib/qso50/pack50.f90
Normal file
26
lib/qso50/pack50.f90
Normal file
@ -0,0 +1,26 @@
|
||||
subroutine pack50(n1,n2,dat)
|
||||
|
||||
integer*1 dat(11),i1
|
||||
|
||||
i1=iand(ishft(n1,-20),255) !8 bits
|
||||
dat(1)=i1
|
||||
i1=iand(ishft(n1,-12),255) !8 bits
|
||||
dat(2)=i1
|
||||
i1=iand(ishft(n1, -4),255) !8 bits
|
||||
dat(3)=i1
|
||||
i1=16*iand(n1,15)+iand(ishft(n2,-18),15) !4+4 bits
|
||||
dat(4)=i1
|
||||
i1=iand(ishft(n2,-10),255) !8 bits
|
||||
dat(5)=i1
|
||||
i1=iand(ishft(n2, -2),255) !8 bits
|
||||
dat(6)=i1
|
||||
i1=64*iand(n2,3) !2 bits
|
||||
dat(7)=i1
|
||||
dat(8)=0
|
||||
dat(9)=0
|
||||
dat(10)=0
|
||||
dat(11)=0
|
||||
|
||||
return
|
||||
end subroutine pack50
|
||||
|
||||
23
lib/qso50/packname.f90
Normal file
23
lib/qso50/packname.f90
Normal file
@ -0,0 +1,23 @@
|
||||
subroutine packname(name,len,n1,n2)
|
||||
|
||||
character*9 name
|
||||
real*8 dn
|
||||
|
||||
dn=0
|
||||
do i=1,len
|
||||
n=ichar(name(i:i))
|
||||
if(n.ge.97 .and. n.le.122) n=n-32
|
||||
dn=27*dn + n-64
|
||||
enddo
|
||||
if(len.lt.9) then
|
||||
do i=len+1,9
|
||||
dn=27*dn
|
||||
enddo
|
||||
endif
|
||||
|
||||
n2=mod(dn,32768.d0)
|
||||
dn=dn/32768.d0
|
||||
n1=dn
|
||||
|
||||
return
|
||||
end subroutine packname
|
||||
36
lib/qso50/packprop.f90
Normal file
36
lib/qso50/packprop.f90
Normal file
@ -0,0 +1,36 @@
|
||||
subroutine packprop(k,muf,ccur,cxp,n1)
|
||||
|
||||
! Pack propagation indicators into a 21-bit number.
|
||||
|
||||
! k k-index, 0-9; 10="N/A"
|
||||
! muf muf, 2-60 MHz; 0=N/A, 1="none", 61=">60 MHz"
|
||||
! ccur up to two current events, each indicated by single
|
||||
! or double letter.
|
||||
! cxp zero or one expected event, indicated by single or
|
||||
! double letter
|
||||
|
||||
character ccur*4,cxp*2
|
||||
|
||||
j=ichar(ccur(1:1))-64
|
||||
if(j.lt.0) j=0
|
||||
n1=j
|
||||
do i=2,4
|
||||
if(ccur(i:i).eq.' ') go to 10
|
||||
if(ccur(i:i).eq.ccur(i-1:i-1)) then
|
||||
n1=n1+26
|
||||
else
|
||||
j=ichar(ccur(i:i))-64
|
||||
if(j.lt.0) j=0
|
||||
n1=53*n1 + j
|
||||
endif
|
||||
enddo
|
||||
|
||||
10 j=ichar(cxp(1:1))-64
|
||||
if(j.lt.0) j=0
|
||||
if(cxp(2:2).eq.cxp(1:1)) j=j+26
|
||||
n1=53*n1 + j
|
||||
n1=11*n1 + k
|
||||
n1=62*n1 + muf
|
||||
|
||||
return
|
||||
end subroutine packprop
|
||||
22
lib/qso50/packtext2.f90
Normal file
22
lib/qso50/packtext2.f90
Normal file
@ -0,0 +1,22 @@
|
||||
subroutine packtext2(msg,n1,ng)
|
||||
|
||||
character*8 msg
|
||||
real*8 dn
|
||||
character*41 c
|
||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +./?'/
|
||||
|
||||
dn=0.
|
||||
do i=1,8
|
||||
do j=1,41
|
||||
if(msg(i:i).eq.c(j:j)) go to 10
|
||||
enddo
|
||||
j=37
|
||||
10 j=j-1 !Codes should start at zero
|
||||
dn=41.d0*dn + j
|
||||
enddo
|
||||
|
||||
ng=mod(dn,32768.d0)
|
||||
n1=(dn-ng)/32768.d0
|
||||
|
||||
return
|
||||
end subroutine packtext2
|
||||
18
lib/qso50/twq.f90
Normal file
18
lib/qso50/twq.f90
Normal file
@ -0,0 +1,18 @@
|
||||
program twq
|
||||
|
||||
character*22 msg0,msg
|
||||
integer*1 data0(11)
|
||||
|
||||
open(10,file='wqmsg.txt',status='old')
|
||||
write(*,1000)
|
||||
1000 format(4x,'Encoded message',9x,'Decoded as',12x,'itype'/55('-'))
|
||||
|
||||
do line=1,9999
|
||||
read(10,*,end=999) msg0
|
||||
call wqenc(msg0,itype,data0)
|
||||
call wqdec(data0,msg,ntype)
|
||||
write(*,1100) line,msg0,msg,ntype
|
||||
1100 format(i2,'.',1x,a22,2x,a22,i3)
|
||||
enddo
|
||||
|
||||
999 end program twq
|
||||
30
lib/qso50/unpack50.f90
Normal file
30
lib/qso50/unpack50.f90
Normal file
@ -0,0 +1,30 @@
|
||||
subroutine unpack50(dat,n1,n2)
|
||||
|
||||
integer*1 dat(11)
|
||||
|
||||
i=dat(1)
|
||||
i4=iand(i,255)
|
||||
n1=ishft(i4,20)
|
||||
i=dat(2)
|
||||
i4=iand(i,255)
|
||||
n1=n1 + ishft(i4,12)
|
||||
i=dat(3)
|
||||
i4=iand(i,255)
|
||||
n1=n1 + ishft(i4,4)
|
||||
i=dat(4)
|
||||
i4=iand(i,255)
|
||||
n1=n1 + iand(ishft(i4,-4),15)
|
||||
n2=ishft(iand(i4,15),18)
|
||||
i=dat(5)
|
||||
i4=iand(i,255)
|
||||
n2=n2 + ishft(i4,10)
|
||||
i=dat(6)
|
||||
i4=iand(i,255)
|
||||
n2=n2 + ishft(i4,2)
|
||||
i=dat(7)
|
||||
i4=iand(i,255)
|
||||
n2=n2 + iand(ishft(i4,-6),3)
|
||||
|
||||
return
|
||||
end subroutine unpack50
|
||||
|
||||
20
lib/qso50/unpackname.f90
Normal file
20
lib/qso50/unpackname.f90
Normal file
@ -0,0 +1,20 @@
|
||||
subroutine unpackname(n1,n2,name,len)
|
||||
|
||||
character*9 name
|
||||
real*8 dn
|
||||
|
||||
dn=32768.d0*n1 + n2
|
||||
len=0
|
||||
do i=9,1,-1
|
||||
j=mod(dn,27.d0)
|
||||
if(j.ge.1) then
|
||||
name(i:i)=char(64+j)
|
||||
len=len+1
|
||||
else
|
||||
name(i:i)=' '
|
||||
endif
|
||||
dn=dn/27.d0
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine unpackname
|
||||
35
lib/qso50/unpackpfx.f90
Normal file
35
lib/qso50/unpackpfx.f90
Normal file
@ -0,0 +1,35 @@
|
||||
subroutine unpackpfx(ng,call1)
|
||||
|
||||
character*12 call1
|
||||
character*3 pfx
|
||||
|
||||
if(ng.lt.60000) then
|
||||
! Add-on prefix of 1 to 3 characters
|
||||
n=ng
|
||||
do i=3,1,-1
|
||||
nc=mod(n,37)
|
||||
if(nc.ge.0 .and. nc.le.9) then
|
||||
pfx(i:i)=char(nc+48)
|
||||
else if(nc.ge.10 .and. nc.le.35) then
|
||||
pfx(i:i)=char(nc+55)
|
||||
else
|
||||
pfx(i:i)=' '
|
||||
endif
|
||||
n=n/37
|
||||
enddo
|
||||
call1=pfx//'/'//call1
|
||||
if(call1(1:1).eq.' ') call1=call1(2:)
|
||||
if(call1(1:1).eq.' ') call1=call1(2:)
|
||||
else
|
||||
! Add-on suffix, one character
|
||||
i1=index(call1,' ')
|
||||
nc=ng-60000
|
||||
if(nc.ge.0 .and. nc.le.9) then
|
||||
call1=call1(:i1-1)//'/'//char(nc+48)
|
||||
else if(nc.ge.10 .and. nc.le.35) then
|
||||
call1=call1(:i1-1)//'/'//char(nc+55)
|
||||
endif
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine unpackpfx
|
||||
28
lib/qso50/unpackprop.f90
Normal file
28
lib/qso50/unpackprop.f90
Normal file
@ -0,0 +1,28 @@
|
||||
subroutine unpackprop(n1,k,muf,ccur,cxp)
|
||||
|
||||
character ccur*4,cxp*2
|
||||
|
||||
muf=mod(n1,62)
|
||||
n1=n1/62
|
||||
|
||||
k=mod(n1,11)
|
||||
n1=n1/11
|
||||
|
||||
j=mod(n1,53)
|
||||
n1=n1/53
|
||||
if(j.eq.0) cxp='*'
|
||||
if(j.ge.1 .and. j.le.26) cxp=char(64+j)
|
||||
if(j.gt.26) cxp=char(64+j-26)//char(64+j-26)
|
||||
|
||||
j=mod(n1,53)
|
||||
n1=n1/53
|
||||
if(j.eq.0) ccur(2:2)='*'
|
||||
if(j.ge.1 .and. j.le.26) ccur(2:2)=char(64+j)
|
||||
if(j.gt.26) ccur(2:3)=char(64+j-26)//char(64+j-26)
|
||||
j=n1
|
||||
if(j.eq.0) ccur(1:1)='*'
|
||||
if(j.ge.1 .and. j.le.26) ccur(1:1)=char(64+j)
|
||||
if(j.gt.26) ccur=char(64+j-26)//char(64+j-26)//ccur(2:3)
|
||||
|
||||
return
|
||||
end subroutine unpackprop
|
||||
17
lib/qso50/unpacktext2.f90
Normal file
17
lib/qso50/unpacktext2.f90
Normal file
@ -0,0 +1,17 @@
|
||||
subroutine unpacktext2(n1,ng,msg)
|
||||
|
||||
character*22 msg
|
||||
real*8 dn
|
||||
character*41 c
|
||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +./?'/
|
||||
|
||||
msg=' '
|
||||
dn=32768.d0*n1 + ng
|
||||
do i=8,1,-1
|
||||
j=mod(dn,41.d0)
|
||||
msg(i:i)=c(j+1:j+1)
|
||||
dn=dn/41.d0
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine unpacktext2
|
||||
316
lib/qso50/wqdec.f90
Normal file
316
lib/qso50/wqdec.f90
Normal file
@ -0,0 +1,316 @@
|
||||
subroutine wqdec(data0,message,ntype)
|
||||
|
||||
use packjt
|
||||
parameter (N15=32758)
|
||||
integer*1 data0(11)
|
||||
character*22 message
|
||||
character*12 callsign
|
||||
character*3 cdbm,cf
|
||||
character*2 crpt
|
||||
character*4 grid,psfx
|
||||
character*9 name
|
||||
character*36 fmt
|
||||
character*6 cwx(4)
|
||||
character*7 cwind(5)
|
||||
character ccur*4,cxp*2
|
||||
logical first
|
||||
character*12 dcall(0:N15-1)
|
||||
data first/.true./
|
||||
data cwx/'CLEAR','CLOUDY','RAIN','SNOW'/
|
||||
data cwind/'CALM','BREEZES','WINDY','DRY','HUMID'/
|
||||
save first,dcall
|
||||
|
||||
if(first) then
|
||||
dcall=' '
|
||||
first=.false.
|
||||
endif
|
||||
|
||||
message=' '
|
||||
call unpack50(data0,n1,n2)
|
||||
call unpackcall(n1,callsign,iv2,psfx)
|
||||
i1=index(callsign,' ')
|
||||
call unpackgrid(n2/128,grid)
|
||||
ntype=iand(n2,127) -64
|
||||
|
||||
! Standard WSPR message (types 0 3 7 10 13 17 ... 60)
|
||||
nu=mod(ntype,10)
|
||||
if(ntype.ge.0 .and. ntype.le.60 .and. (nu.eq.0 .or. nu.eq.3 .or. &
|
||||
nu.eq.7)) then
|
||||
write(cdbm,'(i3)'),ntype
|
||||
if(cdbm(1:1).eq.' ') cdbm=cdbm(2:)
|
||||
if(cdbm(1:1).eq.' ') cdbm=cdbm(2:)
|
||||
message=callsign(1:i1)//grid//' '//cdbm
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1)
|
||||
|
||||
! "Best DX" WSPR response (type 1)
|
||||
else if(ntype.eq.1) then
|
||||
message=grid//' DE '//callsign
|
||||
|
||||
! CQ (msg 3; types 2,4,5)
|
||||
else if(ntype.eq.2) then
|
||||
message='CQ '//callsign(:i1)//grid
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1)
|
||||
else if(ntype.eq.4 .or. ntype.eq.5) then
|
||||
ng=n2/128 + 32768*(ntype-4)
|
||||
call unpackpfx(ng,callsign)
|
||||
message='CQ '//callsign
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1)
|
||||
|
||||
! Reply to CQ (msg #2; type 6)
|
||||
else if(ntype.eq.6) then
|
||||
ih=(n2-64-ntype)/128
|
||||
if(dcall(ih)(1:1).ne.' ') then
|
||||
i2=index(dcall(ih),' ')
|
||||
message='<'//dcall(ih)(:i2-1)//'> '//callsign(:i1-1)
|
||||
else
|
||||
message='<...> '//callsign
|
||||
endif
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! Reply to CQ (msg #2; type 8)
|
||||
else if(ntype.eq.8) then
|
||||
message='DE '//callsign(:i1)//grid
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! Reply to CQ, DE pfx/call (msg #2; types 9, 11)
|
||||
else if(ntype.eq.9 .or. ntype.eq.11) then
|
||||
ng=n2/128 + 32768*(ntype-9)/2
|
||||
call unpackpfx(ng,callsign)
|
||||
message='DE '//callsign
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! Calls and report (msg #3; types -1 to -9)
|
||||
else if(ntype.le.-1 .and. ntype.ge.-9) then
|
||||
write(crpt,1010) -ntype
|
||||
1010 format('S',i1)
|
||||
ih=(n2-62-ntype)/128
|
||||
if(dcall(ih)(1:1).ne.' ') then
|
||||
i2=index(dcall(ih),' ')
|
||||
message=callsign(:i1)//'<'//dcall(ih)(:i2-1)//'> '//crpt
|
||||
else
|
||||
message=callsign(:i1)//'<...> '//crpt
|
||||
endif
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! pfx/call and report (msg #3; types -10 to -27)
|
||||
else if(ntype.le.-10 .and. ntype.ge.-27) then
|
||||
ng=n2/128
|
||||
nrpt=-ntype-9
|
||||
if(ntype.le.-19) then
|
||||
ng=ng + 32768
|
||||
nrpt=-ntype-18
|
||||
endif
|
||||
write(crpt,1010) nrpt
|
||||
call unpackpfx(ng,callsign)
|
||||
message=callsign//' '//crpt
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! Calls and R and report (msg #4; types -28 to -36)
|
||||
else if(ntype.le.-28 .and. ntype.ge.-36) then
|
||||
write(crpt,1010) -(ntype+27)
|
||||
ih=(n2-64+28-ntype)/128
|
||||
if(dcall(ih)(1:1).ne.' ') then
|
||||
i2=index(dcall(ih),' ')
|
||||
message=callsign(:i1)//'<'//dcall(ih)(:i2-1)//'> '//'R '//crpt
|
||||
else
|
||||
message=callsign(:i1)//'<...> '//'R '//crpt
|
||||
endif
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! pfx/call R and report (msg #4; types -37 to -54)
|
||||
else if(ntype.le.-37 .and. ntype.ge.-54) then
|
||||
ng=n2/128
|
||||
nrpt=-ntype-36
|
||||
if(ntype.le.-46) then
|
||||
ng=ng + 32768
|
||||
nrpt=-ntype-45
|
||||
endif
|
||||
write(crpt,1010) nrpt
|
||||
call unpackpfx(ng,callsign)
|
||||
message=callsign//' R '//crpt
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! Calls and RRR (msg#5; type 12)
|
||||
else if(ntype.eq.12) then
|
||||
ih=(n2-64+28-ntype)/128
|
||||
if(dcall(ih)(1:1).ne.' ') then
|
||||
i2=index(dcall(ih),' ')
|
||||
message=callsign(:i1)//'<'//dcall(ih)(:i2-1)//'> RRR'
|
||||
else
|
||||
message=callsign(:i1)//'<...> RRR'
|
||||
endif
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! Calls and RRR (msg#5; type 14)
|
||||
else if(ntype.eq.14) then
|
||||
ih=(n2-64+28-ntype)/128
|
||||
if(dcall(ih)(1:1).ne.' ') then
|
||||
i2=index(dcall(ih),' ')
|
||||
message='<'//dcall(ih)(:i2-1)//'> '//callsign(:i1)//'RRR'
|
||||
else
|
||||
message='<...> '//callsign(:i1)//' RRR'
|
||||
endif
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! DE pfx/call and RRR (msg#5; types 15, 16)
|
||||
else if(ntype.eq.15 .or. ntype.eq.16) then
|
||||
ng=n2/128 + 32768*(ntype-15)
|
||||
call unpackpfx(ng,callsign)
|
||||
message='DE '//callsign//' RRR'
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! TNX [name] 73 GL (msg #6; type 18)
|
||||
else if(ntype.eq.18) then
|
||||
ng=(n2-18-64)/128
|
||||
call unpackname(n1,ng,name,len)
|
||||
message='TNX '//name(:len)//' 73 GL'
|
||||
|
||||
! OP [name] 73 GL (msg #6; type 18)
|
||||
else if(ntype.eq.-56) then
|
||||
ng=(n2+56-64)/128
|
||||
call unpackname(n1,ng,name,len)
|
||||
message='OP '//name(:len)//' 73 GL'
|
||||
|
||||
! 73 DE [call] [grid] (msg #6; type 19)
|
||||
else if(ntype.eq.19) then
|
||||
ng=(n2-19-64)/128
|
||||
message='73 DE '//callsign(:i1)//grid
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! 73 DE pfx/call (msg #6; type 21, 22)
|
||||
else if(ntype.eq.21 .or. ntype.eq.22) then
|
||||
ng=n2/128 + (ntype-21)*32768
|
||||
call unpackpfx(ng,callsign)
|
||||
i1=index(callsign,' ')
|
||||
message='73 DE '//callsign
|
||||
call hash(callsign,i1-1,ih)
|
||||
dcall(ih)=callsign(:i1-1)
|
||||
|
||||
! [power] W [gain] DBD 73 GL (msg#6; type 24, 25)
|
||||
else if(ntype.eq.24 .or. ntype.eq.25) then
|
||||
ng=(n2-24-64)/128 - 32
|
||||
i1=1
|
||||
if(n1.gt.0) i1=log10(float(n1)) + 1
|
||||
i2=1
|
||||
if(ng.ge.10) i2=2
|
||||
if(ng.lt.0) i2=i2+1
|
||||
if(n1.le.3000) then
|
||||
if(ntype.eq.24) fmt="(i4,' W ',i2,' DBD 73 GL')"
|
||||
if(ntype.eq.25) fmt="(i4,' W ',i2,' DBD ')"
|
||||
fmt(3:3)=char(48+i1)
|
||||
fmt(12:12)=char(48+i2)
|
||||
if(ng.le.100) then
|
||||
write(message,fmt) n1,ng
|
||||
else
|
||||
if(ng.eq.30000) fmt=fmt(1:8)//"DIPOLE')"
|
||||
if(ng.eq.30001) fmt=fmt(1:8)//"VERTICAL')"
|
||||
write(message,fmt) n1
|
||||
endif
|
||||
else
|
||||
mw=n1-3000
|
||||
if(ntype.eq.24) fmt="('0.',i3.3,' W ',i2,' DBD 73 GL')"
|
||||
if(ntype.eq.25) fmt="('0.',i3.3,' W ',i2,' DBD ')"
|
||||
fmt(19:19)=char(48+i2)
|
||||
if(ng.le.100) then
|
||||
write(message,fmt) mw,ng
|
||||
else
|
||||
if(ng.eq.30000) fmt=fmt(1:15)//"DIPOLE')"
|
||||
if(ng.eq.30001) fmt=fmt(1:15)//"VERTICAL')"
|
||||
write(message,fmt) n1
|
||||
endif
|
||||
if(index(message,'***').gt.0) go to 700
|
||||
endif
|
||||
|
||||
! QRZ call (msg #3; type 26)
|
||||
else if(ntype.eq.26) then
|
||||
ng=(n2-24-64)/128 - 32
|
||||
message='QRZ '//callsign
|
||||
|
||||
! PSE QSY [nnn] KHZ (msg #6; type 28)
|
||||
else if(ntype.eq.28) then
|
||||
if(n1.gt.0) i1=log10(float(n1)) + 1
|
||||
fmt="('PSE QSY ',i2,' KHZ')"
|
||||
fmt(14:14)=char(48+i1)
|
||||
write(message,fmt) n1
|
||||
|
||||
! WX wx temp C/F wind (msg #6; type 29)
|
||||
else if(ntype.eq.29) then
|
||||
nwx=n1/10000
|
||||
ntemp=mod(n1,10000) - 100
|
||||
cf=' F '
|
||||
if(ntemp.gt.800) then
|
||||
ntemp=ntemp-1000
|
||||
cf=' C '
|
||||
endif
|
||||
n2a=n2/128
|
||||
if(nwx.ge.1 .and. nwx.le.4 .and. n2a.ge.1 .and. n2a.le.5) then
|
||||
write(message,1020) cwx(nwx),ntemp,cf,cwind(n2/128)
|
||||
1020 format('WX ',a6,i3,a3,a7)
|
||||
else
|
||||
message='WX'//' (BadMsg)'
|
||||
endif
|
||||
|
||||
! Hexadecimal data (type 62)
|
||||
else if(ntype.eq.62) then
|
||||
ng=n2/128
|
||||
write(message,'(z4.4,z7.7)') ng,n1
|
||||
|
||||
! Solar/geomagnetic/ionospheric data (type 63)
|
||||
else if(ntype.eq.63) then
|
||||
ih=(n2-64-ntype)/128
|
||||
if(dcall(ih)(1:1).ne.' ') then
|
||||
i2=index(dcall(ih),' ')
|
||||
message='<'//dcall(ih)(:i2-1)//'> '
|
||||
else
|
||||
message='<...> '
|
||||
endif
|
||||
call unpackprop(n1,k,muf,ccur,cxp)
|
||||
i2=index(message,'>')
|
||||
write(message(i2+1:),'(i3,i3)') k,muf
|
||||
message=message(:i2+7)//ccur//' '//cxp
|
||||
|
||||
! [plain text] (msg #6; type -57)
|
||||
else if(ntype.eq.-57) then
|
||||
ng=n2/128
|
||||
call unpacktext2(n1,ng,message)
|
||||
else
|
||||
go to 700
|
||||
endif
|
||||
go to 750
|
||||
|
||||
! message='<Unknown message type>'
|
||||
700 i1=index(callsign,' ')
|
||||
if(i1.lt.1) i1=12
|
||||
message=callsign(:i1)//' (BadMsg)'
|
||||
|
||||
750 do i=1,22
|
||||
if(ichar(message(i:i)).eq.0) message(i:i)=' '
|
||||
enddo
|
||||
|
||||
do i=22,1,-1
|
||||
if(message(i:i).ne.' ') go to 800
|
||||
enddo
|
||||
800 i2=i
|
||||
do n=1,20
|
||||
i1=index(message(:i2),' ')
|
||||
if(i1.le.0) go to 900
|
||||
message=message(1:i1)//message(i1+2:)
|
||||
i2=i2-1
|
||||
enddo
|
||||
|
||||
900 return
|
||||
end subroutine wqdec
|
||||
346
lib/qso50/wqenc.f90
Normal file
346
lib/qso50/wqenc.f90
Normal file
@ -0,0 +1,346 @@
|
||||
subroutine wqenc(msg,ntype,data0)
|
||||
|
||||
! Parse and encode a WSPR message.
|
||||
|
||||
use packjt
|
||||
parameter (MASK15=32767)
|
||||
character*22 msg
|
||||
character*12 call1,call2
|
||||
character*4 grid
|
||||
character*9 name
|
||||
character ccur*4,cxp*2
|
||||
logical lbad1,lbad2
|
||||
integer*1 data0(11)
|
||||
integer nu(0:9)
|
||||
data nu/0,-1,1,0,-1,2,1,0,-1,1/
|
||||
|
||||
read(msg,1001,end=1,err=1) ng,n1
|
||||
1001 format(z4,z7)
|
||||
ntype=62
|
||||
n2=128*ng + (ntype+64)
|
||||
call pack50(n1,n2,data0) !Pack 8 bits per byte, add tail
|
||||
go to 900
|
||||
|
||||
1 if(msg(1:6).eq.'73 DE ') go to 80
|
||||
if(index(msg,' W ').gt.0 .and. index(msg,' DBD ').gt.0) go to 90
|
||||
if(msg(1:4).eq.'QRZ ') go to 100
|
||||
if(msg(1:8).eq.'PSE QSY ') go to 110
|
||||
if(msg(1:3).eq.'WX ') go to 120
|
||||
|
||||
! Standard WSPR message (types 0 3 7 10 13 17 ... 60)
|
||||
i1=index(msg,' ')
|
||||
if(i1.lt.4 .or. i1.gt.7) go to 10
|
||||
call1=msg(:i1-1)
|
||||
grid=msg(i1+1:i1+4)
|
||||
call packcall(call1,n1,lbad1)
|
||||
call packgrid(grid,ng,lbad2)
|
||||
if(lbad1 .or. lbad2) go to 10
|
||||
ndbm=0
|
||||
read(msg(i1+5:),*,err=10,end=800) ndbm
|
||||
if(ndbm.lt.0 .or. ndbm.gt.60) go to 800
|
||||
ndbm=ndbm+nu(mod(ndbm,10))
|
||||
n2=128*ng + (ndbm+64)
|
||||
call pack50(n1,n2,data0)
|
||||
ntype=ndbm
|
||||
go to 900
|
||||
|
||||
! "BestDX" automated WSPR reply (type 1)
|
||||
10 if(i1.ne.5 .or. msg(5:8).ne.' DE ') go to 20
|
||||
grid=msg(1:4)
|
||||
call packgrid(grid,ng,lbad2)
|
||||
if(lbad2) go to 800
|
||||
call1=msg(9:)
|
||||
call packcall(call1,n1,lbad1)
|
||||
if(lbad1) go to 800
|
||||
ntype=1
|
||||
n2=128*ng + (ntype+64)
|
||||
call pack50(n1,n2,data0) !Pack 8 bits per byte, add tail
|
||||
go to 900
|
||||
|
||||
! CQ (msg #1; types 2, 4, 5)
|
||||
20 if(msg(1:3).ne.'CQ ') go to 30
|
||||
if(index(msg,'/').le.0) then
|
||||
i2=index(msg(4:),' ')
|
||||
call1=msg(4:i2+3)
|
||||
grid=msg(i2+4:)
|
||||
call packcall(call1,n1,lbad1)
|
||||
if(lbad1) go to 30
|
||||
call packgrid(grid,ng,lbad2)
|
||||
if(lbad2) go to 30
|
||||
ntype=2
|
||||
n2=128*ng + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
else
|
||||
ntype=4 ! or 5
|
||||
call1=msg(4:)
|
||||
call packpfx(call1,n1,ng,nadd)
|
||||
ntype=ntype+nadd
|
||||
n2=128*ng + ntype + 64
|
||||
call pack50(n1,n2,data0)
|
||||
endif
|
||||
go to 900
|
||||
|
||||
! Reply to CQ (msg #2; types 6,8,9,11)
|
||||
30 if(msg(1:1).ne.'<' .and. msg(1:3).ne.'DE ') go to 40
|
||||
if(index(msg,' RRR ').gt.0) go to 50
|
||||
if(msg(1:1).eq.'<') then
|
||||
ntype=6
|
||||
i1=index(msg,'>')
|
||||
call1=msg(2:i1-1)
|
||||
read(msg(i1+1:),*,err=31,end=31) k,muf,ccur,cxp
|
||||
go to 130
|
||||
31 call2=msg(i1+2:)
|
||||
call hash(call1,i1-2,ih)
|
||||
call packcall(call2,n1,lbad1)
|
||||
n2=128*ih + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
else
|
||||
i1=index(msg(4:),' ')
|
||||
call1=msg(4:i1+2)
|
||||
if(index(msg,'/').le.0) then
|
||||
ntype=8
|
||||
ih=0
|
||||
call packcall(call1,n1,lbad1)
|
||||
grid=msg(i1+4:i1+7)
|
||||
call packgrid(grid,ng,lbad2)
|
||||
n2=128*ng + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
else
|
||||
ntype=9 ! or 11
|
||||
call1=msg(4:)
|
||||
call packpfx(call1,n1,ng,nadd)
|
||||
ntype=ntype + 2*nadd
|
||||
n2=128*ng + ntype + 64
|
||||
call pack50(n1,n2,data0)
|
||||
endif
|
||||
endif
|
||||
go to 900
|
||||
|
||||
! Call(s) + report (msg #3; types -1 to -27)
|
||||
! Call(s) + R + report (msg #4; types -28 to -54)
|
||||
40 if(index(msg,' RRR').gt.0) go to 50
|
||||
i1=index(msg,'<')
|
||||
if(i1.gt.0 .and. (i1.lt.5 .or. i1.gt.8)) go to 50
|
||||
i2=index(msg,'/')
|
||||
if(i2.gt.0 .and.i2.le.4) then
|
||||
ntype=-10 ! -10 to -27
|
||||
i0=index(msg,' ')
|
||||
call1=msg(:i0-1)
|
||||
call packpfx(call1,n1,ng,nadd)
|
||||
ntype=ntype - 9*nadd
|
||||
i2=index(msg,' ')
|
||||
i3=index(msg,' R ')
|
||||
if(i3.gt.0) i2=i2+2 !-28 to -36
|
||||
read(msg(i2+2:i2+2),*,end=800,err=800) nrpt
|
||||
ntype=ntype - (nrpt-1)
|
||||
if(i3.gt.0) ntype=ntype-27
|
||||
n2=128*ng + ntype + 64
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
else if(i1.eq.0) then
|
||||
go to 50
|
||||
endif
|
||||
call1=msg(:i1-2) !-1 to -9
|
||||
i2=index(msg,'>')
|
||||
call2=msg(i1+1:i2-1)
|
||||
call hash(call2,i2-i1-1,ih)
|
||||
i3=index(msg,' R ')
|
||||
if(i3.gt.0) i2=i2+2 !-28 to -36
|
||||
read(msg(i2+3:i2+3),*,end=42,err=42) nrpt
|
||||
go to 43
|
||||
42 nrpt=1
|
||||
43 ntype=-nrpt
|
||||
if(i3.gt.0) ntype=-(nrpt+27)
|
||||
call packcall(call1,n1,lbad1)
|
||||
n2=128*ih + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
|
||||
50 i0=index(msg,'<')
|
||||
if(i0.le.0 .and. msg(1:3).ne.'DE ') go to 60
|
||||
i3=index(msg,' RRR')
|
||||
if(i3.le.0) go to 60
|
||||
! Call or calls and RRR (msg#5; type2 12,14,15,16)
|
||||
i0=index(msg,'<')
|
||||
if(i0.eq.1) then
|
||||
if(index(msg,'/').le.0) then
|
||||
ntype=14
|
||||
i1=index(msg,'>')
|
||||
call1=msg(2:i1-1)
|
||||
call2=msg(i1+2:)
|
||||
i2=index(call2,' ')
|
||||
call2=call2(:i2-1)
|
||||
call packcall(call2,n1,lbad1)
|
||||
call hash(call1,i1-2,ih)
|
||||
n2=128*ih + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
else
|
||||
stop '0002'
|
||||
endif
|
||||
else if(i0.ge.5 .and. i0.le.8) then
|
||||
if(index(msg,'/').le.0) then
|
||||
ntype=12
|
||||
i1=index(msg,'>')
|
||||
call1=msg(:i0-2)
|
||||
call2=msg(i0+1:i1-1)
|
||||
call packcall(call1,n1,lbad1)
|
||||
call hash(call2,i1-i0-1,ih)
|
||||
n2=128*ih + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
else
|
||||
stop '0002'
|
||||
endif
|
||||
else
|
||||
i1=index(msg(4:),' ')
|
||||
call1=msg(4:i1+2)
|
||||
if(index(msg,'/').le.0) then
|
||||
ntype=9
|
||||
grid=msg(i1+4:i1+7)
|
||||
else
|
||||
ntype=15 ! or 16
|
||||
call1=msg(4:)
|
||||
i0=index(call1,' ')
|
||||
call1=call1(:i0-1)
|
||||
call packpfx(call1,n1,ng,nadd)
|
||||
ntype=ntype+nadd
|
||||
n2=128*ng + ntype + 64
|
||||
call pack50(n1,n2,data0)
|
||||
endif
|
||||
endif
|
||||
go to 900
|
||||
|
||||
! TNX <name> 73 GL (msg #6; type 18 ...)
|
||||
60 if(msg(1:4).ne.'TNX ') go to 70
|
||||
ntype=18
|
||||
n1=0
|
||||
i2=index(msg(5:),' ')
|
||||
name=msg(5:i2+4)
|
||||
call packname(name,i2-1,n1,ng)
|
||||
n2=128*ng + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
|
||||
! TNX name 73 GL (msg #6; type -56 ...)
|
||||
70 if(msg(1:3).ne.'OP ') go to 80
|
||||
ntype=-56
|
||||
n1=0
|
||||
i2=index(msg(4:),' ')
|
||||
name=msg(4:i2+3)
|
||||
call packname(name,i2-1,n1,ng)
|
||||
n2=128*ng + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
|
||||
! 73 DE call grid (msg #6; type 19)
|
||||
80 if(msg(1:6).ne.'73 DE ') go to 90
|
||||
ntype=19
|
||||
i1=index(msg(7:),' ')
|
||||
call1=msg(7:)
|
||||
if(index(call1,'/').le.0) then
|
||||
i1=index(call1,' ')
|
||||
grid=call1(i1+1:)
|
||||
call1=call1(:i1-1)
|
||||
call packcall(call1,n1,lbad1)
|
||||
call packgrid(grid,ng,lbad2)
|
||||
if(lbad1 .or. lbad2) go to 800
|
||||
n2=128*ng + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
else
|
||||
ntype=21 ! or 22
|
||||
call packpfx(call1,n1,ng,nadd)
|
||||
ntype=ntype + nadd
|
||||
n2=128*ng + ntype + 64
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
endif
|
||||
|
||||
! [pwr] W [gain] DBD [73 GL] (msg #6; types 24, 25)
|
||||
90 if(index(msg,' W ').le.0) go to 140
|
||||
ntype=25
|
||||
if(index(msg,' DBD 73 GL').gt.0) ntype=24
|
||||
i1=index(msg,' ')
|
||||
read(msg(:i1-1),*,end=800,err=800) watts
|
||||
if(watts.ge.1.0) nwatts=watts
|
||||
if(watts.lt.1.0) nwatts=3000 + nint(1000.*watts)
|
||||
if(index(msg,'DIPOLE').gt.0) then
|
||||
ndbd=30000
|
||||
else if(index(msg,'VERTICAL').gt.0) then
|
||||
ndbd=30001
|
||||
else
|
||||
i2=index(msg(i1+3:),' ')
|
||||
read(msg(i1+3:i1+i2+1),*,end=800,err=800) ndbd
|
||||
endif
|
||||
n1=nwatts
|
||||
ng=ndbd + 32
|
||||
n2=128*ng + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
|
||||
! QRZ call (msg #3; type 26)
|
||||
100 call1=msg(5:)
|
||||
call packcall(call1,n1,lbad1)
|
||||
if(lbad1) go to 800
|
||||
ntype=26
|
||||
n2=ntype+64
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
|
||||
! PSE QSY [nnn] KHZ (msg #6; type 28)
|
||||
110 ntype=28
|
||||
read(msg(9:),*,end=800,err=800) n1
|
||||
n2=ntype+64
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
|
||||
! WX wx temp C|F wind (msg #6; type 29)
|
||||
120 ntype=29
|
||||
if(index(msg,' CLEAR ').gt.0) then
|
||||
i1=10
|
||||
n1=10000
|
||||
else if(index(msg,' CLOUDY ').gt.0) then
|
||||
i1=11
|
||||
n1=20000
|
||||
else if(index(msg,' RAIN ').gt.0) then
|
||||
i1=9
|
||||
n1=30000
|
||||
else if(index(msg,' SNOW ').gt.0) then
|
||||
i1=9
|
||||
n1=40000
|
||||
endif
|
||||
read(msg(i1:),*,err=800,end=800) ntemp
|
||||
ntemp=ntemp+100
|
||||
i1=index(msg,' C ')
|
||||
if(i1.gt.0) ntemp=ntemp+1000
|
||||
n1=n1+ntemp
|
||||
if(index(msg,' CALM').gt.0) ng=1
|
||||
if(index(msg,' BREEZES').gt.0) ng=2
|
||||
if(index(msg,' WINDY').gt.0) ng=3
|
||||
if(index(msg,' DRY').gt.0) ng=4
|
||||
if(index(msg,' HUMID').gt.0) ng=5
|
||||
|
||||
n2=128*ng + (ntype+64)
|
||||
call pack50(n1,n2,data0)
|
||||
|
||||
go to 900
|
||||
|
||||
! Solar/geomagnetic/ionospheric data
|
||||
130 ntype=63
|
||||
call packprop(k,muf,ccur,cxp,n1)
|
||||
call hash(call1,i1-2,ih)
|
||||
n2=128*ih + ntype + 64
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
|
||||
140 continue
|
||||
|
||||
! Plain text
|
||||
800 ntype=-57
|
||||
call packtext2(msg(:8),n1,ng)
|
||||
n2=128*ng + ntype + 64
|
||||
call pack50(n1,n2,data0)
|
||||
go to 900
|
||||
|
||||
900 continue
|
||||
return
|
||||
end subroutine wqenc
|
||||
31
lib/qso50/wqmsg.txt
Normal file
31
lib/qso50/wqmsg.txt
Normal file
@ -0,0 +1,31 @@
|
||||
"CQ K1JT FN20"
|
||||
"CQ PJ4/K1JT"
|
||||
"<K1JT> W6CQZ"
|
||||
"DE W6CQZ CM87"
|
||||
"DE PJ4/K1JT"
|
||||
"W6CQZ <K1JT> S4"
|
||||
"QRZ K1JT"
|
||||
"PJ4/W6CQZ S4"
|
||||
"K1JT <W6CQZ> R S3"
|
||||
"PJ4/K1JT R S3"
|
||||
"<W6CQZ> K1JT RRR"
|
||||
"W6CQZ <K1JT> RRR"
|
||||
"DE PJ4/K1JT RRR"
|
||||
"73 DE W6CQZ CM87"
|
||||
"73 DE PJ4/K1JT"
|
||||
"TNX VICTORIA 73 GL"
|
||||
"OP HARRY 73 GL"
|
||||
"5 W DIPOLE"
|
||||
"10 W VERTICAL"
|
||||
"1 W 0 DBD"
|
||||
"1500 W 21 DBD 73 GL"
|
||||
"PSE QSY 1811 KHZ"
|
||||
"WX SNOW -5 C CALM"
|
||||
"CUL JACK"
|
||||
"."
|
||||
"CQ K1JT FN20"
|
||||
"<K1JT> W6CQZ"
|
||||
"W6CQZ <K1JT> S4"
|
||||
"K1JT <W6CQZ> R S3"
|
||||
"<W6CQZ> K1JT RRR"
|
||||
"TNX JOE 73 GL"
|
||||
Loading…
Reference in New Issue
Block a user