1subroutine wqenc(msg,ntype,data0)
2
3!  Parse and encode a WSPR message.
4
5  use packjt
6  parameter (MASK15=32767)
7  character*22 msg
8  character*12 call1,call2
9  character*4 grid
10  character*9 name
11  character ccur*4,cxp*2
12  logical lbad1,lbad2
13  integer*1 data0(11)
14  integer nu(0:9)
15  data nu/0,-1,1,0,-1,2,1,0,-1,1/
16
17  read(msg,1001,end=1,err=1) ng,n1
181001 format(z4,z7)
19  ntype=62
20  n2=128*ng + (ntype+64)
21  call pack50(n1,n2,data0)             !Pack 8 bits per byte, add tail
22  go to 900
23
241  if(msg(1:6).eq.'73 DE ') go to 80
25  if(index(msg,' W ').gt.0 .and. index(msg,' DBD ').gt.0) go to 90
26  if(msg(1:4).eq.'QRZ ') go to 100
27  if(msg(1:8).eq.'PSE QSY ') go to 110
28  if(msg(1:3).eq.'WX ') go to 120
29
30! Standard WSPR message (types 0 3 7 10 13 17 ... 60)
31  i1=index(msg,' ')
32  if(i1.lt.4 .or. i1.gt.7) go to 10
33  call1=msg(:i1-1)
34  grid=msg(i1+1:i1+4)
35  call packcall(call1,n1,lbad1)
36  call packgrid(grid,ng,lbad2)
37  if(lbad1 .or. lbad2) go to 10
38  ndbm=0
39  read(msg(i1+5:),*,err=10,end=800) ndbm
40  if(ndbm.lt.0 .or. ndbm.gt.60) go to 800
41  ndbm=ndbm+nu(mod(ndbm,10))
42  n2=128*ng + (ndbm+64)
43  call pack50(n1,n2,data0)
44  ntype=ndbm
45  go to 900
46
47! "BestDX" automated WSPR reply (type 1)
4810 if(i1.ne.5 .or. msg(5:8).ne.' DE ') go to 20
49  grid=msg(1:4)
50  call packgrid(grid,ng,lbad2)
51  if(lbad2) go to 800
52  call1=msg(9:)
53  call packcall(call1,n1,lbad1)
54  if(lbad1) go to 800
55  ntype=1
56  n2=128*ng + (ntype+64)
57  call pack50(n1,n2,data0)             !Pack 8 bits per byte, add tail
58  go to 900
59
60! CQ (msg #1; types 2, 4, 5)
6120  if(msg(1:3).ne.'CQ ') go to 30
62  if(index(msg,'/').le.0) then
63     i2=index(msg(4:),' ')
64     call1=msg(4:i2+3)
65     grid=msg(i2+4:)
66     call packcall(call1,n1,lbad1)
67     if(lbad1) go to 30
68     call packgrid(grid,ng,lbad2)
69     if(lbad2) go to 30
70     ntype=2
71     n2=128*ng + (ntype+64)
72     call pack50(n1,n2,data0)
73  else
74     ntype=4                                     ! or 5
75     call1=msg(4:)
76     call packpfx(call1,n1,ng,nadd)
77     ntype=ntype+nadd
78     n2=128*ng + ntype + 64
79     call pack50(n1,n2,data0)
80  endif
81  go to 900
82
83! Reply to CQ (msg #2; types 6,8,9,11)
8430 if(msg(1:1).ne.'<' .and. msg(1:3).ne.'DE ') go to 40
85  if(index(msg,' RRR ').gt.0) go to 50
86  if(msg(1:1).eq.'<') then
87     ntype=6
88     i1=index(msg,'>')
89     call1=msg(2:i1-1)
90     read(msg(i1+1:),*,err=31,end=31) k,muf,ccur,cxp
91     go to 130
9231   call2=msg(i1+2:)
93     call hash(call1,i1-2,ih)
94     call packcall(call2,n1,lbad1)
95     n2=128*ih + (ntype+64)
96     call pack50(n1,n2,data0)
97  else
98     i1=index(msg(4:),' ')
99     call1=msg(4:i1+2)
100     if(index(msg,'/').le.0) then
101        ntype=8
102        ih=0
103        call packcall(call1,n1,lbad1)
104        grid=msg(i1+4:i1+7)
105        call packgrid(grid,ng,lbad2)
106        n2=128*ng + (ntype+64)
107        call pack50(n1,n2,data0)
108     else
109        ntype=9                                   ! or 11
110        call1=msg(4:)
111        call packpfx(call1,n1,ng,nadd)
112        ntype=ntype + 2*nadd
113        n2=128*ng + ntype + 64
114        call pack50(n1,n2,data0)
115     endif
116  endif
117  go to 900
118
119! Call(s) + report (msg #3; types -1 to -27)
120! Call(s) + R + report (msg #4; types -28 to -54)
12140 if(index(msg,' RRR').gt.0) go to 50
122  i1=index(msg,'<')
123  if(i1.gt.0 .and. (i1.lt.5 .or. i1.gt.8)) go to 50
124  i2=index(msg,'/')
125  if(i2.gt.0 .and.i2.le.4) then
126     ntype=-10                                   ! -10 to -27
127     i0=index(msg,' ')
128     call1=msg(:i0-1)
129     call packpfx(call1,n1,ng,nadd)
130     ntype=ntype - 9*nadd
131     i2=index(msg,' ')
132     i3=index(msg,' R ')
133     if(i3.gt.0) i2=i2+2                            !-28 to -36
134     read(msg(i2+2:i2+2),*,end=800,err=800) nrpt
135     ntype=ntype - (nrpt-1)
136     if(i3.gt.0) ntype=ntype-27
137     n2=128*ng + ntype + 64
138     call pack50(n1,n2,data0)
139     go to 900
140  else if(i1.eq.0) then
141     go to 50
142  endif
143  call1=msg(:i1-2)                               !-1 to -9
144  i2=index(msg,'>')
145  call2=msg(i1+1:i2-1)
146  call hash(call2,i2-i1-1,ih)
147  i3=index(msg,' R ')
148  if(i3.gt.0) i2=i2+2                            !-28 to -36
149  read(msg(i2+3:i2+3),*,end=42,err=42) nrpt
150  go to 43
15142 nrpt=1
15243 ntype=-nrpt
153  if(i3.gt.0) ntype=-(nrpt+27)
154  call packcall(call1,n1,lbad1)
155  n2=128*ih + (ntype+64)
156  call pack50(n1,n2,data0)
157  go to 900
158
15950 i0=index(msg,'<')
160  if(i0.le.0 .and. msg(1:3).ne.'DE ') go to 60
161  i3=index(msg,' RRR')
162  if(i3.le.0) go to 60
163! Call or calls and RRR (msg#5; type2 12,14,15,16)
164  i0=index(msg,'<')
165  if(i0.eq.1) then
166     if(index(msg,'/').le.0) then
167        ntype=14
168        i1=index(msg,'>')
169        call1=msg(2:i1-1)
170        call2=msg(i1+2:)
171        i2=index(call2,' ')
172        call2=call2(:i2-1)
173        call packcall(call2,n1,lbad1)
174        call hash(call1,i1-2,ih)
175        n2=128*ih + (ntype+64)
176        call pack50(n1,n2,data0)
177     else
178        stop '0002'
179     endif
180  else if(i0.ge.5 .and. i0.le.8) then
181     if(index(msg,'/').le.0) then
182        ntype=12
183        i1=index(msg,'>')
184        call1=msg(:i0-2)
185        call2=msg(i0+1:i1-1)
186        call packcall(call1,n1,lbad1)
187        call hash(call2,i1-i0-1,ih)
188        n2=128*ih + (ntype+64)
189        call pack50(n1,n2,data0)
190     else
191        stop '0002'
192     endif
193  else
194     i1=index(msg(4:),' ')
195     call1=msg(4:i1+2)
196     if(index(msg,'/').le.0) then
197        ntype=9
198        grid=msg(i1+4:i1+7)
199     else
200        ntype=15                                   ! or 16
201        call1=msg(4:)
202        i0=index(call1,' ')
203        call1=call1(:i0-1)
204        call packpfx(call1,n1,ng,nadd)
205        ntype=ntype+nadd
206        n2=128*ng + ntype + 64
207        call pack50(n1,n2,data0)
208     endif
209  endif
210  go to 900
211
212! TNX <name> 73 GL (msg #6; type 18 ...)
21360 if(msg(1:4).ne.'TNX ') go to 70
214  ntype=18
215  n1=0
216  i2=index(msg(5:),' ')
217  name=msg(5:i2+4)
218  call packname(name,i2-1,n1,ng)
219  n2=128*ng + (ntype+64)
220  call pack50(n1,n2,data0)
221  go to 900
222
223! TNX name 73 GL (msg #6; type -56 ...)
22470 if(msg(1:3).ne.'OP ') go to 80
225  ntype=-56
226  n1=0
227  i2=index(msg(4:),' ')
228  name=msg(4:i2+3)
229  call packname(name,i2-1,n1,ng)
230  n2=128*ng + (ntype+64)
231  call pack50(n1,n2,data0)
232  go to 900
233
234! 73 DE call grid (msg #6; type 19)
23580 if(msg(1:6).ne.'73 DE ') go to 90
236  ntype=19
237  i1=index(msg(7:),' ')
238  call1=msg(7:)
239  if(index(call1,'/').le.0) then
240     i1=index(call1,' ')
241     grid=call1(i1+1:)
242     call1=call1(:i1-1)
243     call packcall(call1,n1,lbad1)
244     call packgrid(grid,ng,lbad2)
245     if(lbad1 .or. lbad2) go to 800
246     n2=128*ng + (ntype+64)
247     call pack50(n1,n2,data0)
248     go to 900
249  else
250     ntype=21                                   ! or 22
251     call packpfx(call1,n1,ng,nadd)
252     ntype=ntype + nadd
253     n2=128*ng + ntype + 64
254     call pack50(n1,n2,data0)
255     go to 900
256  endif
257
258! [pwr] W [gain] DBD [73 GL] (msg #6; types 24, 25)
25990  if(index(msg,' W ').le.0) go to 140
260  ntype=25
261  if(index(msg,' DBD 73 GL').gt.0) ntype=24
262  i1=index(msg,' ')
263  read(msg(:i1-1),*,end=800,err=800) watts
264  if(watts.ge.1.0) nwatts=watts
265  if(watts.lt.1.0) nwatts=3000 + nint(1000.*watts)
266  if(index(msg,'DIPOLE').gt.0) then
267     ndbd=30000
268  else if(index(msg,'VERTICAL').gt.0) then
269     ndbd=30001
270  else
271     i2=index(msg(i1+3:),' ')
272     read(msg(i1+3:i1+i2+1),*,end=800,err=800) ndbd
273  endif
274  n1=nwatts
275  ng=ndbd + 32
276  n2=128*ng + (ntype+64)
277  call pack50(n1,n2,data0)
278  go to 900
279
280! QRZ call (msg #3; type 26)
281100 call1=msg(5:)
282  call packcall(call1,n1,lbad1)
283  if(lbad1) go to 800
284  ntype=26
285  n2=ntype+64
286  call pack50(n1,n2,data0)
287  go to 900
288
289! PSE QSY [nnn] KHZ (msg #6; type 28)
290110 ntype=28
291  read(msg(9:),*,end=800,err=800) n1
292  n2=ntype+64
293  call pack50(n1,n2,data0)
294  go to 900
295
296! WX wx temp C|F wind (msg #6; type 29)
297120 ntype=29
298  if(index(msg,' CLEAR ').gt.0) then
299     i1=10
300     n1=10000
301  else if(index(msg,' CLOUDY ').gt.0) then
302     i1=11
303     n1=20000
304  else if(index(msg,' RAIN ').gt.0) then
305     i1=9
306     n1=30000
307  else if(index(msg,' SNOW ').gt.0) then
308     i1=9
309     n1=40000
310  endif
311  read(msg(i1:),*,err=800,end=800) ntemp
312  ntemp=ntemp+100
313  i1=index(msg,' C ')
314  if(i1.gt.0) ntemp=ntemp+1000
315  n1=n1+ntemp
316  if(index(msg,' CALM').gt.0) ng=1
317  if(index(msg,' BREEZES').gt.0) ng=2
318  if(index(msg,' WINDY').gt.0) ng=3
319  if(index(msg,' DRY').gt.0) ng=4
320  if(index(msg,' HUMID').gt.0) ng=5
321
322  n2=128*ng + (ntype+64)
323  call pack50(n1,n2,data0)
324
325  go to 900
326
327! Solar/geomagnetic/ionospheric data
328130 ntype=63
329  call packprop(k,muf,ccur,cxp,n1)
330  call hash(call1,i1-2,ih)
331  n2=128*ih + ntype + 64
332  call pack50(n1,n2,data0)
333  go to 900
334
335140 continue
336
337! Plain text
338800 ntype=-57
339  call packtext2(msg(:8),n1,ng)
340  n2=128*ng + ntype + 64
341  call pack50(n1,n2,data0)
342  go to 900
343
344900 continue
345  return
346end subroutine wqenc
347