remove lhasgrid

This commit is contained in:
Pavel Demin 2018-04-19 22:09:02 +02:00
parent 61ae08bf0c
commit e5a9ffb91e
4 changed files with 12 additions and 16 deletions

View File

@ -1,4 +1,4 @@
subroutine extractmessage174(decoded,lhasgrid,msgcall,msggrid,ncrcflag)
subroutine extractmessage174(decoded,msgcall,msggrid,ncrcflag)
use iso_c_binding, only: c_loc,c_size_t
use crc
use packjt
@ -8,7 +8,6 @@ subroutine extractmessage174(decoded,lhasgrid,msgcall,msggrid,ncrcflag)
integer*1 decoded(87)
integer*1, target:: i1Dec8BitBytes(11)
integer*4 i4Dec6BitWords(12)
logical lhasgrid
! Write decoded bits into cbits: 75-bit message plus 12-bit CRC
write(cbits,1000) decoded
@ -31,7 +30,7 @@ subroutine extractmessage174(decoded,lhasgrid,msgcall,msggrid,ncrcflag)
enddo
i4Dec6BitWords(ibyte)=itmp
enddo
call unpackmsg(i4Dec6BitWords,lhasgrid,msgcall,msggrid)
call unpackmsg(i4Dec6BitWords,msgcall,msggrid)
ncrcflag=1
else
msgcall=' '

View File

@ -1,6 +1,6 @@
subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
napwid,nagain,iaptype,f1,xdt,xbase,apsym,nharderrors,dmin, &
nbadcrc,ipass,lhasgrid,msgcall,msggrid,xsnr)
nbadcrc,ipass,msgcall,msggrid,xsnr)
use crc
include 'ft8_params.f90'
@ -23,7 +23,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
complex cd0(3200)
complex ctwk(32)
complex csymb(32)
logical first,newdat,lapon,lapcqonly,nagain,lhasgrid
logical first,newdat,lapon,lapcqonly,nagain
equivalence (s1,s1sort)
data icos7/2,5,6,0,4,1,3/
data mcq/1,1,1,1,1,0,1,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,1,1,0,0,1/
@ -360,7 +360,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
cycle
endif
if(nbadcrc.eq.0) then
call extractmessage174(decoded,lhasgrid,msgcall,msggrid,ncrcflag)
call extractmessage174(decoded,msgcall,msggrid,ncrcflag)
xsig=0.0
xnoi=0.0
do i=1,79

View File

@ -10,7 +10,7 @@ program ft8d
real candidate(3,200)
real*8 dialfreq
complex dd(NMAX,4)
logical newdat,lhasgrid
logical newdat
integer apsym(KK)
nargs=iargc()
@ -52,15 +52,15 @@ program ft8d
call ft8b(dd(1:NMAX,ipart),newdat,nQSOProgress,nfqso+2000, &
nftx,ndepth,lft8apon,lapcqonly,napwid,nagain,iaptype, &
f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,iappass, &
lhasgrid,msgcall,msggrid,xsnr)
msgcall,msggrid,xsnr)
message=msg37(1:22)
nsnr=nint(xsnr)
xdt=xdt-0.5
hd=nharderrors+dmin
if(nbadcrc.eq.0 .and. lhasgrid) then
if(nbadcrc.eq.0) then
write(*,1004) nutc+15*(ipart-1),min(sync,999.0),nint(xsnr), &
xdt,nint(f1-2000+dialfreq),msggrid,msgcall
1004 format(i6.6,f6.1,i4,f6.2,i9,1x,a4,1x,a12)
xdt,nint(f1-2000+dialfreq),msgcall,msggrid
1004 format(i6.6,f6.1,i4,f6.2,i9,1x,a12,1x,a4)
endif
enddo
enddo ! ipart loop

View File

@ -170,13 +170,12 @@ module packjt
return
end subroutine unpackcall
subroutine unpackmsg(dat,lhasgrid,msgcall,msggrid)
subroutine unpackmsg(dat,msgcall,msggrid)
parameter (NBASE=37*36*10*27*27*27)
parameter (NGBASE=180*180)
integer dat(:)
character msgcall*12,msggrid*4,grid6*6,junk2*4
logical lhasgrid
nc1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+ &
ishft(dat(4),4) + iand(ishft(dat(5),-2),15)
@ -187,15 +186,13 @@ module packjt
ng=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12)
lhasgrid=.false.
call unpackcall(nc2,msgcall,junk1,junk2)
msggrid=' '
if(ng.lt.32400 .and. ng.ne.533) then
call unpackcall(nc2,msgcall,junk1,junk2)
dlat=mod(ng,180)-90
dlong=(ng/180)*2 - 180 + 2
call deg2grid(dlong,dlat,grid6)
msggrid=grid6(:4)
lhasgrid=msggrid(1:2).ne.'KA' .and. msggrid(1:2).ne.'KA'
endif
return