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
 | 
