w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-11-24 13:18:38 -05:00
Code Issues Packages Projects Releases Wiki Activity
232773c582
WSJT-X/lib/wqdecode.f90
Joe Taylor 64a9aa5d39 Silence compiler warnings.
2020-03-19 13:45:13 -04:00

339 lines
10 KiB
Fortran
Raw Blame History

!-------------------------------------------------------------------------------
!
! This file is part of the WSPR application, Weak Signal Propagation Reporter
!
! File Name: wqdecode.f90
! Description:
!
! Copyright (C) 2001-2014 Joseph Taylor, K1JT
! License: GPL-3
!
! This program is free software; you can redistribute it and/or modify it under
! the terms of the GNU General Public License as published by the Free Software
! Foundation; either version 3 of the License, or (at your option) any later
! version.
!
! This program is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
! details.
!
! You should have received a copy of the GNU General Public License along with
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!-------------------------------------------------------------------------------
subroutine wqdecode(data0,message,ntype)
parameter (N15=32768)
integer*1 data0(11)
character*22 message
character*12 callsign
character*3 cdbm
character grid4*4,grid6*6
logical first
character*12 dcall(0:N15-1)
data first/.true./
save first,dcall
! May want to have a timeout (say, one hour?) on calls fetched
! from the hash table.
if(first) then
dcall=' '
first=.false.
endif
message=' '
call unpack50(data0,n1,n2)
! print*,data0,n1,n2
call unpackcall(n1,callsign)
i1=index(callsign,' ')
call unpackgrid(n2/128,grid4)
ntype=iand(n2,127) -64
! Standard WSPR message (types 0 3 7 10 13 17 ... 60)
if(ntype.ge.0 .and. ntype.le.62) then
nu=mod(ntype,10)
if(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)//grid4//' '//cdbm
call hash(callsign,i1-1,ih)
dcall(ih)=callsign(:i1)
else
nadd=nu
if(nu.gt.3) nadd=nu-3
if(nu.gt.7) nadd=nu-7
ng=n2/128 + 32768*(nadd-1)
call unpackpfx(ng,callsign)
ndbm=ntype-nadd
write(cdbm,'(i3)') ndbm
if(cdbm(1:1).eq.' ') cdbm=cdbm(2:)
if(cdbm(1:1).eq.' ') cdbm=cdbm(2:)
i2=index(callsign,' ')
message=callsign(:i2)//cdbm
call hash(callsign,i2-1,ih)
dcall(ih)=callsign(:i2)
endif
else if(ntype.lt.0) then
ndbm=-(ntype+1)
grid6=callsign(6:6)//callsign(1:5)
ih=(n2-ntype-64)/128
callsign=dcall(ih)
write(cdbm,'(i3)') ndbm
if(cdbm(1:1).eq.' ') cdbm=cdbm(2:)
if(cdbm(1:1).eq.' ') cdbm=cdbm(2:)
i2=index(callsign,' ')
if(dcall(ih)(1:1).ne.' ') then
message='<'//callsign(:i2-1)//'> '//grid6//' '//cdbm
else
message='<...> '//grid6//' '//cdbm
endif
endif
return
end subroutine wqdecode
!-------------------------------------------------------------------------------
!
! This file is part of the WSPR application, Weak Signal Propagation Reporter
!
! File Name: unpack50.f90
! Description:
!
! Copyright (C) 2001-2014 Joseph Taylor, K1JT
! License: GPL-3
!
! This program is free software; you can redistribute it and/or modify it under
! the terms of the GNU General Public License as published by the Free Software
! Foundation; either version 3 of the License, or (at your option) any later
! version.
!
! This program is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
! details.
!
! You should have received a copy of the GNU General Public License along with
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!-------------------------------------------------------------------------------
subroutine unpack50(dat,n1,n2)
integer*1 dat(11)
i=dat(1)
i4=iand(i,255)
n1=ishft(i4,20)
i=dat(2)
i4=iand(i,255)
n1=n1 + ishft(i4,12)
i=dat(3)
i4=iand(i,255)
n1=n1 + ishft(i4,4)
i=dat(4)
i4=iand(i,255)
n1=n1 + iand(ishft(i4,-4),15)
n2=ishft(iand(i4,15),18)
i=dat(5)
i4=iand(i,255)
n2=n2 + ishft(i4,10)
i=dat(6)
i4=iand(i,255)
n2=n2 + ishft(i4,2)
i=dat(7)
i4=iand(i,255)
n2=n2 + iand(ishft(i4,-6),3)
return
end subroutine unpack50
!-------------------------------------------------------------------------------
!
! This file is part of the WSPR application, Weak Signal Propagation Reporter
!
! File Name: unpackcall.f90
! Description:
!
! Copyright (C) 2001-2014 Joseph Taylor, K1JT
! License: GPL-3
!
! This program is free software; you can redistribute it and/or modify it under
! the terms of the GNU General Public License as published by the Free Software
! Foundation; either version 3 of the License, or (at your option) any later
! version.
!
! This program is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
! details.
!
! You should have received a copy of the GNU General Public License along with
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!-------------------------------------------------------------------------------
subroutine unpackcall(ncall,word)
character word*12,c*37
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
n=ncall
word='......'
if(n.ge.262177560) go to 999 !Plain text message ...
i=mod(n,27)+11
word(6:6)=c(i:i)
n=n/27
i=mod(n,27)+11
word(5:5)=c(i:i)
n=n/27
i=mod(n,27)+11
word(4:4)=c(i:i)
n=n/27
i=mod(n,10)+1
word(3:3)=c(i:i)
n=n/10
i=mod(n,36)+1
word(2:2)=c(i:i)
n=n/36
i=n+1
word(1:1)=c(i:i)
do i=1,4
if(word(i:i).ne.' ') go to 10
enddo
go to 999
10 word=word(i:)
999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
return
end subroutine unpackcall
!-------------------------------------------------------------------------------
!
! This file is part of the WSPR application, Weak Signal Propagation Reporter
!
! File Name: unpackgrid.f90
! Description:
!
! Copyright (C) 2001-2014 Joseph Taylor, K1JT
! License: GPL-3
!
! This program is free software; you can redistribute it and/or modify it under
! the terms of the GNU General Public License as published by the Free Software
! Foundation; either version 3 of the License, or (at your option) any later
! version.
!
! This program is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
! details.
!
! You should have received a copy of the GNU General Public License along with
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!-------------------------------------------------------------------------------
subroutine unpackgrid(ng,grid)
parameter (NGBASE=180*180)
character grid*4,grid6*6,digit*10
data digit/'0123456789'/
grid=' '
if(ng.ge.32400) go to 10
dlat=mod(ng,180)-90
dlong=(ng/180)*2 - 180 + 2
call deg2grid(dlong,dlat,grid6)
grid=grid6(1:4) !XXX explicitly truncate this -db
go to 100
10 n=ng-NGBASE-1
if(n.ge.1 .and.n.le.30) then
grid(1:1)='-'
grid(2:2)=char(48+n/10)
grid(3:3)=char(48+mod(n,10))
else if(n.ge.31 .and.n.le.60) then
n=n-30
grid(1:2)='R-'
grid(3:3)=char(48+n/10)
grid(4:4)=char(48+mod(n,10))
else if(n.eq.61) then
grid='RO'
else if(n.eq.62) then
grid='RRR'
else if(n.eq.63) then
grid='73'
endif
100 return
end subroutine unpackgrid
!-------------------------------------------------------------------------------
!
! This file is part of the WSPR application, Weak Signal Propagation Reporter
!
! File Name: unpackpfx.f90
! Description:
!
! Copyright (C) 2001-2014 Joseph Taylor, K1JT
! License: GPL-3
!
! This program is free software; you can redistribute it and/or modify it under
! the terms of the GNU General Public License as published by the Free Software
! Foundation; either version 3 of the License, or (at your option) any later
! version.
!
! This program is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
! details.
!
! You should have received a copy of the GNU General Public License along with
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!-------------------------------------------------------------------------------
subroutine unpackpfx(ng,call1)
character*12 call1
character*3 pfx
if(ng.lt.60000) then
! Add-on prefix of 1 to 3 characters
n=ng
do i=3,1,-1
nc=mod(n,37)
if(nc.ge.0 .and. nc.le.9) then
pfx(i:i)=char(nc+48)
else if(nc.ge.10 .and. nc.le.35) then
pfx(i:i)=char(nc+55)
else
pfx(i:i)=' '
endif
n=n/37
enddo
call1=pfx//'/'//call1(1:8)
if(call1(1:1).eq.' ') call1=call1(2:)
if(call1(1:1).eq.' ') call1=call1(2:)
else
! Add-on suffix, one or teo characters
i1=index(call1,' ')
nc=ng-60000
if(nc.ge.0 .and. nc.le.9) then
call1=call1(:i1-1)//'/'//char(nc+48)
else if(nc.ge.10 .and. nc.le.35) then
call1=call1(:i1-1)//'/'//char(nc+55)
else if(nc.ge.36 .and. nc.le.125) then
nc1=(nc-26)/10
nc2=mod(nc-26,10)
call1=call1(:i1-1)//'/'//char(nc1+48)//char(nc2+48)
endif
endif
return
end subroutine unpackpfx
Reference in New Issue View Git Blame Copy Permalink