mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-05 08:51:19 -05:00
317 lines
8.9 KiB
Fortran
317 lines
8.9 KiB
Fortran
|
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
|