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