Merged master 8748
This commit is contained in:
Jordan Sherer
@@ -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
|
||||
Reference in New Issue
Block a user