339 lines
		
	
	
		
			10 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
			
		
		
	
	
			339 lines
		
	
	
		
			10 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
!-------------------------------------------------------------------------------
 | 
						|
!
 | 
						|
! 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
 | 
						|
     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
 |