347 lines
8.8 KiB
Fortran
347 lines
8.8 KiB
Fortran
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
|